PSEUDOHOSTS: Moved SLASHIT to UNIXUTILS, also includes minor change in previous (unexamined) PR, to be removed
This commit is contained in:
rmkaplan
parent
445de6745d
commit
9ed6448591
@ -1,14 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jul-2023 09:17:48" {WMEDLEY}<lispusers>PSEUDOHOSTS.;153 27674
|
||||
(FILECREATED "22-Sep-2023 15:29:50" {WMEDLEY}<lispusers>PSEUDOHOSTS.;158 26638
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE)
|
||||
(MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL)
|
||||
:CHANGES-TO (FNS PSEUDOHOST SLASHIT CONTRACT.PH)
|
||||
(VARS PSEUDOHOSTSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "18-Jul-2023 13:12:35" {WMEDLEY}<lispusers>PSEUDOHOSTS.;152)
|
||||
:PREVIOUS-DATE "26-Jul-2023 12:34:37" {WMEDLEY}<lispusers>PSEUDOHOSTS.;155)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PSEUDOHOSTSCOMS)
|
||||
@ -21,7 +20,7 @@
|
||||
|
||||
(* ;; "Internals")
|
||||
|
||||
(FNS EXPAND.PH CONTRACT.PH SLASHIT UNSLASHIT GETHOSTINFO.PH)
|
||||
(FNS EXPAND.PH CONTRACT.PH UNSLASHIT GETHOSTINFO.PH)
|
||||
(FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH
|
||||
OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH
|
||||
SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH)
|
||||
@ -42,6 +41,8 @@
|
||||
(PSEUDOHOST
|
||||
[LAMBDA (HOST PREFIX)
|
||||
|
||||
(* ;; "Edited 22-Sep-2023 15:29 by rmk")
|
||||
|
||||
(* ;; "Edited 25-Jun-2022 17:00 by rmk")
|
||||
|
||||
(* ;; "Edited 24-Feb-2022 23:56 by rmk: Expand prefix so that it is rooted in a real host and not a previously defined pseudohost.")
|
||||
@ -81,7 +82,7 @@
|
||||
(SELECTQ TARGETHOST
|
||||
((DSK CORE)
|
||||
(SETQ PREFIX (UNSLASHIT PREFIX)))
|
||||
(UNIX (SETQ PREFIX (SLASHIT PREFIX)))
|
||||
(UNIX (SETQ PREFIX (SLASHIT PREFIX)))
|
||||
NIL)
|
||||
(SETQ TARGETDEVICE (OR (\GETDEVICEFROMHOSTNAME TARGETHOST)
|
||||
(ERROR "UNKNOWN TARGET HOST" TARGETHOST)))
|
||||
@ -153,26 +154,32 @@
|
||||
(FETCH (FDEV DEVICENAME) OF (FETCH (PHDEVICE TARGETDEV) OF (\GETDEVICEFROMNAME HOST))))])
|
||||
|
||||
(TRUEFILENAME
|
||||
[LAMBDA (FILE) (* ; "Edited 26-Jan-2022 23:33 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 26-Jul-2023 07:53 by rmk")
|
||||
(* ; "Edited 26-Jan-2022 23:33 by rmk")
|
||||
(* ; "Edited 25-Jan-2022 08:47 by rmk")
|
||||
(LET (FILENAME DEVICE)
|
||||
(IF (STREAMP FILE)
|
||||
THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE))
|
||||
(SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE))
|
||||
ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE))
|
||||
(SETQ DEVICE (\GETDEVICEFROMNAME FILENAME)))
|
||||
(CL:IF (TYPE? PHDEVICE DEVICE)
|
||||
(EXPAND.PH FILENAME DEVICE)
|
||||
FILENAME)])
|
||||
(if (LISTP FILE)
|
||||
then (for F in FILE collect (TRUEFILENAME F))
|
||||
else (LET (FILENAME DEVICE)
|
||||
(IF (STREAMP FILE)
|
||||
THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE))
|
||||
(SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE))
|
||||
ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE))
|
||||
(SETQ DEVICE (\GETDEVICEFROMNAME FILENAME)))
|
||||
(CL:IF (TYPE? PHDEVICE DEVICE)
|
||||
(EXPAND.PH FILENAME DEVICE)
|
||||
FILENAME)])
|
||||
|
||||
(PSEUDOFILENAME
|
||||
[LAMBDA (FILE) (* ; "Edited 29-Jan-2022 23:08 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 26-Jul-2023 12:34 by rmk")
|
||||
(* ; "Edited 29-Jan-2022 23:08 by rmk")
|
||||
(* ; "Edited 28-Jan-2022 09:06 by rmk")
|
||||
(FOR D PN (FILENAME _ (IF (STREAMP FILE)
|
||||
THEN (FETCH (STREAM FULLFILENAME) OF FILE)
|
||||
ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES
|
||||
WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D)))
|
||||
DO (RETURN PN) FINALLY (RETURN FILENAME])
|
||||
(if (LISTP FILE)
|
||||
then (for F in FILE collect (PSEUDOFILENAME F))
|
||||
else (FOR D PN (FILENAME _ (IF (STREAMP FILE)
|
||||
THEN (FETCH (STREAM FULLFILENAME) OF FILE)
|
||||
ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES
|
||||
WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D)))
|
||||
DO (RETURN PN) FINALLY (RETURN FILENAME])
|
||||
)
|
||||
|
||||
|
||||
@ -209,6 +216,8 @@
|
||||
(CONTRACT.PH
|
||||
[LAMBDA (NAME PHDEV)
|
||||
|
||||
(* ;; "Edited 22-Sep-2023 14:30 by rmk")
|
||||
|
||||
(* ;; "Edited 30-Jan-2022 00:20 by rmk: the smallest pseudoname for NAME. If the NAME was constructed by expanding, then")
|
||||
|
||||
(* ;; "Finds the smallest pseudoname for NAME. The PHDEV is used only to find its targetdev, that's where we scan for matching prefixes. This is so we can find the lowest matching pseudohost in the target's prefix map. If the hosts are defined as {DSK}...{H1}...{H2}, DSK knows the prefixes that lead to H1 and H2, picks the longest matching prefix and replaces it by the corresponding host.")
|
||||
@ -234,7 +243,7 @@
|
||||
|
||||
(SETQ CONNECTOR (CADDR PM))
|
||||
[SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/)
|
||||
THEN (SLASHIT SUFFIX)
|
||||
THEN (SLASHIT SUFFIX)
|
||||
ELSE (UNSLASHIT SUFFIX])
|
||||
(RETURN (PACK* '{ (CADR PM)
|
||||
"}"
|
||||
@ -244,31 +253,6 @@
|
||||
|
||||
(RETURN NAME)))])
|
||||
|
||||
(SLASHIT
|
||||
[LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:08 by rmk")
|
||||
(* ; "Edited 3-Jan-2022 11:44 by rmk")
|
||||
(* ; "Edited 22-Dec-2021 20:18 by rmk")
|
||||
(* ; "Edited 2-Nov-2021 22:54 by rmk:")
|
||||
(LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X)
|
||||
0]
|
||||
[SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I))
|
||||
COLLECT (SELCHARQ C
|
||||
((< >)
|
||||
(SETQ LASTDIRPOS I)
|
||||
(CHARCODE /))
|
||||
(/ (SETQ LASTDIRPOS I)
|
||||
C)
|
||||
C]
|
||||
(CL:WHEN (AND LCASEDIRS LASTDIRPOS)
|
||||
(SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
|
||||
(SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS))
|
||||
(OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS))
|
||||
""))))
|
||||
(CL:IF (EQ DIRPOS 1)
|
||||
SLASHED
|
||||
(CONCAT (SUBSTRING X 1 (SUB1 DIRPOS))
|
||||
SLASHED))])
|
||||
|
||||
(UNSLASHIT
|
||||
[LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:09 by rmk")
|
||||
(* ; "Edited 22-Dec-2021 20:18 by rmk")
|
||||
@ -527,13 +511,12 @@
|
||||
EXPORTS.ALL)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1397 9433 (PSEUDOHOST 1407 . 6966) (PSEUDOHOSTP 6968 . 7481) (PSEUDOHOSTS 7483 . 7844)
|
||||
(TARGETHOST 7846 . 8120) (TRUEFILENAME 8122 . 8809) (PSEUDOFILENAME 8811 . 9431)) (9461 17000 (
|
||||
EXPAND.PH 9471 . 10724) (CONTRACT.PH 10726 . 13391) (SLASHIT 13393 . 14961) (UNSLASHIT 14963 . 16709)
|
||||
(GETHOSTINFO.PH 16711 . 16998)) (17001 25021 (OPENFILE.PH 17011 . 18084) (GETFILENAME.PH 18086 . 18375
|
||||
) (DIRECTORYNAMEP.PH 18377 . 19001) (CLOSEFILE.PH 19003 . 19470) (REOPENFILE.PH 19472 . 20037) (
|
||||
DELETEFILE.PH 20039 . 20323) (OPENP.PH 20325 . 20620) (UNREGISTERFILE.PH 20622 . 21164) (
|
||||
REGISTERFILE.PH 21166 . 21700) (GENERATEFILES.PH 21702 . 22746) (GETFILEINFO.PH 22748 . 23050) (
|
||||
SETFILEINFO.PH 23052 . 23251) (NEXTFILEFN.PH 23253 . 23799) (FILEINFOFN.PH 23801 . 24076) (
|
||||
RENAMEFILE.PH 24078 . 25019)))))
|
||||
(FILEMAP (NIL (1315 9921 (PSEUDOHOST 1325 . 6930) (PSEUDOHOSTP 6932 . 7445) (PSEUDOHOSTS 7447 . 7808)
|
||||
(TARGETHOST 7810 . 8084) (TRUEFILENAME 8086 . 9048) (PSEUDOFILENAME 9050 . 9919)) (9949 15964 (
|
||||
EXPAND.PH 9959 . 11212) (CONTRACT.PH 11214 . 13925) (UNSLASHIT 13927 . 15673) (GETHOSTINFO.PH 15675 .
|
||||
15962)) (15965 23985 (OPENFILE.PH 15975 . 17048) (GETFILENAME.PH 17050 . 17339) (DIRECTORYNAMEP.PH
|
||||
17341 . 17965) (CLOSEFILE.PH 17967 . 18434) (REOPENFILE.PH 18436 . 19001) (DELETEFILE.PH 19003 . 19287
|
||||
) (OPENP.PH 19289 . 19584) (UNREGISTERFILE.PH 19586 . 20128) (REGISTERFILE.PH 20130 . 20664) (
|
||||
GENERATEFILES.PH 20666 . 21710) (GETFILEINFO.PH 21712 . 22014) (SETFILEINFO.PH 22016 . 22215) (
|
||||
NEXTFILEFN.PH 22217 . 22763) (FILEINFOFN.PH 22765 . 23040) (RENAMEFILE.PH 23042 . 23983)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user