Compare commits
6 Commits
mth63--Mis
...
rmk177--ME
| Author | SHA1 | Date | |
|---|---|---|---|
|
8c8b9f7c2e | ||
|
|
5383934328 | ||
|
|
c0bbc3d14c | ||
|
|
c29c3f0088 | ||
|
|
193e85e789 | ||
|
|
664fdfb468 |
@@ -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}<internal>loadups>LOADUP-FULL.;38 5967
|
||||
(FILECREATED "16-Apr-2026 09:37:27" {WMEDLEY}<internal>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}<internal>loadups>LOADUP-FULL.;37)
|
||||
:PREVIOUS-DATE "14-Feb-2026 00:42:39" {WMEDLEY}<internal>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
|
||||
|
||||
Binary file not shown.
@@ -1,14 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "XCL" :BASE 10)
|
||||
|
||||
(FILECREATED "26-Mar-2026 18:38:22"
|
||||
|{DSK}<Users>briggs>Projects>medley>internal>loadups>LOADUP-LISP.;14| 7604
|
||||
(FILECREATED "16-Apr-2026 10:29:26" |{MEDLEY}<internal>loadups>LOADUP-LISP.;2| 7859
|
||||
|
||||
:EDIT-BY "briggs"
|
||||
:EDIT-BY |rmk|
|
||||
|
||||
:CHANGES-TO (FNS LOADUP-LISP)
|
||||
|
||||
:PREVIOUS-DATE "22-Feb-2026 14:15:31"
|
||||
|{DSK}<Users>briggs>Projects>medley>internal>loadups>LOADUP-LISP.;13|)
|
||||
:PREVIOUS-DATE "16-Apr-2026 09:06:26" |{MEDLEY}<internal>loadups>LOADUP-LISP.;1|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT LOADUP-LISPCOMS)
|
||||
@@ -21,7 +19,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(LOADUP-LISP
|
||||
(LAMBDA (DRIBBLEFILE) (* \; "Edited 26-Mar-2026 18:38 by briggs")
|
||||
(LAMBDA (DRIBBLEFILE) (* \; "Edited 16-Apr-2026 10:29 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")
|
||||
(* \; "Edited 27-Dec-2025 15:02 by rmk")
|
||||
@@ -38,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")
|
||||
|
||||
@@ -110,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")
|
||||
@@ -151,5 +151,5 @@
|
||||
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (695 7398 (LOADUP-LISP 705 . 7396)))))
|
||||
(FILEMAP (NIL (636 7653 (LOADUP-LISP 646 . 7651)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED "16-Mar-2026 12:05:55" {WMEDLEY}<lispusers>GITFNS.;578 134065
|
||||
(FILECREATED "18-Apr-2026 21:36:33" {WMEDLEY}<lispusers>GITFNS.;582 134437
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GIT-BRANCH-WHENSELECTEDFN PRC-COMMAND)
|
||||
:CHANGES-TO (FNS GIT-BRANCH-MENU)
|
||||
|
||||
:PREVIOUS-DATE " 2-Mar-2026 14:00:13" {WMEDLEY}<lispusers>GITFNS.;576)
|
||||
:PREVIOUS-DATE "17-Apr-2026 12:39:29" {WMEDLEY}<lispusers>GITFNS.;581)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -169,6 +169,8 @@
|
||||
|
||||
(GIT-MAKE-PROJECT
|
||||
[LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
|
||||
(* ; "Edited 17-Apr-2026 12:33 by rmk")
|
||||
(* ; "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")
|
||||
@@ -242,7 +244,8 @@
|
||||
(SETQ EXCLUSIONS (CL:REMOVE-DUPLICATES (APPEND (for E inside EXCLUSIONS
|
||||
collect (MKSTRING E))
|
||||
GITIGNORE
|
||||
`("deleted/" "*.sysout"))
|
||||
`("deleted/" "*.sysout"
|
||||
"internal/fonts/*/*"))
|
||||
:TEST
|
||||
(FUNCTION STRING.EQUAL)))
|
||||
|
||||
@@ -275,7 +278,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)
|
||||
@@ -1398,13 +1402,12 @@
|
||||
" branches"])
|
||||
|
||||
(GIT-BRANCH-MENU
|
||||
[LAMBDA (BRANCHES TITLE PIN?) (* ; "Edited 1-May-2024 14:36 by rmk")
|
||||
[LAMBDA (BRANCHES TITLE) (* ; "Edited 18-Apr-2026 21:36 by rmk")
|
||||
(* ; "Edited 1-May-2024 14:36 by rmk")
|
||||
(* ; "Edited 6-Jul-2023 22:31 by rmk")
|
||||
(* ; "Edited 30-Jun-2023 16:58 by rmk")
|
||||
(* ; "Edited 18-May-2022 13:44 by rmk")
|
||||
(CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES))
|
||||
(CL:WHEN PIN?
|
||||
[SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu])
|
||||
(create MENU
|
||||
TITLE ← (OR TITLE (CONCAT (LENGTH BRANCHES)
|
||||
" branches"))
|
||||
@@ -2429,33 +2432,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 (4175 21435 (GIT-CLONEP 4185 . 5616) (GIT-INIT 5618 . 6248) (GIT-MAKE-PROJECT 6250 .
|
||||
14489) (GIT-GET-PROJECT 14491 . 16416) (GIT-PUT-PROJECT-FIELD 16418 . 18059) (GIT-PROJECT-PATH 18061
|
||||
. 19105) (FIND-ANCESTOR-DIRECTORY 19107 . 19458) (GIT-FIND-CLONE 19460 . 20543) (GIT-MAINBRANCH 20545
|
||||
. 20940) (GIT-MAINBRANCH? 20942 . 21433)) (26898 32192 (PRC-COMMAND 26908 . 32190)) (32248 35036 (
|
||||
ALLSUBDIRS 32258 . 33544) (MEDLEYSUBDIRS 33546 . 34239) (GITSUBDIRS 34241 . 35034)) (35037 37442 (
|
||||
TOGIT 35047 . 36455) (FROMGIT 36457 . 37440)) (37443 40453 (MYMEDLEYSUBDIR 37453 . 37909) (GITSUBDIR
|
||||
37911 . 38354) (STRIPDIR 38356 . 38734) (STRIPHOST 38736 . 38976) (STRIPNAME 38978 . 39731) (
|
||||
STRIPWHERE 39733 . 40451)) (40454 42689 (GFILE4MFILE 40464 . 41160) (MFILE4GFILE 41162 . 41731) (
|
||||
GIT-REPO-FILENAME 41733 . 42687)) (42738 52995 (GIT-COMMIT 42748 . 43574) (GIT-PUSH 43576 . 44336) (
|
||||
GIT-PULL 44338 . 45090) (GIT-APPROVAL 45092 . 45441) (GIT-GET-FILE 45443 . 47358) (GIT-FILE-EXISTS?
|
||||
47360 . 47634) (GIT-REMOTE-UPDATE 47636 . 48471) (GIT-REMOTE-ADD 48473 . 48780) (GIT-FILE-DATE 48782
|
||||
. 49829) (GIT-FILE-HISTORY 49831 . 51765) (GIT-PRINT-FILE-HISTORY 51767 . 52819) (GIT-FETCH 52821 .
|
||||
52993)) (53025 64977 (GIT-BRANCH-DIFF 53035 . 59924) (GIT-COMMIT-DIFFS 59926 . 60817) (
|
||||
GIT-BRANCH-RELATIONS 60819 . 64503) (GIT-MODIFIED 64505 . 64975)) (65022 83969 (GIT-BRANCH-NUM 65032
|
||||
. 65605) (GIT-CHECKOUT 65607 . 66893) (GIT-WHICH-BRANCH 66895 . 67302) (GIT-MAKE-BRANCH 67304 . 69883
|
||||
) (GIT-BRANCHES 69885 . 72482) (GIT-BRANCH-EXISTS? 72484 . 73355) (GIT-PICK-BRANCH 73357 . 73847) (
|
||||
GIT-BRANCH-MENU 73849 . 74750) (GIT-BRANCH-WHENSELECTEDFN 74752 . 76459) (GIT-PULL-REQUESTS 76461 .
|
||||
80346) (GIT-SHORT-BRANCH-NAME 80348 . 80639) (GIT-LONG-NAME 80641 . 80958) (GIT-PRC-BRANCHES 80960 .
|
||||
83967)) (83999 88753 (GIT-MY-CURRENT-BRANCH 84009 . 84379) (GIT-MY-BRANCHP 84381 . 84999) (
|
||||
GIT-MY-NEXT-BRANCH 85001 . 86801) (GIT-MY-BRANCHES 86803 . 88751)) (88799 92883 (GIT-ADD-WORKTREE
|
||||
88809 . 90416) (GIT-REMOVE-WORKTREE 90418 . 91350) (GIT-LIST-WORKTREES 91352 . 92163) (WORKTREEDIR
|
||||
92165 . 92881)) (92931 125969 (GIT-GET-DIFFERENT-FILES 92941 . 99849) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 99851 . 107490) (GIT-WORKING-COMPARE-DIRECTORIES 107492 . 113294) (
|
||||
GIT-COMPARE-WORKTREE 113296 . 117274) (GITCDOBJBUTTONFN 117276 . 121774) (GIT-CD-LABELFN 121776 .
|
||||
122862) (GIT-CD-MENUFN 122864 . 123950) (GIT-WORKING-COMPARE-FILES 123952 . 124572) (
|
||||
GIT-BRANCHES-COMPARE-FILES 124574 . 125738) (GIT-PR-COMPARE 125740 . 125967)) (126039 134370 (CDGITDIR
|
||||
126049 . 126736) (GIT-COMMAND 126738 . 128296) (GITORIGIN 128298 . 128995) (GIT-INITIALS 128997 .
|
||||
129301) (GIT-COMMAND-TO-FILE 129303 . 132788) (GIT-RESULT-TO-LINES 132790 . 133703) (STRIPLOCAL 133705
|
||||
. 134368)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "23-Feb-2026 10:32:36" {WMEDLEY}<sources>FILESETS.;32 6226
|
||||
(FILECREATED "16-Apr-2026 09:49:12" {MEDLEY}<sources>FILESETS.;2 6259
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS 0LISPSET)
|
||||
:CHANGES-TO (VARS 1LISPSET)
|
||||
|
||||
:PREVIOUS-DATE "23-Feb-2026 09:36:51" {WMEDLEY}<sources>FILESETS.;31)
|
||||
:PREVIOUS-DATE "16-Apr-2026 09:01:52" {MEDLEY}<sources>FILESETS.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FILESETSCOMS)
|
||||
@@ -57,8 +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 APUTDQ COMPATIBILITY DMISC CMLMACROS
|
||||
CMLLIST CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS MAIKOBITBLT MAIKOINIT LLDISPLAY))
|
||||
DSK UFS UFSCALLC PASSWORDS MEDLEYDIR PSEUDOHOSTS FONT MEDLEYFONTFORMAT APUTDQ
|
||||
COMPATIBILITY DMISC CMLMACROS CMLLIST CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS
|
||||
MAIKOBITBLT MAIKOINIT LLDISPLAY))
|
||||
|
||||
(RPAQQ 2LISPSET (MACHINEINDEPENDENT))
|
||||
|
||||
|
||||
@@ -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}<sources>MEDLEYDIR.;44 16074
|
||||
(FILECREATED "16-Apr-2026 11:06:53" {WMEDLEY}<sources>MEDLEYDIR.;53 17488
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MEDLEYDIR)
|
||||
(VARS MEDLEYDIRCOMS)
|
||||
|
||||
:PREVIOUS-DATE "26-Nov-2025 21:51:39" {WMEDLEY}<sources>MEDLEYDIR.;43)
|
||||
:PREVIOUS-DATE "15-Apr-2026 17:27:14" {WMEDLEY}<sources>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)
|
||||
@@ -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 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 "MEDLEY¬LOADUPS¬DIR"))
|
||||
(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 "MEDLEY¬LOADUPS¬DIR"))
|
||||
(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 )
|
||||
|
||||
@@ -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 (5529 14760 (MEDLEY-INIT-VARS 5539 . 9170) (MEDLEYDIR 9172 . 13560) (MEDLEYSUBSTDIR
|
||||
13562 . 14540) (SET-SYSOUT-COMMIT 14542 . 14758)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user