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..8ab847fd 100644 Binary files a/lispusers/GITFNS.LCOM and b/lispusers/GITFNS.LCOM differ diff --git a/sources/MEDLEYDIR b/sources/MEDLEYDIR index 886f4497..d56a9720 100644 --- a/sources/MEDLEYDIR +++ b/sources/MEDLEYDIR @@ -1,12 +1,13 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "31-Jan-2026 23:43:06" {WMEDLEY}MEDLEYDIR.;44 16074 +(FILECREATED "15-Apr-2026 17:27:14" {WMEDLEY}MEDLEYDIR.;51 17370 :EDIT-BY rmk :CHANGES-TO (FNS MEDLEYDIR) + (VARS MEDLEYDIRCOMS) - :PREVIOUS-DATE "26-Nov-2025 21:51:39" {WMEDLEY}MEDLEYDIR.;43) + :PREVIOUS-DATE "15-Apr-2026 16:44:33" {WMEDLEY}MEDLEYDIR.;50) (PRETTYCOMPRINT MEDLEYDIRCOMS) @@ -15,6 +16,8 @@ [ (* ;; "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) (\SAVE.MEDLEYDIR) @@ -53,7 +56,7 @@ (CONS LOGINHOST/DIR '("INIT"] RESET) (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts" - "fonts/displayfonts") + ) NIL NIL T)) (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts" ) @@ -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 15-Apr-2026 17:13 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) (* ; + (LET (MED) + [SETQ MED (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 (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) - (* ;; "(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) (* ; @@ -268,7 +286,7 @@ (USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM)) (CONS LOGINHOST/DIR '("INIT"] RESET) - (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts" "fonts/displayfonts") + (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts") NIL NIL T)) (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts") NIL NIL T)) @@ -285,6 +303,6 @@ (ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5324 13336 (MEDLEY-INIT-VARS 5334 . 8812) (MEDLEYDIR 8814 . 12136) (MEDLEYSUBSTDIR -12138 . 13116) (SET-SYSOUT-COMMIT 13118 . 13334))))) + (FILEMAP (NIL (5517 14653 (MEDLEY-INIT-VARS 5527 . 9158) (MEDLEYDIR 9160 . 13453) (MEDLEYSUBSTDIR +13455 . 14433) (SET-SYSOUT-COMMIT 14435 . 14651))))) STOP diff --git a/sources/MEDLEYDIR.LCOM b/sources/MEDLEYDIR.LCOM index d348dc27..d6328855 100644 Binary files a/sources/MEDLEYDIR.LCOM and b/sources/MEDLEYDIR.LCOM differ