diff --git a/sources/ADIR b/sources/ADIR index 4669db0c5..444d2d8de 100644 --- a/sources/ADIR +++ b/sources/ADIR @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-May-2023 21:39:25" {DSK}c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;2 65907 +(FILECREATED "14-Sep-2023 23:20:17" {WMEDLEY}ADIR.;30 67297 - :EDIT-BY "lmm" + :EDIT-BY rmk - :CHANGES-TO (FNS OPENFILE) + :CHANGES-TO (FNS \COPYSYS) - :PREVIOUS-DATE "31-Oct-2022 23:50:03" -{DSK}c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;1) + :PREVIOUS-DATE "14-Sep-2023 22:56:19" {WMEDLEY}ADIR.;29) (PRETTYCOMPRINT ADIRCOMS) @@ -79,16 +78,18 @@ (\GETFILENAME X RECOG]) (INFILE - [LAMBDA (FILE) (* rmk%: " 3-OCT-79 14:23") - (INPUT (OPENFILE FILE 'INPUT 'OLD]) + [LAMBDA (FILE) (* ; "Edited 14-Sep-2023 22:40 by rmk") + (* rmk%: " 3-OCT-79 14:23") + (INPUT (OPENSTREAM FILE 'INPUT 'OLD]) (INFILEP [LAMBDA (FILE) (* rmk%: " 9-OCT-79 22:39") (\GETFILENAME FILE 'OLD]) (IOFILE - [LAMBDA (FILE) (* rmk%: " 5-SEP-81 13:54") - (OPENFILE FILE 'BOTH 'OLD]) + [LAMBDA (FILE) (* ; "Edited 14-Sep-2023 22:56 by rmk") + (* rmk%: " 5-SEP-81 13:54") + (OPENSTREAM FILE 'BOTH 'OLD]) (OPENFILE [LAMBDA (FILE ACCESS RECOG PARAMETERS OPTIONAL) (* ; "Edited 11-May-2023 21:05 by lmm") @@ -167,8 +168,9 @@ (RETURN STREAM]) (OUTFILE - [LAMBDA (FILE) (* rmk%: " 3-OCT-79 14:24") - (OUTPUT (OPENFILE FILE 'OUTPUT 'NEW]) + [LAMBDA (FILE) (* ; "Edited 13-Sep-2023 17:59 by rmk") + (* rmk%: " 3-OCT-79 14:24") + (OUTPUT (OPENSTREAM FILE 'OUTPUT 'NEW]) (OUTFILEP [LAMBDA (FILE) (* rmk%: " 9-OCT-79 22:39") @@ -195,50 +197,69 @@ (fetch (IFPAGE NActivePages) of \InterfacePage]) (\COPYSYS - [LAMBDA (FILE SYSNAME DONTSAVE) (* ; "Edited 31-Oct-2022 23:49 by rmk") + [LAMBDA (FILE SYSNAME DONTSAVE) (* ; "Edited 14-Sep-2023 23:19 by rmk") + (* ; "Edited 3-Jul-2023 19:21 by rmk") + (* ; "Edited 1-Jul-2023 12:34 by rmk") + (* ; "Edited 29-Jun-2023 11:41 by rmk") + (* ; "Edited 31-Oct-2022 23:49 by rmk") (* ; "Edited 16-Mar-2021 19:46 by larry") - (PROG (FULLNAME VAL TFILE THOST) + (PROG (TEMPNAME VAL TARGETFILE TARGETHOST PSEUDOHOSTP) RETRY - (SETQ FILE (PACKFILENAME.STRING 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY \CONNECTED.DIRECTORY)) - (SETQ TFILE (TRUEFILENAME FILE)) - [SELECTQ [SETQ THOST (U-CASE (FILENAMEFIELD TFILE 'HOST] - (DSK [SETQ FULLNAME (PACKFILENAME.STRING 'HOST THOST 'NAME 'tmp 'EXTENSION 'SYSOUT + + + (* ;; "RMK: Get the full target name, including version in particular for DSK, at the outset so we know what the RENAMEFILE will do and we can return that value.") + + (* ;; "We try to make the temp file on the same device, so that the RENAMEFILE (hopefully) won't do a copy. ") + + (* ;; "The reason for all this fooling around is because \FLUSHVM doesn't like version numbers.") + + (* ;; "") + + (* ;; "Perhaps we should also check the value of RENAMEFILE to make sure it succeeded?") + + (SETQ FILE (OUTFILEP (PACKFILENAME.STRING 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY + \CONNECTED.DIRECTORY))) + (SETQ PSEUDOHOSTP (PSEUDOHOSTP FILE)) (* ; + "In order to return the expected name at the end.") + (SETQ TARGETFILE (TRUEFILENAME FILE)) + [SELECTQ [SETQ TARGETHOST (U-CASE (FILENAMEFIELD TARGETFILE 'HOST] + (DSK [SETQ TEMPNAME (PACKFILENAME.STRING 'HOST TARGETHOST 'NAME 'tmp 'EXTENSION + 'SYSOUT 'BODY - (\UFS.RECOGNIZE.FILE TFILE 'NON (\GETDEVICEFROMNAME THOST] - (SETQ VAL (\FLUSHVM FULLNAME)) - (SETQ FULLNAME (RENAMEFILE FULLNAME FILE))) - (UNIX [SETQ FULLNAME (CONCAT "{" THOST "}" (\UFS.RECOGNIZE.FILE TFILE 'NON ( - \GETDEVICEFROMNAME - THOST] + (\UFS.RECOGNIZE.FILE TARGETFILE 'NON (\GETDEVICEFROMNAME + TARGETHOST] + (SETQ VAL (\FLUSHVM TEMPNAME))) + (UNIX [SETQ TEMPNAME (CONCAT "{" TARGETHOST "}" (\UFS.RECOGNIZE.FILE TARGETFILE + 'NON + (\GETDEVICEFROMNAME TARGETHOST] (* ; "\DOFLUSHVM ") - (SETQ VAL (\FLUSHVM FULLNAME)) - (SETQ FULLNAME (RENAMEFILE FULLNAME FILE))) + (SETQ VAL (\FLUSHVM TEMPNAME))) (PROGN (SETQ VAL (\FLUSHVM)) - (LET ((UNIXVAR (UNIX-GETENV "LDEDESTSYSOUT"))) + (LET ((LDEDEST (UNIX-GETENV "LDEDESTSYSOUT"))) (* ; - "\FLSUVM saves image to Unix enviroment var or lisp.virtualmem") - (SETQ FULLNAME (COPYFILE (COND - (UNIXVAR (CONCAT "{DSK}" UNIXVAR)) + "\FLUSHVM saves image to Unix enviroment var or lisp.virtualmem. LDEDEST is assumed to be DSK??") + (SETQ TEMPNAME (COPYFILE (COND + (LDEDEST (CONCAT "{DSK}" LDEDEST)) (T "{DSK}~/lisp.virtualmem")) - FILE + TARGETFILE '((TYPE BINARY] (COND - ((NULL VAL) - - (* ;; "First clause of OR is T when resuming this vmem; second is starting the sysout. Unless \COPYSYS1 itself does a \FLUSHVM, the second never returns T, yes? NIL is normal return (continuing in same image), is error return") - (* ; "Continuing in the current image") + ((NULL VAL) (* ; "Continuing in the current image") + (CL:WHEN TARGETFILE (RENAMEFILE TEMPNAME TARGETFILE)) (\DAYTIME0 \LASTUSERACTION) - (RETURN FULLNAME)) + (RETURN (CL:IF PSEUDOHOSTP + (PSEUDOFILENAME TARGETFILE) + TARGETFILE))) ((AND (SMALLP VAL) (IGREATERP 0 VAL)) (* ;  "Error occurred while making sysout.") (LISPERROR (IMINUS VAL) - FULLNAME) + TEMPNAME) (GO RETRY)) - (T (* ; "Starting sysout") + (T (* ; "Restarting sysout") (\CLEARSYSBUF T) (* ; "Get rid of any spurious typeahead") (\RESETKEYBOARD) (* ; "Enable keyhandler") - (RETURN (LIST FULLNAME]) + (RETURN (LIST (OR FILE TEMPNAME]) (\FLUSHVM [LAMBDA (MAIKO.SYSOUTFILE) (* ; "Edited 16-Mar-2021 10:59 by larry") @@ -1229,14 +1250,14 @@ (ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3175 14373 (DELFILE 3185 . 3346) (FULLNAME 3348 . 3715) (INFILE 3717 . 3865) (INFILEP -3867 . 4002) (IOFILE 4004 . 4144) (OPENFILE 4146 . 4449) (OPENSTREAM 4451 . 8791) (OUTFILE 8793 . 8944 -) (OUTFILEP 8946 . 9082) (RENAMEFILE 9084 . 9390) (SIMPLE.FINDFILE 9392 . 9802) (VMEMSIZE 9804 . 9971) - (\COPYSYS 9973 . 13092) (\FLUSHVM 13094 . 14166) (\LOGOUT0 14168 . 14371)) (14831 36736 ( -UNPACKFILENAME.STRING 14841 . 34115) (\UPF.DIRECTORY 34117 . 36734)) (38264 40936 (UNPACKFILENAME -38274 . 38460) (LASTCHPOS 38462 . 39156) (FILENAMEFIELD 39158 . 39643) (FILENAMEFIELD.STRING 39645 . -40224) (PACKFILENAME 40226 . 40569) (PACKFILENAME.STRING 40571 . 40934)) (55406 56319 ( -FILEDIRCASEARRAY 55416 . 56317)) (56486 63666 (LOGOUT 56496 . 57413) (MAKESYS 57415 . 59044) (SYSOUT -59046 . 60598) (SAVEVM 60600 . 61400) (HERALD 61402 . 61562) (INTERPRET.REM.CM 61564 . 63289) ( -\USEREVENT 63291 . 63664)) (63848 65575 (USERNAME 63858 . 64814) (SETUSERNAME 64816 . 65573))))) + (FILEMAP (NIL (3106 15763 (DELFILE 3116 . 3277) (FULLNAME 3279 . 3646) (INFILE 3648 . 3907) (INFILEP +3909 . 4044) (IOFILE 4046 . 4297) (OPENFILE 4299 . 4602) (OPENSTREAM 4604 . 8944) (OUTFILE 8946 . 9208 +) (OUTFILEP 9210 . 9346) (RENAMEFILE 9348 . 9654) (SIMPLE.FINDFILE 9656 . 10066) (VMEMSIZE 10068 . +10235) (\COPYSYS 10237 . 14482) (\FLUSHVM 14484 . 15556) (\LOGOUT0 15558 . 15761)) (16221 38126 ( +UNPACKFILENAME.STRING 16231 . 35505) (\UPF.DIRECTORY 35507 . 38124)) (39654 42326 (UNPACKFILENAME +39664 . 39850) (LASTCHPOS 39852 . 40546) (FILENAMEFIELD 40548 . 41033) (FILENAMEFIELD.STRING 41035 . +41614) (PACKFILENAME 41616 . 41959) (PACKFILENAME.STRING 41961 . 42324)) (56796 57709 ( +FILEDIRCASEARRAY 56806 . 57707)) (57876 65056 (LOGOUT 57886 . 58803) (MAKESYS 58805 . 60434) (SYSOUT +60436 . 61988) (SAVEVM 61990 . 62790) (HERALD 62792 . 62952) (INTERPRET.REM.CM 62954 . 64679) ( +\USEREVENT 64681 . 65054)) (65238 66965 (USERNAME 65248 . 66204) (SETUSERNAME 66206 . 66963))))) STOP diff --git a/sources/ADIR.LCOM b/sources/ADIR.LCOM index 3da091708..f77f1d8a7 100644 Binary files a/sources/ADIR.LCOM and b/sources/ADIR.LCOM differ diff --git a/sources/MEDLEYDIR b/sources/MEDLEYDIR index 9f9369e90..6ba2a631c 100644 --- a/sources/MEDLEYDIR +++ b/sources/MEDLEYDIR @@ -1,11 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "22-Nov-2022 20:50:20" {DSK}frank>il>medley>wmedley>sources>MEDLEYDIR.;10 10271 +(FILECREATED "29-Jun-2023 22:48:12" {WMEDLEY}MEDLEYDIR.;20 10663 - :CHANGES-TO (FNS MEDLEY-INIT-VARS) + :EDIT-BY rmk - :PREVIOUS-DATE "21-Nov-2022 17:31:30" {DSK}frank>il>medley>wmedley>sources>MEDLEYDIR.;9 -) + :CHANGES-TO (FNS MEDLEYDIR) + + :PREVIOUS-DATE "22-Nov-2022 20:50:20" {WMEDLEY}MEDLEYDIR.;17) (PRETTYCOMPRINT MEDLEYDIRCOMS) @@ -95,16 +96,22 @@ NIL]) (MEDLEYDIR - [LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 18-Oct-2022 17:49 by lmm") + [LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 29-Jun-2023 22:48 by rmk") + (* ; "Edited 18-Oct-2022 17:49 by lmm") (* ; "Edited 5-Mar-2022 12:43 by larry") (* ; "Edited 2-Dec-2021 20:23 by kaplan") + + (* ;; "RMK: MEDLEYDIR defaults to DSK") + (COND ((NULL DIRNAME) (if (OR (NOT (BOUNDP 'MEDLEYDIR)) (NOT MEDLEYDIR)) - then (OR (SETQ MEDLEYDIR (DIRECTORYNAME (OR (UNIX-GETENV "MEDLEYDIR") - T))) - (DIRECTORYNAME T)) + then [SETQ MEDLEYDIR (DIRECTORYNAME (if (SETQ MEDLEYDIR (UNIX-GETENV "MEDLEYDIR")) + then (DIRECTORYNAME (PACKFILENAME 'BODY MEDLEYDIR + 'HOST + 'DSK)) + else (DIRECTORYNAME T] elseif (STRPOS "/" MEDLEYDIR) then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR)) else MEDLEYDIR)) @@ -201,6 +208,6 @@ (ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1469 7896 (MEDLEY-INIT-VARS 1479 . 4957) (MEDLEYDIR 4959 . 6914) (MEDLEYSUBSTDIR 6916 - . 7894))))) + (FILEMAP (NIL (1432 8288 (MEDLEY-INIT-VARS 1442 . 4920) (MEDLEYDIR 4922 . 7306) (MEDLEYSUBSTDIR 7308 + . 8286))))) STOP diff --git a/sources/MEDLEYDIR.LCOM b/sources/MEDLEYDIR.LCOM index 7b1a1dae5..90ecf7ee2 100644 Binary files a/sources/MEDLEYDIR.LCOM and b/sources/MEDLEYDIR.LCOM differ