diff --git a/sources/LOADUP-INIT.LISP b/sources/LOADUP-INIT.LISP index 00f8fdb5..31cb03b3 100644 --- a/sources/LOADUP-INIT.LISP +++ b/sources/LOADUP-INIT.LISP @@ -1,6 +1,6 @@ (* "make init files; this file is loaded as a 'greet' file by scripts/loadup-init.sh") -(LOAD? (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM")) +(LOAD (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM")) (CNDIR (MEDLEYDIR "tmp")) (DRIBBLE "init.dribble") diff --git a/sources/MEDLEYDIR b/sources/MEDLEYDIR index 485b555f..d2f520c2 100644 --- a/sources/MEDLEYDIR +++ b/sources/MEDLEYDIR @@ -1,10 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Jul-2022 12:12:11" {DSK}larry>medley>sources>MEDLEYDIR.;2 6649 +(FILECREATED "18-Oct-2022 18:08:24" {DSK}larry>ilisp>medley>sources>MEDLEYDIR.;4 9414 - :CHANGES-TO (FNS MEDLEY-INIT-VARS) + :CHANGES-TO (VARS MEDLEYDIRCOMS) + (FNS MEDLEY-INIT-VARS MEDLEYDIR MEDLEYSUBSTDIR) - :PREVIOUS-DATE "13-Jul-2022 15:34:07" {DSK}larry>medley>sources>MEDLEYDIR.;1) + :PREVIOUS-DATE "18-Oct-2022 08:45:52" {DSK}larry>ilisp>medley>sources>MEDLEYDIR.;3) (PRETTYCOMPRINT MEDLEYDIRCOMS) @@ -13,18 +14,16 @@ [ (* ;; "set up initialization for file paths relative to where Medley is installed. This assumes that the environment variable MEDLEYDIR is set (usually by the ./run-medley script) to the (unix path) and all of the other directories variables are set relative to that (by MEDLEY-INIT-VARS)") - (FNS MEDLEY-INIT-VARS MEDLEYDIR) - (INITVARS (MEDLEYDIR)) - (ADDVARS (BEFORESYSOUTFORMS (SETQ MEDLEYDIR)) - (BEFOREMAKESYSFORMS (SETQ MEDLEYDIR)) - (AFTERSYSOUTFORMS (MEDLEY-INIT-VARS)) - (AFTERMAKESYSFORMS (MEDLEY-INIT-VARS))) + (FNS MEDLEY-INIT-VARS MEDLEYDIR MEDLEYSUBSTDIR) + (INITVARS (MEDLEYDIR) + (\SAVE.MEDLEYDIR)) + (ADDVARS (AROUNDEXITFNS MEDLEY-INIT-VARS)) - (* ;; - "NOTE: Do not use backquote in the variable definitions. These get evaluated early in the loadup.") + (* ;; "**WARNING** The EVALed expressions get run early in the lodup.") (VARS MEDLEY-INIT-VARS) - (DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS]) + (DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS + \SAVE.MEDLEYDIR DIRECTORIES]) @@ -35,85 +34,126 @@ (DEFINEQ (MEDLEY-INIT-VARS - [LAMBDA (CLEAR) (* ; "Edited 18-Jul-2022 12:11 by larry") - (* ; "Edited 21-Aug-2021 18:23 by larry") + [LAMBDA (EVENT) (* ; "Edited 18-Oct-2022 18:08 by lmm") - (* ;; "MEDLEY-INIT-VARS has variables that might need to get reset. ") + (* ;; "Called on events including before & after loadup") - (if CLEAR - then (SETQ MEDLEYDIR NIL) - (SETQ XCL::*WHERE-IS-CASH-FILES* NIL) - (for X in MEDLEY-INIT-VARS do (SET (CAR X))) - elseif [OR (NOT (BOUNDP 'MEDLEYDIR)) - (AND (NULL MEDLEYDIR) - (NULL (MEDLEYDIR] - then (PRINTOUT T "WARNING: MEDLEYDIR not set correctly" - " set it and call (MEDLEY-INIT-VARS) again" T) - else [for X in MEDLEY-INIT-VARS do (SET (CAR X) - (EVAL (CADR X] + (SELECTQ EVENT + ((T BEFOREMAKESYS) + (* ;; "Clear old values") - (* ;; "WHEREIS doesn't follow conventions") + (FOR X IN MEDLEY-INIT-VARS DO (IF (CDDR X) + THEN (SETTOPVAL (CAR X) + NIL))) + (SETQ \SAVE.MEDLEYDIR NIL)) + ((BEFORESYSOUT BEFORELOGOUT BEFORESAVEVM) + (* ;; "save old values") - [LET [(NEWSYS (STRPOS "tmp/" (UNIX-GETENV "LDESRCESYSOUT"] - (if NEWSYS - then (push DIRECTORIES (MEDLEYDIR "tmp"))) - (CL:WHEN (GETD 'XCL::ADD-WHERE-IS-DATABASE) - (SETQ XCL::*WHERE-IS-CASH-FILES* NIL) - (NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR (if NEWSYS - then "tmp" - else "loadups") - "WHEREIS.HASH"))))] - NIL]) + [SETQ \SAVE.MEDLEYDIR (CONS MEDLEYDIR (FOR X IN MEDLEY-INIT-VARS + COLLECT (CONS (CAR X) + (GETTOPVAL (CAR X]) + ((AFTERSYSOUT AFTERMAKESYS AFTERLOGOUT AFTERSAVEVM RESTART INIT NIL) + (* ;; + "Restore old values, subtituting medleydirs") + + (LET* [[OLDMD (AND \SAVE.MEDLEYDIR (U-CASE (POP \SAVE.MEDLEYDIR] + (NEWMD (PROGN (SETQ MEDLEYDIR) + (MEDLEYDIR))) + (SAME (AND OLDMD (STRING-EQUAL OLDMD NEWMD] + [for X TMP in MEDLEY-INIT-VARS + do (/SETTOPVAL (CAR X) + (IF [OR (EQ (CADDR X) + 'RESET) + (NOT (SETQ TMP (ASSOC (CAR X) + \SAVE.MEDLEYDIR] + THEN (EVAL (CADR X)) + ELSEIF SAME + THEN (CDR TMP) + ELSE (MEDLEYSUBSTDIR OLDMD NEWMD (CDR TMP] + + (* ;; "now some variables that are reset hard-coded") + + [LET [(NEWSYS (STRPOS "tmp/" (UNIX-GETENV "LDESRCESYSOUT"] + (if NEWSYS + then (push DIRECTORIES (MEDLEYDIR "tmp"))) + (CL:WHEN (GETD 'XCL::ADD-WHERE-IS-DATABASE) + (SETQ XCL::*WHERE-IS-CASH-FILES* NIL) + (NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR (if NEWSYS + then "tmp" + else "loadups") + "WHEREIS.HASH"))))] + NIL)) + (PROGN (* ; "no changes") + NIL]) (MEDLEYDIR - [LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 5-Mar-2022 12:43 by larry") + [LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 18-Oct-2022 17:49 by lmm") + (* ; "Edited 5-Mar-2022 12:43 by larry") (* ; "Edited 2-Dec-2021 20:23 by kaplan") - (DECLARE (GLOBALVARS MEDLEYDIR)) - (DECLARE (GLOBALVARS MEDLEYDIR)) - (if (NULL DIRNAME) - then (if (OR (NOT (BOUNDP 'MEDLEYDIR)) - (NOT MEDLEYDIR)) - then (OR (SETQ MEDLEYDIR (DIRECTORYNAME (OR (UNIX-GETENV "MEDLEYDIR") - T))) - (DIRECTORYNAME T)) - elseif (STRPOS "/" MEDLEYDIR) - then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR)) - else MEDLEYDIR) - elseif (LISTP DIRNAME) - then (for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) collect Y) - elseif FILENAME - then [if (NULL (SETQ DIRNAME (MEDLEYDIR DIRNAME NIL OUTPUT NOERROR))) - then (OR NOERROR (SHOULDNT)) - NIL - else (SETQ FILENAME (CONCAT DIRNAME FILENAME)) - (if OUTPUT - then FILENAME - else (OR (INFILEP FILENAME) - (if NOERROR - then NIL - else (ERROR "No such medley file" FILENAME] - else (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR) - DIRNAME ">") - NIL OUTPUT) - (if NOERROR - then NIL - else (ERROR "No such medley directory" DIRNAME]) + (COND + ((NULL DIRNAME) + (if (OR (NOT (BOUNDP 'MEDLEYDIR)) + (NOT MEDLEYDIR)) + then (OR (SETQ MEDLEYDIR (DIRECTORYNAME (OR (UNIX-GETENV "MEDLEYDIR") + T))) + (DIRECTORYNAME T)) + elseif (STRPOS "/" MEDLEYDIR) + then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR)) + else MEDLEYDIR)) + [(EQUAL DIRNAME "login") (* ; "special case for login dir") + (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") + (UNIX-GETENV "HOME"] + ((LISTP DIRNAME) + (for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) collect Y)) + [FILENAME (if (NULL (SETQ DIRNAME (MEDLEYDIR DIRNAME NIL OUTPUT NOERROR))) + then (OR NOERROR (SHOULDNT)) + NIL + else (SETQ FILENAME (CONCAT DIRNAME FILENAME)) + (if OUTPUT + then FILENAME + else (OR (INFILEP FILENAME) + (if NOERROR + then NIL + else (ERROR "No such medley file" FILENAME] + (T (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR) + DIRNAME ">") + NIL OUTPUT) + (if NOERROR + then NIL + else (ERROR "No such medley directory" DIRNAME]) + +(MEDLEYSUBSTDIR + [LAMBDA (OLD NEW BODY) (* ; + "Edited 18-Oct-2022 18:06 by lmm: assumes OLD is upper case") + (IF (NULL BODY) + THEN NIL + ELSEIF (LISTP BODY) + THEN (LET [(A (MEDLEYSUBSTDIR OLD NEW (CAR BODY))) + (D (MEDLEYSUBSTDIR OLD NEW (CDR BODY] + (IF (AND (EQ A (CAR BODY)) + (EQ D (CDR BODY))) + THEN BODY + ELSE (CONS A D))) + ELSEIF (STRINGP BODY) + THEN (IF (EQ 1 (STRPOS OLD (U-CASE BODY) + 1)) + THEN [CONCAT NEW (SUBSTRING BODY (ADD1 (NCHARS OLD] + ELSE BODY) + ELSEIF [AND (LITATOM BODY) + (EQ 1 (STRPOS OLD (U-CASE (MKSTRING BODY] + THEN [PACK* NEW (SUBSTRING BODY (ADD1 (NCHARS OLD] + ELSE BODY]) ) (RPAQ? MEDLEYDIR ) -(ADDTOVAR BEFORESYSOUTFORMS (SETQ MEDLEYDIR)) +(RPAQ? \SAVE.MEDLEYDIR ) -(ADDTOVAR BEFOREMAKESYSFORMS (SETQ MEDLEYDIR)) - -(ADDTOVAR AFTERSYSOUTFORMS (MEDLEY-INIT-VARS)) - -(ADDTOVAR AFTERMAKESYSFORMS (MEDLEY-INIT-VARS)) +(ADDTOVAR AROUNDEXITFNS MEDLEY-INIT-VARS) -(* ;; -"NOTE: Do not use backquote in the variable definitions. These get evaluated early in the loadup.") +(* ;; "**WARNING** The EVALed expressions get run early in the lodup.") (RPAQQ MEDLEY-INIT-VARS @@ -136,11 +176,19 @@ NIL NIL T)) (UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox") NIL NIL T)) - (XCL::*WHERE-IS-CASH-FILES*))) + (XCL::*WHERE-IS-CASH-FILES* NIL RESET) + (LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") + (UNIX-GETENV "HOME"))) + RESET) + (USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM)) + (CONS LOGINHOST/DIR '("INIT"] + RESET) + (XCL::*WHERE-IS-CASH-FILES* NIL RESET))) (DECLARE%: EVAL@COMPILE DOCOPY -(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS) +(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1518 4925 (MEDLEY-INIT-VARS 1528 . 3139) (MEDLEYDIR 3141 . 4923))))) + (FILEMAP (NIL (1521 7471 (MEDLEY-INIT-VARS 1531 . 4532) (MEDLEYDIR 4534 . 6489) (MEDLEYSUBSTDIR 6491 + . 7469))))) STOP diff --git a/sources/MEDLEYDIR.LCOM b/sources/MEDLEYDIR.LCOM index d840f012..fa0edc47 100644 Binary files a/sources/MEDLEYDIR.LCOM and b/sources/MEDLEYDIR.LCOM differ