github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-03-03 18:27:44 +00:00
Code Issues Projects Releases Wiki Activity

Rework MEDLEYDIR before/after logout to substitute instead of reset (#998)

Browse Source 
* Rework MEDLEYDIR before/after logout to substitute instead of reset

* debugging

* working when changing home directory

* fix bug and removed redundtant declarations
This commit is contained in:
Larry Masinter
2022-10-24 07:10:45 -07:00
committed by GitHub
parent 32ff7b7649
commit 7a4470ce8b
3 changed files with 128 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
sources/LOADUP-INIT.LISP
View File

@@ -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")

206
sources/MEDLEYDIR
View File

@@ -1,10 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "18-Jul-2022 12:12:11" {DSK}<home>larry>medley>sources>MEDLEYDIR.;2 6649
(FILECREATED "18-Oct-2022 18:08:24" {DSK}<home>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}<home>larry>medley>sources>MEDLEYDIR.;1)
:PREVIOUS-DATE "18-Oct-2022 08:45:52" {DSK}<home>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

BIN
sources/MEDLEYDIR.LCOM
View File

Binary file not shown.