diff --git a/internal/loadups/LOADUP-FULL b/internal/loadups/LOADUP-FULL index f6289eff..dd1e3e67 100644 --- a/internal/loadups/LOADUP-FULL +++ b/internal/loadups/LOADUP-FULL @@ -1,12 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "14-Feb-2026 00:42:39" {WMEDLEY}loadups>LOADUP-FULL.;38 5967 +(FILECREATED "16-Apr-2026 09:37:27" {WMEDLEY}loadups>LOADUP-FULL.;46 5817 :EDIT-BY rmk - :CHANGES-TO (FNS LOADUP-FULL) + :CHANGES-TO (FNS LOADFULLFONTS) - :PREVIOUS-DATE "13-Feb-2026 00:47:52" {WMEDLEY}loadups>LOADUP-FULL.;37) + :PREVIOUS-DATE "14-Feb-2026 00:42:39" {WMEDLEY}loadups>LOADUP-FULL.;38) (PRETTYCOMPRINT LOADUP-FULLCOMS) @@ -16,7 +16,8 @@ (DEFINEQ (LOADFULLFONTS - [LAMBDA NIL (* ; "Edited 20-Sep-2025 14:17 by rmk") + [LAMBDA NIL (* ; "Edited 16-Apr-2026 09:37 by rmk") + (* ; "Edited 20-Sep-2025 14:17 by rmk") (* ; "Edited 2-Sep-2025 20:06 by rmk") (* ; "Edited 13-Jul-2025 11:40 by rmk") (* ; "Edited 30-Jun-2025 00:04 by rmk") @@ -27,11 +28,8 @@ (* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q") - (PRINTOUT T "Loading FULL fonts..." T) + (PRINTOUT T T "Loading FULL fonts..." T) (SETQ *POSTSCRIPT-FILE-TYPE* 'TEXT) - - (* ;; "Previous code reset the coercion variables to NIL, which would have resulted in glyph-incomplete charsets. With Medley-formatted fonts, the completions have already been installed in the files and there is no need to deal with those variables.") - (for FAMILY in '(CLASSIC MODERN TERMINAL) do (PRINTOUT T " Loading " FAMILY " ") [for SIZE in '(8 10 12) @@ -103,5 +101,5 @@ (FIXMETA) (DECLARE%: DONTCOPY - (FILEMAP (NIL (456 5929 (LOADFULLFONTS 466 . 2601) (LOADUP-FULL 2603 . 5679) (FIXMETA 5681 . 5927))))) + (FILEMAP (NIL (458 5779 (LOADFULLFONTS 468 . 2451) (LOADUP-FULL 2453 . 5529) (FIXMETA 5531 . 5777))))) STOP diff --git a/internal/loadups/LOADUP-FULL.LCOM b/internal/loadups/LOADUP-FULL.LCOM index b6d976e2..51592668 100644 Binary files a/internal/loadups/LOADUP-FULL.LCOM and b/internal/loadups/LOADUP-FULL.LCOM differ diff --git a/internal/loadups/LOADUP-LISP b/internal/loadups/LOADUP-LISP index ff8633bd..b681d3ac 100644 --- a/internal/loadups/LOADUP-LISP +++ b/internal/loadups/LOADUP-LISP @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "XCL" :BASE 10) -(FILECREATED " 5-Apr-2026 21:35:35" |{WMEDLEY}loadups>LOADUP-LISP.;30| 7659 +(FILECREATED "16-Apr-2026 09:06:26" |{WMEDLEY}loadups>LOADUP-LISP.;32| 7864 :EDIT-BY |rmk| :CHANGES-TO (FNS LOADUP-LISP) - :PREVIOUS-DATE "26-Mar-2026 18:38:22" |{WMEDLEY}loadups>LOADUP-LISP.;29|) + :PREVIOUS-DATE "15-Apr-2026 23:27:22" |{WMEDLEY}loadups>LOADUP-LISP.;31|) (PRETTYCOMPRINT LOADUP-LISPCOMS) @@ -19,7 +19,8 @@ (DEFINEQ (LOADUP-LISP - (LAMBDA (DRIBBLEFILE) (* \; "Edited 5-Apr-2026 21:35 by rmk") + (LAMBDA (DRIBBLEFILE) (* \; "Edited 16-Apr-2026 09:06 by rmk") + (* \; "Edited 5-Apr-2026 21:35 by rmk") (* \; "Edited 26-Mar-2026 18:38 by briggs") (* \; "Edited 22-Feb-2026 14:15 by rmk") (* \; "Edited 28-Jan-2026 14:30 by lmm") @@ -37,15 +38,15 @@ (* \; "Edited 13-Jul-2022 14:09 by rmk") (* \; "Edited 4-Mar-2022 19:13 by larry") (* \; "Edited 29-Apr-2021 22:30 by rmk:") - (SETQQ COMPILE.EXT LCOM) - (MEDLEY-INIT-VARS) (* \; "should be set earlier") + (SETQQ COMPILE.EXT LCOM) (* (MEDLEY-INIT-VARS) + (* \; "should be set earlier")) (DRIBBLE DRIBBLEFILE) (FOR X IN BOOTLOADEDFILES DO (CL:UNLESS (MEMB X SYSFILES) (PRINTOUT T X " bootloaded" T) (SETQ SYSFILES (CONS X SYSFILES)))) (SETQ BOOTLOADEDFILES NIL) (IF (NOT (BOUNDP 'DIRECTORIES)) - THEN (SETQ DIRECTORIES LOADUPDIRECTORIES)) + THEN (SETQ DIRECTORIES LOADUPDIRECTORIES)) (* (LOADUP (QUOTE (PSEUDOHOSTS)))) (* |;;| "following files are really loaded earlier, this call to LOADUP just cleans up") @@ -109,7 +110,7 @@ (LOADUP '(DSK UFS UFSCALLC MAIKOBITBLT)) (LOADUP '(TIME)) (LOADUP '(BRKDWN)) - (LOADUP '(LOGOW IDLER UNIXUTILS PSEUDOHOSTS HARDCOPY ICONW FREEMENU SEDIT)) + (LOADUP '(LOGOW IDLER UNIXUTILS HARDCOPY ICONW FREEMENU SEDIT)) (LOADUP '(XCL-EXTRAS)) (* |;;| "CMLPACKAGE pushes onto INSPECTMACROS") @@ -150,5 +151,5 @@ (GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (640 7453 (LOADUP-LISP 650 . 7451))))) + (FILEMAP (NIL (640 7658 (LOADUP-LISP 650 . 7656))))) STOP diff --git a/internal/loadups/LOADUP-LISP.LCOM b/internal/loadups/LOADUP-LISP.LCOM index 6947611a..e13f8ab0 100644 Binary files a/internal/loadups/LOADUP-LISP.LCOM and b/internal/loadups/LOADUP-LISP.LCOM differ diff --git a/lispusers/GITFNS b/lispusers/GITFNS index 035519af..f896708f 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) -(FILECREATED "16-Mar-2026 12:05:55" {WMEDLEY}GITFNS.;578 134065 +(FILECREATED "15-Apr-2026 16:34:48" {WMEDLEY}GITFNS.;579 134228 :EDIT-BY rmk - :CHANGES-TO (FNS GIT-BRANCH-WHENSELECTEDFN PRC-COMMAND) + :CHANGES-TO (FNS GIT-MAKE-PROJECT) - :PREVIOUS-DATE " 2-Mar-2026 14:00:13" {WMEDLEY}GITFNS.;576) + :PREVIOUS-DATE "16-Mar-2026 12:05:55" {WMEDLEY}GITFNS.;578) (PRETTYCOMPRINT GITFNSCOMS) @@ -169,6 +169,7 @@ (GIT-MAKE-PROJECT [LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS) + (* ; "Edited 15-Apr-2026 16:33 by rmk") (* ; "Edited 25-Feb-2026 23:25 by rmk") (* ; "Edited 25-Oct-2025 16:53 by rmk") (* ; "Edited 22-Oct-2025 12:45 by rmk") @@ -275,7 +276,8 @@ "for " PROJECTNAME] (SETQ PROJECT (create GIT-PROJECT PROJECTNAME ← PROJECTNAME - GITHOST ← (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH) + GITHOST ← (PACK* "{" (PSEUDOHOST (CONCAT "G" PROJECTNAME) + CLONEPATH) "}") WHOST ← (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W" PROJECTNAME) @@ -2429,33 +2431,33 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4197 21075 (GIT-CLONEP 4207 . 5638) (GIT-INIT 5640 . 6270) (GIT-MAKE-PROJECT 6272 . -14129) (GIT-GET-PROJECT 14131 . 16056) (GIT-PUT-PROJECT-FIELD 16058 . 17699) (GIT-PROJECT-PATH 17701 - . 18745) (FIND-ANCESTOR-DIRECTORY 18747 . 19098) (GIT-FIND-CLONE 19100 . 20183) (GIT-MAINBRANCH 20185 - . 20580) (GIT-MAINBRANCH? 20582 . 21073)) (26538 31832 (PRC-COMMAND 26548 . 31830)) (31888 34676 ( -ALLSUBDIRS 31898 . 33184) (MEDLEYSUBDIRS 33186 . 33879) (GITSUBDIRS 33881 . 34674)) (34677 37082 ( -TOGIT 34687 . 36095) (FROMGIT 36097 . 37080)) (37083 40093 (MYMEDLEYSUBDIR 37093 . 37549) (GITSUBDIR -37551 . 37994) (STRIPDIR 37996 . 38374) (STRIPHOST 38376 . 38616) (STRIPNAME 38618 . 39371) ( -STRIPWHERE 39373 . 40091)) (40094 42329 (GFILE4MFILE 40104 . 40800) (MFILE4GFILE 40802 . 41371) ( -GIT-REPO-FILENAME 41373 . 42327)) (42378 52635 (GIT-COMMIT 42388 . 43214) (GIT-PUSH 43216 . 43976) ( -GIT-PULL 43978 . 44730) (GIT-APPROVAL 44732 . 45081) (GIT-GET-FILE 45083 . 46998) (GIT-FILE-EXISTS? -47000 . 47274) (GIT-REMOTE-UPDATE 47276 . 48111) (GIT-REMOTE-ADD 48113 . 48420) (GIT-FILE-DATE 48422 - . 49469) (GIT-FILE-HISTORY 49471 . 51405) (GIT-PRINT-FILE-HISTORY 51407 . 52459) (GIT-FETCH 52461 . -52633)) (52665 64617 (GIT-BRANCH-DIFF 52675 . 59564) (GIT-COMMIT-DIFFS 59566 . 60457) ( -GIT-BRANCH-RELATIONS 60459 . 64143) (GIT-MODIFIED 64145 . 64615)) (64662 83597 (GIT-BRANCH-NUM 64672 - . 65245) (GIT-CHECKOUT 65247 . 66533) (GIT-WHICH-BRANCH 66535 . 66942) (GIT-MAKE-BRANCH 66944 . 69523 -) (GIT-BRANCHES 69525 . 72122) (GIT-BRANCH-EXISTS? 72124 . 72995) (GIT-PICK-BRANCH 72997 . 73487) ( -GIT-BRANCH-MENU 73489 . 74378) (GIT-BRANCH-WHENSELECTEDFN 74380 . 76087) (GIT-PULL-REQUESTS 76089 . -79974) (GIT-SHORT-BRANCH-NAME 79976 . 80267) (GIT-LONG-NAME 80269 . 80586) (GIT-PRC-BRANCHES 80588 . -83595)) (83627 88381 (GIT-MY-CURRENT-BRANCH 83637 . 84007) (GIT-MY-BRANCHP 84009 . 84627) ( -GIT-MY-NEXT-BRANCH 84629 . 86429) (GIT-MY-BRANCHES 86431 . 88379)) (88427 92511 (GIT-ADD-WORKTREE -88437 . 90044) (GIT-REMOVE-WORKTREE 90046 . 90978) (GIT-LIST-WORKTREES 90980 . 91791) (WORKTREEDIR -91793 . 92509)) (92559 125597 (GIT-GET-DIFFERENT-FILES 92569 . 99477) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 99479 . 107118) (GIT-WORKING-COMPARE-DIRECTORIES 107120 . 112922) ( -GIT-COMPARE-WORKTREE 112924 . 116902) (GITCDOBJBUTTONFN 116904 . 121402) (GIT-CD-LABELFN 121404 . -122490) (GIT-CD-MENUFN 122492 . 123578) (GIT-WORKING-COMPARE-FILES 123580 . 124200) ( -GIT-BRANCHES-COMPARE-FILES 124202 . 125366) (GIT-PR-COMPARE 125368 . 125595)) (125667 133998 (CDGITDIR - 125677 . 126364) (GIT-COMMAND 126366 . 127924) (GITORIGIN 127926 . 128623) (GIT-INITIALS 128625 . -128929) (GIT-COMMAND-TO-FILE 128931 . 132416) (GIT-RESULT-TO-LINES 132418 . 133331) (STRIPLOCAL 133333 - . 133996))))) + (FILEMAP (NIL (4176 21238 (GIT-CLONEP 4186 . 5617) (GIT-INIT 5619 . 6249) (GIT-MAKE-PROJECT 6251 . +14292) (GIT-GET-PROJECT 14294 . 16219) (GIT-PUT-PROJECT-FIELD 16221 . 17862) (GIT-PROJECT-PATH 17864 + . 18908) (FIND-ANCESTOR-DIRECTORY 18910 . 19261) (GIT-FIND-CLONE 19263 . 20346) (GIT-MAINBRANCH 20348 + . 20743) (GIT-MAINBRANCH? 20745 . 21236)) (26701 31995 (PRC-COMMAND 26711 . 31993)) (32051 34839 ( +ALLSUBDIRS 32061 . 33347) (MEDLEYSUBDIRS 33349 . 34042) (GITSUBDIRS 34044 . 34837)) (34840 37245 ( +TOGIT 34850 . 36258) (FROMGIT 36260 . 37243)) (37246 40256 (MYMEDLEYSUBDIR 37256 . 37712) (GITSUBDIR +37714 . 38157) (STRIPDIR 38159 . 38537) (STRIPHOST 38539 . 38779) (STRIPNAME 38781 . 39534) ( +STRIPWHERE 39536 . 40254)) (40257 42492 (GFILE4MFILE 40267 . 40963) (MFILE4GFILE 40965 . 41534) ( +GIT-REPO-FILENAME 41536 . 42490)) (42541 52798 (GIT-COMMIT 42551 . 43377) (GIT-PUSH 43379 . 44139) ( +GIT-PULL 44141 . 44893) (GIT-APPROVAL 44895 . 45244) (GIT-GET-FILE 45246 . 47161) (GIT-FILE-EXISTS? +47163 . 47437) (GIT-REMOTE-UPDATE 47439 . 48274) (GIT-REMOTE-ADD 48276 . 48583) (GIT-FILE-DATE 48585 + . 49632) (GIT-FILE-HISTORY 49634 . 51568) (GIT-PRINT-FILE-HISTORY 51570 . 52622) (GIT-FETCH 52624 . +52796)) (52828 64780 (GIT-BRANCH-DIFF 52838 . 59727) (GIT-COMMIT-DIFFS 59729 . 60620) ( +GIT-BRANCH-RELATIONS 60622 . 64306) (GIT-MODIFIED 64308 . 64778)) (64825 83760 (GIT-BRANCH-NUM 64835 + . 65408) (GIT-CHECKOUT 65410 . 66696) (GIT-WHICH-BRANCH 66698 . 67105) (GIT-MAKE-BRANCH 67107 . 69686 +) (GIT-BRANCHES 69688 . 72285) (GIT-BRANCH-EXISTS? 72287 . 73158) (GIT-PICK-BRANCH 73160 . 73650) ( +GIT-BRANCH-MENU 73652 . 74541) (GIT-BRANCH-WHENSELECTEDFN 74543 . 76250) (GIT-PULL-REQUESTS 76252 . +80137) (GIT-SHORT-BRANCH-NAME 80139 . 80430) (GIT-LONG-NAME 80432 . 80749) (GIT-PRC-BRANCHES 80751 . +83758)) (83790 88544 (GIT-MY-CURRENT-BRANCH 83800 . 84170) (GIT-MY-BRANCHP 84172 . 84790) ( +GIT-MY-NEXT-BRANCH 84792 . 86592) (GIT-MY-BRANCHES 86594 . 88542)) (88590 92674 (GIT-ADD-WORKTREE +88600 . 90207) (GIT-REMOVE-WORKTREE 90209 . 91141) (GIT-LIST-WORKTREES 91143 . 91954) (WORKTREEDIR +91956 . 92672)) (92722 125760 (GIT-GET-DIFFERENT-FILES 92732 . 99640) ( +GIT-BRANCHES-COMPARE-DIRECTORIES 99642 . 107281) (GIT-WORKING-COMPARE-DIRECTORIES 107283 . 113085) ( +GIT-COMPARE-WORKTREE 113087 . 117065) (GITCDOBJBUTTONFN 117067 . 121565) (GIT-CD-LABELFN 121567 . +122653) (GIT-CD-MENUFN 122655 . 123741) (GIT-WORKING-COMPARE-FILES 123743 . 124363) ( +GIT-BRANCHES-COMPARE-FILES 124365 . 125529) (GIT-PR-COMPARE 125531 . 125758)) (125830 134161 (CDGITDIR + 125840 . 126527) (GIT-COMMAND 126529 . 128087) (GITORIGIN 128089 . 128786) (GIT-INITIALS 128788 . +129092) (GIT-COMMAND-TO-FILE 129094 . 132579) (GIT-RESULT-TO-LINES 132581 . 133494) (STRIPLOCAL 133496 + . 134159))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 03bd1bb9..a7ef1464 100644 Binary files a/lispusers/GITFNS.LCOM and b/lispusers/GITFNS.LCOM differ diff --git a/sources/FILESETS b/sources/FILESETS index d256c409..23b3f4f1 100644 --- a/sources/FILESETS +++ b/sources/FILESETS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED " 9-Mar-2026 12:36:02" {WMEDLEY}FILESETS.;33 6251 +(FILECREATED "16-Apr-2026 09:01:52" {WMEDLEY}FILESETS.;34 6272 :EDIT-BY rmk :CHANGES-TO (VARS 1LISPSET) - :PREVIOUS-DATE "23-Feb-2026 10:32:36" {WMEDLEY}FILESETS.;32) + :PREVIOUS-DATE " 9-Mar-2026 12:36:02" {WMEDLEY}FILESETS.;33) (PRETTYCOMPRINT FILESETSCOMS) @@ -57,9 +57,9 @@ (ASTACK DTDECLARE ATBL LLCODE ACODE COREIO AOFD ADIR PMAP VANILLADISK ATERM APRINT ABASIC AERROR AINTERRUPT MISC BOOTSTRAP CMLMACROS CMLEVAL CMLPROGV CMLSPECIALFORMS LLRESTART LLERROR LLSYMBOL LLPACKAGE PACKAGE-STARTUP CONDITION-PACKAGE XCL-PACKAGE PROC CMLARRAY - DSK UFS UFSCALLC PASSWORDS FONT MEDLEYFONTFORMAT MCCSFONTS APUTDQ COMPATIBILITY DMISC - CMLMACROS CMLLIST CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS MAIKOBITBLT MAIKOINIT - LLDISPLAY)) + DSK UFS UFSCALLC PASSWORDS MEDLEYDIR PSEUDOHOSTS FONT MEDLEYFONTFORMAT MCCSFONTS APUTDQ + COMPATIBILITY DMISC CMLMACROS CMLLIST CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS + MAIKOBITBLT MAIKOINIT LLDISPLAY)) (RPAQQ 2LISPSET (MACHINEINDEPENDENT)) diff --git a/sources/MEDLEYDIR b/sources/MEDLEYDIR index 1d372b0d..c5450bc3 100644 --- a/sources/MEDLEYDIR +++ b/sources/MEDLEYDIR @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "13-Apr-2026 15:57:26" {WMEDLEY}MEDLEYDIR.;48 16038 +(FILECREATED "16-Apr-2026 11:06:53" {WMEDLEY}MEDLEYDIR.;53 17488 :EDIT-BY rmk - :CHANGES-TO (VARS MEDLEYDIRCOMS) + :CHANGES-TO (FNS MEDLEYDIR) + (VARS MEDLEYDIRCOMS) - :PREVIOUS-DATE "22-Mar-2026 09:52:47" {WMEDLEY}MEDLEYDIR.;46) + :PREVIOUS-DATE "15-Apr-2026 17:27:14" {WMEDLEY}MEDLEYDIR.;51) (PRETTYCOMPRINT MEDLEYDIRCOMS) @@ -15,8 +16,10 @@ [ (* ;; "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)") + (P (MOVD? 'EVQ 'PSEUDOHOST)) + (* ; "For loadup") (FNS MEDLEY-INIT-VARS MEDLEYDIR MEDLEYSUBSTDIR SET-SYSOUT-COMMIT) - [INITVARS (MEDLEYDIR) + [INITVARS (MEDLEYDIR (MEDLEYDIR)) (\SAVE.MEDLEYDIR) (SYSOUTCOMMITS (OR (AND (BOUNDP 'SYSOUTCOMMITS) SYSOUTCOMMITS) @@ -75,10 +78,18 @@ "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)" ) + +(MOVD? 'EVQ 'PSEUDOHOST) + + + +(* ; "For loadup") + (DEFINEQ (MEDLEY-INIT-VARS - [LAMBDA (EVENT) (* ; "Edited 22-Nov-2022 20:38 by FGH") + [LAMBDA (EVENT) (* ; "Edited 15-Apr-2026 16:44 by rmk") + (* ; "Edited 22-Nov-2022 20:38 by FGH") (* ; "Edited 21-Nov-2022 17:31 by FGH") (* ; "Edited 21-Nov-2022 15:39 by frank") (* ; "Edited 21-Nov-2022 14:33 by FGH") @@ -105,6 +116,7 @@ (* ;;  "Any old values, restore them, substituting the new MEDLEYDIR") + (PSEUDOHOST 'MEDLEY MEDLEYDIR) (PROG (OLDMD NEWMD SAME TMP) (IF (EQ \SAVE.MEDLEYDIR T) THEN (* ; " Already restored") @@ -139,7 +151,8 @@ NIL]) (MEDLEYDIR - [LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 31-Jan-2026 23:42 by rmk") + [LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 16-Apr-2026 11:06 by rmk") + (* ; "Edited 31-Jan-2026 23:42 by rmk") (* ; "Edited 23-Aug-2025 17:21 by lmm") (* ; "Edited 18-Aug-2025 11:15 by FGH") (* ; "Edited 29-Jun-2023 22:48 by rmk") @@ -149,55 +162,60 @@ (* ;; "RMK: MEDLEYDIR defaults to DSK") - (COND - ((NULL DIRNAME) (* ; - "Call to (MEDLEYDIR) or (MEDLEYDIR NIL ...) just set it ") - (if (OR (NOT (BOUNDP 'MEDLEYDIR)) - (NOT MEDLEYDIR)) - then (SETQ MEDLEYDIR (DIRECTORYNAME (if (SETQ MEDLEYDIR (UNIX-GETENV "MEDLEYDIR")) - then (PACKFILENAME 'BODY MEDLEYDIR 'HOST - 'DSK) - else T))) - elseif (STRPOS "/" MEDLEYDIR) - then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR)) - else MEDLEYDIR)) - ((LISTP DIRNAME) + (if (NULL DIRNAME) + then (* ; + "Call to (MEDLEYDIR) or (MEDLEYDIR NIL ...) just set it--Don't want MEDLEYDIR to be {MEDLEY}.") + (if (OR (NOT (BOUNDP 'MEDLEYDIR)) + (NOT MEDLEYDIR)) + then (SETQ MEDLEYDIR (DIRECTORYNAME (if (SETQ MEDLEYDIR (UNIX-GETENV "MEDLEYDIR")) + then (PACKFILENAME 'BODY MEDLEYDIR + 'HOST + 'DSK) + else T))) + elseif (STRPOS "/" MEDLEYDIR) + then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR)) + else MEDLEYDIR) + else (LET (MED) + [SETQ MED (COND + ((LISTP DIRNAME) - (* ;; "(MEDLEYDIR a list -- recurse") + (* ;; "(MEDLEYDIR a list -- recurse") - (for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) collect Y)) - [FILENAME + (for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) + collect Y)) + [FILENAME - (* ;; " if FILENAME, find it as a file. ") + (* ;; " if FILENAME, find it as a file. ") - (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] - ((EQUAL DIRNAME "login") (* ; "special case for login dir") - (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") - (UNIX-GETENV "HOME") - DIRNAME))) - [(EQUAL DIRNAME "loadups") (* ; "special case for loadups dir") - (OR (DIRECTORYNAME (UNIX-GETENV "MEDLEYLOADUPSDIR")) - (DIRECTORYNAME (CONCAT (MEDLEYDIR) - "loadups" ">") - NIL OUTPUT) - (if NOERROR - then NIL - else (ERROR "Cannot find medley loadups directory" (MEDLEYDIR] - (T (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR) - DIRNAME ">") - NIL OUTPUT) - (if NOERROR - then NIL - else (ERROR "No such medley directory" DIRNAME]) + (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] + ((EQUAL DIRNAME "login") (* ; "special case for login dir") + (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") + (UNIX-GETENV "HOME") + DIRNAME))) + [(EQUAL DIRNAME "loadups") (* ; "special case for loadups dir") + (OR (DIRECTORYNAME (UNIX-GETENV "MEDLEYLOADUPSDIR")) + (DIRECTORYNAME (CONCAT (MEDLEYDIR) + "loadups" ">") + NIL OUTPUT) + (if NOERROR + then NIL + else (ERROR "Cannot find medley loadups directory" (MEDLEYDIR] + (T (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR) + DIRNAME ">") + NIL OUTPUT) + (if NOERROR + then NIL + else (ERROR "No such medley directory" DIRNAME] + (CL:WHEN MED (PSEUDOFILENAME MED]) (MEDLEYSUBSTDIR [LAMBDA (OLD NEW BODY) (* ; @@ -227,7 +245,7 @@ SYSOUTCOMMITS]) ) -(RPAQ? MEDLEYDIR ) +(RPAQ? MEDLEYDIR (MEDLEYDIR)) (RPAQ? \SAVE.MEDLEYDIR ) @@ -285,6 +303,6 @@ (ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5309 13321 (MEDLEY-INIT-VARS 5319 . 8797) (MEDLEYDIR 8799 . 12121) (MEDLEYSUBSTDIR -12123 . 13101) (SET-SYSOUT-COMMIT 13103 . 13319))))) + (FILEMAP (NIL (5529 14760 (MEDLEY-INIT-VARS 5539 . 9170) (MEDLEYDIR 9172 . 13560) (MEDLEYSUBSTDIR +13562 . 14540) (SET-SYSOUT-COMMIT 14542 . 14758))))) STOP diff --git a/sources/MEDLEYDIR.LCOM b/sources/MEDLEYDIR.LCOM index c784ed4e..f7cfaf91 100644 Binary files a/sources/MEDLEYDIR.LCOM and b/sources/MEDLEYDIR.LCOM differ