diff --git a/.github/ISSUE_TEMPLATE/primer.yml b/.github/ISSUE_TEMPLATE/primer.yml new file mode 100644 index 00000000..016db1a8 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/primer.yml @@ -0,0 +1,68 @@ +name: Report an issue with the **Medley Interlisp for the Newcomer** primer +description: Use this template to report issues or make suggestions. +title: Title of your issue +labels: + - primer + - documentation +body: + - type: dropdown + id: problemType + attributes: + label: "What type of issue are you reporting?" + options: + - Suggested improvement + - Incorrect explanation / code sample + - Confusing explanation + - Outdated information + - Broken link + - Typo / Grammar + validations: + required: true + - type: dropdown + id: location + attributes: + label: "Section of the primer where the issue occurs" + options: + - Introduction + - Medley online and Medley Local + - Understanding and Navigating the Interface + - Understanding Lisp Syntax + - Atoms, Functions and Lists + - Variable Bindings and Scope + - Iterators and Conditionals + - The File Browser + - Debugging + - Editing functions with SEdit + - Build Your First Interactive Program + - Saving Your Work + - TEdit, The WYSIWYG Editor + - Drawing and Displaystreams + - Making a Graph with Grapher + - Additional Resources + - General Feedback (not specific to a section) + validations: + required: true + - type: textarea + id: issueLocationDetails + attributes: + label: "Please provide more details about the location of the issue" + description: "For example, the specific page title, section heading, or url." + validations: + required: false + - type: textarea + id: issueDescription + attributes: + label: "Description of the issue" + description: "Please provide a detailed description of the issue you encountered." + validations: + required: true + - type: textarea + id: suggestedFix + attributes: + label: "Suggested fix or improvement" + description: "If you have a suggestion for how to fix or improve the issue, please provide it here." + validations: + required: false + - type: markdown + attributes: + value: "## Thank you for helping us improve the **Medley Interlisp for the Newcomer** primer!" \ No newline at end of file diff --git a/docs/internal/FONTCODECHANGES.tedit b/docs/internal/FONTCODECHANGES.tedit index c92e4098..8bcbf264 100644 Binary files a/docs/internal/FONTCODECHANGES.tedit and b/docs/internal/FONTCODECHANGES.tedit differ diff --git a/internal/loadups/LOADUP-LISP b/internal/loadups/LOADUP-LISP index a84822fe..23875a66 100644 --- a/internal/loadups/LOADUP-LISP +++ b/internal/loadups/LOADUP-LISP @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "16-Oct-2025 16:55:27" |{WMEDLEY}loadups>LOADUP-LISP.;22| 7104 +(FILECREATED " 5-Nov-2025 09:04:36" |{DSK}larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;2| 7333 - :EDIT-BY |rmk| + :EDIT-BY "lmm" :CHANGES-TO (FNS LOADUP-LISP) - :PREVIOUS-DATE "18-Aug-2025 12:09:49" |{WMEDLEY}loadups>LOADUP-LISP.;21|) + :PREVIOUS-DATE "16-Oct-2025 16:55:27" +|{DSK}larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;1|) (PRETTYCOMPRINT LOADUP-LISPCOMS) @@ -19,7 +20,8 @@ (DEFINEQ (LOADUP-LISP - (LAMBDA (DRIBBLEFILE) (* \; "Edited 16-Oct-2025 16:55 by rmk") + (LAMBDA (DRIBBLEFILE) (* \; "Edited 5-Nov-2025 09:01 by lmm") + (* \; "Edited 16-Oct-2025 16:55 by rmk") (* \; "Edited 18-Aug-2025 12:08 by rmk") (* \; "Edited 15-Jun-2025 14:39 by rmk") (* \; "Edited 24-May-2025 10:20 by rmk") @@ -126,7 +128,10 @@ (* |;;| " Added late, LOAD late to avoid any dependencies") + (* |;;| "prevent medley from pinning CPU") + (LOADUP '(XCL-LOOP XCL-HASH-LOOP)) + (LOADUP '(BACKGROUND-YIELD)) (* |;;| " networking code -- should make it optional but too many cross dependencies") @@ -144,5 +149,5 @@ (GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (640 6898 (LOADUP-LISP 650 . 6896))))) + (FILEMAP (NIL (675 7127 (LOADUP-LISP 685 . 7125))))) STOP diff --git a/internal/loadups/LOADUP-LISP.LCOM b/internal/loadups/LOADUP-LISP.LCOM index 4662329c..3a1d8608 100644 Binary files a/internal/loadups/LOADUP-LISP.LCOM and b/internal/loadups/LOADUP-LISP.LCOM differ diff --git a/library/UNIXUTILS b/library/UNIXUTILS index 59253a49..9f9491d9 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 4-Nov-2025 10:11:10" {WMEDLEY}UNIXUTILS.;34 18037 +(FILECREATED "26-Nov-2025 14:21:13" {WMEDLEY}UNIXUTILS.;35 18084 :EDIT-BY rmk - :CHANGES-TO (FNS SLASHIT) + :CHANGES-TO (VARS UNIXUTILSCOMS) - :PREVIOUS-DATE "22-Oct-2025 13:05:51" {WMEDLEY}UNIXUTILS.;33) + :PREVIOUS-DATE " 4-Nov-2025 10:11:10" {WMEDLEY}UNIXUTILS.;34) (PRETTYCOMPRINT UNIXUTILSCOMS) @@ -19,8 +19,8 @@ (INITVARS (ShellBrowser) (ShellOpener)) (FUNCTIONS ShellCommand ShellWhich) - (ADDVARS (MEDLEY-INIT-VARS (ShellBrowser) - (ShellOpener))) + (ADDVARS (MEDLEY-INIT-VARS (ShellBrowser NIL RESET) + (ShellOpener NIL RESET))) (FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) (PROPS (UNIXUTILS FILETYPE)))) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -57,8 +57,8 @@ (T (SETFILEPTR S 0) (RSTRING S]) -(ADDTOVAR MEDLEY-INIT-VARS (ShellBrowser) - (ShellOpener)) +(ADDTOVAR MEDLEY-INIT-VARS (ShellBrowser NIL RESET) + (ShellOpener NIL RESET)) (DEFINEQ (ShellBrowser @@ -327,7 +327,7 @@ (PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1110 1483 (ShellCommand 1110 . 1483)) (1485 1882 (ShellWhich 1485 . 1882)) (1972 17959 -(ShellBrowser 1982 . 3754) (ShellBrowse 3756 . 4441) (ShellOpener 4443 . 6131) (ShellOpen 6133 . 11612 -) (PROCESS-COMMAND 11614 . 12227) (SLASHIT 12229 . 14684) (UNIX-FILE-NAME 14686 . 17957))))) + (FILEMAP (NIL (1137 1510 (ShellCommand 1137 . 1510)) (1512 1909 (ShellWhich 1512 . 1909)) (2019 18006 +(ShellBrowser 2029 . 3801) (ShellBrowse 3803 . 4488) (ShellOpener 4490 . 6178) (ShellOpen 6180 . 11659 +) (PROCESS-COMMAND 11661 . 12274) (SLASHIT 12276 . 14731) (UNIX-FILE-NAME 14733 . 18004))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index 514dfbb9..96e1669b 100644 Binary files a/library/UNIXUTILS.DFASL and b/library/UNIXUTILS.DFASL differ diff --git a/library/tedit/TEDIT-WINDOW b/library/tedit/TEDIT-WINDOW index 9ce843a2..00ea577e 100644 --- a/library/tedit/TEDIT-WINDOW +++ b/library/tedit/TEDIT-WINDOW @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Oct-2025 10:33:08" {WMEDLEY}TEDIT>TEDIT-WINDOW.;878 230780 +(FILECREATED "15-Nov-2025 01:27:38" {WMEDLEY}TEDIT>TEDIT-WINDOW.;881 231034 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.WINDOW.GETREGION) + :CHANGES-TO (FNS \TEDIT.WINDOW.CREATE) - :PREVIOUS-DATE "24-Oct-2025 09:11:52" {WMEDLEY}tedit>TEDIT-WINDOW.;874) + :PREVIOUS-DATE "25-Oct-2025 10:33:08" {WMEDLEY}TEDIT>TEDIT-WINDOW.;878) (PRETTYCOMPRINT TEDIT-WINDOWCOMS) @@ -354,7 +354,8 @@ (DEFINEQ (\TEDIT.WINDOW.CREATE - [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 23-Oct-2025 18:22 by rmk") + [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 15-Nov-2025 01:27 by rmk") + (* ; "Edited 23-Oct-2025 18:22 by rmk") (* ; "Edited 21-Jul-2025 11:55 by rmk") (* ; "Edited 9-May-2025 12:11 by rmk") (* ; "Edited 25-Apr-2025 21:24 by rmk") @@ -377,24 +378,26 @@ (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)) (PHEIGHT 0) - TITLE REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT WTEXTOBJ) + REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT) + (SETQ FILE (GETTOBJ TEXTOBJ TXTFILE)) (CL:WHEN (WINDOWP WINDOW) (CL:WHEN (GETTSTR (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW) TEXTOBJ) - (* ;; " %"Reusing an existing Tedit window, kill the old process, undo its splits and restore its shape.%" ") + (* ;; " %"Reusing an existing Tedit window, kill the old process, undo its splits and restore its shape. Make sure it has a title%" ") (TEDIT.KILL WINDOW) (\TEDIT.CLOSESPLITS (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW) T)) - [SETQ TITLE (OR (LISTGET PROPS 'TITLE) - (WINDOWPROP WINDOW 'TITLE]) + + (* ;; "Every tedit window has a title bar, maybe one that it had already?") + + (WINDOWPROP WINDOW 'TITLE (OR (LISTGET PROPS 'TITLE) + (WINDOWPROP WINDOW 'TITLE) + (\TEDIT.DEFAULT.TITLE FILE PROPS)))) (SETQ REGIONTYPE (OR (GETTEXTPROP TEXTOBJ 'REGION-TYPE) (AND (LITATOM WINDOW) WINDOW))) - (SETQ FILE (GETTOBJ TEXTOBJ TXTFILE)) - (CL:UNLESS TITLE - (SETQ TITLE (\TEDIT.DEFAULT.TITLE FILE PROPS))) (SETQ PROMPTPROP (GETTEXTPROP TEXTOBJ 'PROMPTWINDOW)) (* ;; "All this prompt-height calculation would be unnecessary if the attachment in GETPROMPTWINDOW does the proper shrinking of the main window.") @@ -421,7 +424,8 @@ REGION)) (add (fetch (REGION HEIGHT) of REGION) (IMINUS PHEIGHT)) - (SETQ WINDOW (CREATEW REGION TITLE NIL NIL PROPS)) + (SETQ WINDOW (CREATEW REGION (\TEDIT.DEFAULT.TITLE FILE PROPS) + NIL NIL PROPS)) (* ;; "If we grabbed a typed-region, (maybe just a Tedit region by default. We stash it back onto the window so it will be remembered for next time.") @@ -451,7 +455,6 @@ (FSETTOBJ TEXTOBJ PRIMARYPANE (\TEDIT.MINIMAL.WINDOW.SETUP WINDOW TSTREAM PROPS)) (* ; "This should be PANE") - (WINDOWPROP WINDOW 'TITLE TITLE) WINDOW]) (\TEDIT.WINDOW.GETREGION @@ -3659,36 +3662,36 @@ (RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (17103 17999 (TEDIT.DEFER.UPDATES 17113 . 17997)) (18000 44835 (\TEDIT.WINDOW.CREATE -18010 . 24616) (\TEDIT.WINDOW.GETREGION 24618 . 29322) (\TEDIT.WINDOW.SETUP 29324 . 33654) ( -\TEDIT.MINIMAL.WINDOW.SETUP 33656 . 41467) (\TEDIT.CLEARPANE 41469 . 42186) (\TEDIT.FILL.PANES 42188 - . 44833)) (44836 68537 (\TEDIT.CURSORMOVEDFN 44846 . 50456) (\TEDIT.CURSOROUTFN 50458 . 51146) ( -\TEDIT.ACTIVE.WINDOWP 51148 . 52218) (\TEDIT.EXPANDFN 52220 . 52783) (\TEDIT.MAINW 52785 . 54065) ( -\TEDIT.MAINSTREAM 54067 . 54401) (\TEDIT.PRIMARYPANE 54403 . 55173) (\TEDIT.PANELIST 55175 . 55671) ( -\TEDIT.NEWREGIONFN 55673 . 58189) (\TEDIT.SET.WINDOW.EXTENT 58191 . 63173) (\TEDIT.SHRINK.ICONCREATE -63175 . 65908) (\TEDIT.SHRINKFN 65910 . 66319) (\TEDIT.PANEREGION 66321 . 68535)) (68569 101615 ( -\TEDIT.BUTTONEVENTFN 68579 . 81552) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81554 . 88817) ( -\TEDIT.BUTTONEVENTFN.GETOPERATION 88819 . 90661) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90663 . 94333) ( -\TEDIT.BUTTONEVENTFN.INACTIVE 94335 . 96765) (\TEDIT.BUTTONEVENTFN.INTITLE 96767 . 98602) ( -\TEDIT.COPYINSERTFN 98604 . 99736) (\TEDIT.FOREIGN.COPY 99738 . 101613)) (101616 119179 ( -\TEDIT.PANE.SPLIT 101626 . 105574) (\TEDIT.SPLITW 105576 . 113635) (\TEDIT.UNSPLITW 113637 . 117836) ( -\TEDIT.LINKPANES 117838 . 118601) (\TEDIT.UNLINKPANE 118603 . 119177)) (120613 121504 (TEDITWINDOWP -120623 . 121502)) (121541 124644 (TEDIT.GETINPUT 121551 . 123994) (\TEDIT.MAKEFILENAME 123996 . 124642 -)) (124693 132343 (TEDIT.PROMPTWINDOW 124703 . 125017) (TEDIT.PROMPTPRINT 125019 . 127646) ( -TEDIT.PROMPTCLEAR 127648 . 129390) (TEDIT.PROMPTFLASH 129392 . 130650) (\TEDIT.PROMPT.PAGEFULLFN -130652 . 132341)) (132581 143159 (\TEDIT.FILENAME 132591 . 133363) (\TEDIT.DEFAULT.TITLE 133365 . -135744) (\TEDIT.WINDOW.TITLE 135746 . 137915) (\TEDIT.LIKELY.FILENAME 137917 . 140641) ( -\TEDIT.UPDATE.TITLE 140643 . 143157)) (143202 155686 (TEDIT.DEACTIVATE.WINDOW 143212 . 148785) ( -\TEDIT.RESHAPEFN 148787 . 150872) (\TEDIT.REPAINTFN 150874 . 151098) (\TEDIT.CLOSESPLITS 151100 . -153545) (\TEDIT.CLOSEPANE 153547 . 155684)) (155687 198486 (\TEDIT.SCROLLFN 155697 . 157928) ( -\TEDIT.SCROLLCH.TOP 157930 . 160041) (\TEDIT.SCROLLCH.BOTTOM 160043 . 164373) (\TEDIT.SCROLLUP 164375 - . 170101) (\TEDIT.TOPLINE.YTOP 170103 . 171772) (\TEDIT.SCROLLDOWN 171774 . 178813) ( -\TEDIT.SCROLL.CARET 178815 . 181653) (\TEDIT.VISIBLECARETP 181655 . 183949) (\TEDIT.VISIBLECHARP -183951 . 185042) (\TEDIT.BITMAPLINES 185044 . 188964) (\TEDIT.SETPANE.TOPLINE 188966 . 189578) ( -\TEDIT.SHIFTLINES 189580 . 198484)) (198487 209356 (\TEDIT.ONSCREEN? 198497 . 203048) ( -\TEDIT.ONSCREEN.REGION 203050 . 206701) (\TEDIT.AFTERMOVEFN 206703 . 207600) (OFFSCREENP 207602 . -209354)) (209398 212212 (\TEDIT.PROCIDLEFN 209408 . 211068) (\TEDIT.PROCENTRYFN 211070 . 211515) ( -\TEDIT.PROCEXITFN 211517 . 212210)) (212291 225516 (\TEDIT.DOWNCARET 212301 . 213094) ( -\TEDIT.FLASHCARET 213096 . 215207) (\TEDIT.UPCARET 215209 . 216313) (TEDIT.NORMALIZECARET 216315 . -219533) (\TEDIT.SETCARET 219535 . 224886) (\TEDIT.CARET 224888 . 225514))))) + (FILEMAP (NIL (17100 17996 (TEDIT.DEFER.UPDATES 17110 . 17994)) (17997 45089 (\TEDIT.WINDOW.CREATE +18007 . 24870) (\TEDIT.WINDOW.GETREGION 24872 . 29576) (\TEDIT.WINDOW.SETUP 29578 . 33908) ( +\TEDIT.MINIMAL.WINDOW.SETUP 33910 . 41721) (\TEDIT.CLEARPANE 41723 . 42440) (\TEDIT.FILL.PANES 42442 + . 45087)) (45090 68791 (\TEDIT.CURSORMOVEDFN 45100 . 50710) (\TEDIT.CURSOROUTFN 50712 . 51400) ( +\TEDIT.ACTIVE.WINDOWP 51402 . 52472) (\TEDIT.EXPANDFN 52474 . 53037) (\TEDIT.MAINW 53039 . 54319) ( +\TEDIT.MAINSTREAM 54321 . 54655) (\TEDIT.PRIMARYPANE 54657 . 55427) (\TEDIT.PANELIST 55429 . 55925) ( +\TEDIT.NEWREGIONFN 55927 . 58443) (\TEDIT.SET.WINDOW.EXTENT 58445 . 63427) (\TEDIT.SHRINK.ICONCREATE +63429 . 66162) (\TEDIT.SHRINKFN 66164 . 66573) (\TEDIT.PANEREGION 66575 . 68789)) (68823 101869 ( +\TEDIT.BUTTONEVENTFN 68833 . 81806) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81808 . 89071) ( +\TEDIT.BUTTONEVENTFN.GETOPERATION 89073 . 90915) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90917 . 94587) ( +\TEDIT.BUTTONEVENTFN.INACTIVE 94589 . 97019) (\TEDIT.BUTTONEVENTFN.INTITLE 97021 . 98856) ( +\TEDIT.COPYINSERTFN 98858 . 99990) (\TEDIT.FOREIGN.COPY 99992 . 101867)) (101870 119433 ( +\TEDIT.PANE.SPLIT 101880 . 105828) (\TEDIT.SPLITW 105830 . 113889) (\TEDIT.UNSPLITW 113891 . 118090) ( +\TEDIT.LINKPANES 118092 . 118855) (\TEDIT.UNLINKPANE 118857 . 119431)) (120867 121758 (TEDITWINDOWP +120877 . 121756)) (121795 124898 (TEDIT.GETINPUT 121805 . 124248) (\TEDIT.MAKEFILENAME 124250 . 124896 +)) (124947 132597 (TEDIT.PROMPTWINDOW 124957 . 125271) (TEDIT.PROMPTPRINT 125273 . 127900) ( +TEDIT.PROMPTCLEAR 127902 . 129644) (TEDIT.PROMPTFLASH 129646 . 130904) (\TEDIT.PROMPT.PAGEFULLFN +130906 . 132595)) (132835 143413 (\TEDIT.FILENAME 132845 . 133617) (\TEDIT.DEFAULT.TITLE 133619 . +135998) (\TEDIT.WINDOW.TITLE 136000 . 138169) (\TEDIT.LIKELY.FILENAME 138171 . 140895) ( +\TEDIT.UPDATE.TITLE 140897 . 143411)) (143456 155940 (TEDIT.DEACTIVATE.WINDOW 143466 . 149039) ( +\TEDIT.RESHAPEFN 149041 . 151126) (\TEDIT.REPAINTFN 151128 . 151352) (\TEDIT.CLOSESPLITS 151354 . +153799) (\TEDIT.CLOSEPANE 153801 . 155938)) (155941 198740 (\TEDIT.SCROLLFN 155951 . 158182) ( +\TEDIT.SCROLLCH.TOP 158184 . 160295) (\TEDIT.SCROLLCH.BOTTOM 160297 . 164627) (\TEDIT.SCROLLUP 164629 + . 170355) (\TEDIT.TOPLINE.YTOP 170357 . 172026) (\TEDIT.SCROLLDOWN 172028 . 179067) ( +\TEDIT.SCROLL.CARET 179069 . 181907) (\TEDIT.VISIBLECARETP 181909 . 184203) (\TEDIT.VISIBLECHARP +184205 . 185296) (\TEDIT.BITMAPLINES 185298 . 189218) (\TEDIT.SETPANE.TOPLINE 189220 . 189832) ( +\TEDIT.SHIFTLINES 189834 . 198738)) (198741 209610 (\TEDIT.ONSCREEN? 198751 . 203302) ( +\TEDIT.ONSCREEN.REGION 203304 . 206955) (\TEDIT.AFTERMOVEFN 206957 . 207854) (OFFSCREENP 207856 . +209608)) (209652 212466 (\TEDIT.PROCIDLEFN 209662 . 211322) (\TEDIT.PROCENTRYFN 211324 . 211769) ( +\TEDIT.PROCEXITFN 211771 . 212464)) (212545 225770 (\TEDIT.DOWNCARET 212555 . 213348) ( +\TEDIT.FLASHCARET 213350 . 215461) (\TEDIT.UPCARET 215463 . 216567) (TEDIT.NORMALIZECARET 216569 . +219787) (\TEDIT.SETCARET 219789 . 225140) (\TEDIT.CARET 225142 . 225768))))) STOP diff --git a/library/tedit/TEDIT-WINDOW.LCOM b/library/tedit/TEDIT-WINDOW.LCOM index 439ef362..4b6b6bdf 100644 Binary files a/library/tedit/TEDIT-WINDOW.LCOM and b/library/tedit/TEDIT-WINDOW.LCOM differ diff --git a/lispusers/BACKGROUND-YIELD b/lispusers/BACKGROUND-YIELD index 00d4ded4..aa634972 100644 --- a/lispusers/BACKGROUND-YIELD +++ b/lispusers/BACKGROUND-YIELD @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Jul-2023 09:49:24" {DSK}larry>il>medley>lispusers>BACKGROUND-YIELD.;2 1770 +(FILECREATED " 9-Nov-2025 11:52:07" {DSK}larry>il>MEDLEY>LISPUSERS>BACKGROUND-YIELD.;2 1882 :EDIT-BY "lmm" :CHANGES-TO (FNS BACKGROUND-YIELD) - :PREVIOUS-DATE "14-Nov-2021 22:05:58" {DSK}larry>il>medley>lispusers>BACKGROUND-YIELD.;1 + :PREVIOUS-DATE "28-Jul-2023 09:49:24" {DSK}larry>il>MEDLEY>LISPUSERS>BACKGROUND-YIELD.;1 ) @@ -26,13 +26,14 @@ (DEFINEQ (BACKGROUND-YIELD - [LAMBDA NIL (* ; "Edited 28-Jul-2023 09:11 by lmm") + [LAMBDA NIL (* ; "Edited 9-Nov-2025 11:50 by lmm") + (* ; "Edited 28-Jul-2023 09:11 by lmm") (* ; "Edited 20-Sep-2021 11:37 by larry") (LET ((\BACKGROUND T)) - (DECLARE (SPECVARS \BACKGROUND)) + (DECLARE (SPECVARS \BACKGROUND) + (GLOBALVARS BACKGROUND-YIELD)) (IF (FIXP BACKGROUND-YIELD) - THEN (SUBRCALL YIELD BACKGROUND-YIELD) - (SUBRCALL CAUSE-INTERRUPT]) + THEN (SUBRCALL YIELD BACKGROUND-YIELD]) (INIT-YIELD [LAMBDA (ONP) (* ; "Edited 19-Sep-2021 13:32 by larry") @@ -51,5 +52,5 @@ (RPAQQ BACKGROUND-YIELD 833333) (DECLARE%: DONTCOPY - (FILEMAP (NIL (806 1655 (BACKGROUND-YIELD 816 . 1271) (INIT-YIELD 1273 . 1653))))) + (FILEMAP (NIL (808 1767 (BACKGROUND-YIELD 818 . 1383) (INIT-YIELD 1385 . 1765))))) STOP diff --git a/lispusers/BACKGROUND-YIELD.LCOM b/lispusers/BACKGROUND-YIELD.LCOM index 3e46012b..c44c58fc 100644 Binary files a/lispusers/BACKGROUND-YIELD.LCOM and b/lispusers/BACKGROUND-YIELD.LCOM differ diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index cfe48dc5..2531735b 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Oct-2025 23:59:24" {MEDLEY}COMPAREDIRECTORIES.;2 135376 +(FILECREATED " 8-Nov-2025 13:07:39" {WMEDLEY}COMPAREDIRECTORIES.;285 138536 :EDIT-BY rmk - :CHANGES-TO (FNS CDBROWSER-COPY) + :CHANGES-TO (FNS CD-MENUFN CDBROWSER-COPY) - :PREVIOUS-DATE "22-Oct-2025 08:32:01" {WMEDLEY}COMPAREDIRECTORIES.;272) + :PREVIOUS-DATE "28-Oct-2025 14:52:05" {WMEDLEY}COMPAREDIRECTORIES.;280) (PRETTYCOMPRINT COMPAREDIRECTORIESCOMS) @@ -1707,6 +1707,8 @@ (CDBROWSER [LAMBDA (CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS) + (* ;; "Edited 28-Oct-2025 14:49 by rmk") + (* ;; "Edited 28-Jan-2022 17:01 by rmk: a table browser for the differences in CDVALUE.") (* ;; "Creates a table browser for the differences in CDVALUE.") @@ -1752,7 +1754,7 @@ [SETQ BROWSER (TB.MAKE.BROWSER (FOR PAIR IN STRINGS COLLECT (CD.TABLEITEM PAIR)) WINDOW `(PRINTFN CD.TABLEITEM.PRINTFN COPYFN CD.TABLEITEM.COPYFN USERDATA - ,(APPEND BROWSERPROPS (LIST 'CDVALUE CDVALUE] + (,@BROWSERPROPS (CDVALUE ,@CDVALUE] (ATTACHMENU (CREATE MENU TITLE _ " CD commands " MENUFONT _ DEFAULTFONT @@ -1893,7 +1895,8 @@ 'DON'T]) (CD.COMMANDSELECTEDFN - [LAMBDA (MENUITEM MENU KEY) (* ; "Edited 6-Mar-2022 19:52 by rmk") + [LAMBDA (MENUITEM MENU KEY) (* ; "Edited 28-Oct-2025 14:34 by rmk") + (* ; "Edited 6-Mar-2022 19:52 by rmk") (* ; "Edited 24-Feb-2022 19:52 by rmk") (* ; "Edited 5-Feb-2022 17:23 by rmk") (* ; "Edited 27-Jan-2022 17:46 by rmk") @@ -1944,7 +1947,8 @@ (LABEL1 (OR (CAR LABELS) FILE1)) (LABEL2 (OR (CADR LABELS) - FILE2))) + FILE2)) + TEMP) (DECLARE (SPECVARS . T)) (* ;; @@ -1958,6 +1962,16 @@ OF (FETCH (CDENTRY INFO2) OF CDENTRY))) (SETQ FILE2 NIL)) + (CL:WHEN (SETQ TEMP (SGETMULTI (fetch (TABLEBROWSER + TBUSERDATA) + of CDBROWSER) + 'ORIGINALFILES FILE1)) + (SETQ FILE1 TEMP)) + (CL:WHEN (SETQ TEMP (SGETMULTI (fetch (TABLEBROWSER + TBUSERDATA) + of CDBROWSER) + 'ORIGINALFILES FILE2)) + (SETQ FILE2 TEMP)) (* ;; "If USERDATA contains a LABELFN, then it is applied to the files and the rest of the USERDATA to produce abbreviated labels for titles and headers.") @@ -1969,6 +1983,10 @@ (CD-MENUFN [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) + (* ;; "Edited 8-Nov-2025 13:06 by rmk") + + (* ;; "Edited 28-Oct-2025 17:35 by rmk") + (* ;; "Edited 26-Mar-2025 09:39 by rmk") (* ;; "Edited 18-Feb-2025 23:36 by rmk") @@ -1996,7 +2014,8 @@ (Compare (IF (AND FILE1 FILE2) THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE (WINDOWPROP WINDOW - 'REGION)) + 'REGION) + CDBROWSER) ELSE (FLASHWINDOW T) (PRIN3 "Only one file" T))) (See% left (IF FILE1 @@ -2060,18 +2079,20 @@ NIL)))) (Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT)) (Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT)) - (Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T)) + (Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'LEFT T)) (|Delete ALL <-| - (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL)) - (Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T)) + (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'LEFT NIL)) + (Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'RIGHT T)) (|Delete ALL ->| - (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL)) + (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'RIGHT NIL)) (SHOULDNT))) (CLOSEWITH CHILDREN WINDOW) (MOVEWITH CHILDREN WINDOW]) (CD-COMPARE-FILES - [LAMBDA (FILE1 FILE2 LABEL1 LABEL2 TYPE PARENTREGION) (* ; "Edited 22-May-2022 14:41 by rmk") + [LAMBDA (FILE1 FILE2 LABEL1 LABEL2 TYPE PARENTREGION CDBROWSER) + (* ; "Edited 28-Oct-2025 10:42 by rmk") + (* ; "Edited 22-May-2022 14:41 by rmk") (PROG NIL (SETQ FILE1 (OR (STREAMP FILE1) (INFILEP FILE1))) @@ -2094,7 +2115,7 @@ `(,PARENTREGION 0.125) (IPLUS (FETCH (REGION BOTTOM) OF PARENTREGION ) - 20) + 70) NIL)))) (COMPILED (FLASHWINDOW T) (PRIN3 "Cannot compare compiled files" T)) @@ -2123,7 +2144,8 @@ NIL]) (CDBROWSER-COPY - [LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 25-Oct-2025 23:58 by rmk") + [LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 28-Oct-2025 17:39 by rmk") + (* ; "Edited 25-Oct-2025 23:58 by rmk") (* ; "Edited 24-May-2022 15:49 by rmk") (* ; "Edited 25-Apr-2022 09:24 by rmk") (* ; "Edited 5-Feb-2022 17:27 by rmk") @@ -2137,7 +2159,7 @@ (* ;; "Returns NIL if the copy fails.") (CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM) - (PROG* ((CDVALUE (LISTGET (TB.USERDATA CDBROWSER) + (PROG* ((CDVALUE (GETMULTI (TB.USERDATA CDBROWSER) 'CDVALUE)) (SOURCEDIR (FETCH (CDVALUE CDDIR1) OF CDVALUE)) (DESTDIR (FETCH (CDVALUE CDDIR2) OF CDVALUE)) @@ -2178,7 +2200,9 @@ (CL:UNLESS DESTFILE (SETQ DESTFILE (CD-SWAPDIRS SOURCEFILE SOURCEDIR DESTDIR))) [SETQ RESULT (if UNIXDEST - then [PSEUDOFILENAME (PACKFILENAME 'HOST 'DSK 'BODY + then (SPUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER) + 'ORIGINALFILES DESTFILE (COPYFILE DESTFILE '{NODIRCORE)) + [PSEUDOFILENAME (PACKFILENAME 'HOST 'DSK 'BODY (COPYFILE SOURCEFILE (PACKFILENAME 'HOST 'UNIX @@ -2197,7 +2221,8 @@ (RETURN RESULT)))]) (CDBROWSER-DELETE-FILE - [LAMBDA (CDBROWSER TBITEM SIDE ONLYONE SAVE) (* ; "Edited 25-Apr-2022 09:06 by rmk") + [LAMBDA (CDBROWSER TBITEM KEY SIDE ONLYONE SAVE DONTMARK) (* ; "Edited 28-Oct-2025 13:30 by rmk") + (* ; "Edited 25-Apr-2022 09:06 by rmk") (* ; "Edited 5-Feb-2022 17:46 by rmk") (* ; "Edited 18-Jan-2022 23:02 by rmk") (* ; "Edited 19-Dec-2021 23:33 by rmk") @@ -2210,38 +2235,58 @@ (* ;; "If SAVE, then the files are renamed to a deleted directory, not actually expunged, so that they can be restored if needed. The deleted directory is defined by sticking deleted> on the front of FILE's directory.") + (DECLARE (USEDFREE LABEL1 LABEL2 PWINDOW)) (CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM) - [LET ((CDENTRY (CADR (FETCH TIDATA OF TBITEM))) - FILE OTHERFILE) - (SETQ FILE (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO1) OF CDENTRY))) - (SETQ OTHERFILE (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO2) OF CDENTRY))) - (CL:WHEN (EQ SIDE 'RIGHT) - (SWAP FILE OTHERFILE)) - (CL:WHEN FILE - (FOR F INSIDE (IF (FILENAMEFIELD.STRING FILE 'VERSION) - THEN [IF ONLYONE - THEN FILE - ELSE (DREVERSE (FILDIR (PACKFILENAME.STRING 'VERSION "*" - 'BODY FILE] - ELSE FILE) - COLLECT + [LET + ((CDENTRY (CADR (fetch TIDATA of TBITEM))) + FILE OTHERFILE DELFILES) + (SETQ FILE (fetch (CDINFO FULLNAME) of (fetch (CDENTRY INFO1) of CDENTRY))) + (SETQ OTHERFILE (fetch (CDINFO FULLNAME) of (fetch (CDENTRY INFO2) of CDENTRY))) + (CL:WHEN (EQ SIDE 'RIGHT) + (SWAP FILE OTHERFILE) + (SWAP LABEL1 LABEL2)) + (SETQ DELFILES (if (FILENAMEFIELD.STRING FILE 'VERSION) + then [if ONLYONE + then (MKLIST FILE) + else (DREVERSE (FILDIR (PACKFILENAME.STRING 'VERSION "*" + 'BODY FILE] + else FILE)) + (CL:WHEN DELFILES + (GIVE.TTY.PROCESS PWINDOW) + (CLEARW T) + (FLASHWINDOW T) + (CL:WHEN [OR (EQ KEY 'MIDDLE) + (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " (CL:IF (CDR DELFILES) + "ALL versions of " + "") + LABEL1 " ? "] + (for F in DELFILES + collect (* ;; "Delete the earlier ones first, if it goes bad, you don't want them to persist. This preserves the original version numbers, maybe it should start fresh from 1 (or from whatever might have been deleted before).") - (IF SAVE - THEN (CL:UNLESS (RENAMEFILE F (PACKFILENAME.STRING - 'DIRECTORY - (CONCAT "deleted>" (FILENAMEFIELD.STRING - F - 'DIRECTORY)) - 'BODY F)) - (ERROR "Could not delete " F)) - ELSE (DELFILE FILE)) - F FINALLY + (* ;; "Save copies locally in this browser, for potential Undelete. Undelete would have to match all of the versions") + + (CL:UNLESS (if SAVE + then (PUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER + ) + 'ORIGINALFILES + (RENAMEFILE F (PACKFILENAME.STRING + 'DIRECTORY + (CONCAT "deleted>" + (FILENAMEFIELD.STRING + F + 'DIRECTORY)) + 'BODY F))) + else (PUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER) + 'ORIGINALFILES FILE (COPYFILE FILE '{NODIRCORE})) + (DELFILE FILE)) + (ERROR "Could not delete " F)) + F finally (* ;; "Perhaps only mark it as deleted if both files are gone?") - (TB.DELETE.ITEM CDBROWSER TBITEM)))])]) + (CL:UNLESS DONTMARK (TB.DELETE.ITEM CDBROWSER TBITEM)))))])]) (CD-SWAPDIRS [LAMBDA (FILE FROMDIR TODIR KEEPVERSION) (* ; "Edited 2-Feb-2022 19:10 by rmk") @@ -2258,38 +2303,43 @@ (RPAQ? CD-LINELENGTH NIL) -(RPAQQ CDTABLEBROWSER.MENUITEMS ((Compare CD-MENUFN) - (Copy% -> CD-MENUFN) - (Copy% <- CD-MENUFN) - (See% left CD-MENUFN) - (See% right CD-MENUFN) - (See% both CD-MENUFN) - (See CD-MENUFN))) +(RPAQQ CDTABLEBROWSER.MENUITEMS + ((Compare CD-MENUFN) + (Copy% -> CD-MENUFN) + (Copy% <- CD-MENUFN) + (See% left CD-MENUFN) + (See% right CD-MENUFN) + (See% both CD-MENUFN) + (See CD-MENUFN) + (Delete% <- CD-MENUFN) + (|Delete ALL <-| CD-MENUFN) + (Delete% -> CD-MENUFN) + (|Delete ALL ->| CD-MENUFN))) (FILESLOAD (SYSLOAD) COMPARESOURCES COMPARETEXT) (MOVD? 'NILL 'TEDIT.FILEDATE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2655 23634 (COMPAREDIRECTORIES 2665 . 8000) (COMPAREDIRECTORIES.INFOS 8002 . 11231) ( -COMPAREDIRECTORIES.CANDIDATES 11233 . 14618) (CDENTRIES.SELECT 14620 . 19522) ( -COMPAREDIRECTORIES.INFOS.TYPE 19524 . 20868) (MATCHNAME 20870 . 21550) (CD.INSURECDVALUE 21552 . 23166 -) (CD.UPDATEWIDTHS 23168 . 23632)) (23635 34340 (CDFILES 23645 . 29742) (CDFILES.MATCH 29744 . 31369) -(CDFILES.PATS 31371 . 34338)) (34341 52359 (CDPRINT 34351 . 36868) (CDPRINT.HEADER 36870 . 37767) ( -CDPRINT.LINE 37769 . 41198) (CDPRINT.MAXWIDTHS 41200 . 45315) (CDPRINT.COLHEADERS 45317 . 46602) ( -CDPRINT.COLUMNS 46604 . 51724) (CDTEDIT 51726 . 52357)) (52360 61481 (CDMAP 52370 . 53802) (CDENTRY -53804 . 54113) (CDSUBSET 54115 . 55554) (CDMERGE 55556 . 59540) (CDMERGE.COMMON 59542 . 60857) ( -CD.SORT 60859 . 61479)) (61482 69020 (BINCOMP 61492 . 65781) (EOLTYPE 65783 . 68345) (EOLTYPE.SHOW -68347 . 69018)) (69548 82075 (FIND-UNCOMPILED-FILES 69558 . 73201) (FIND-UNSOURCED-FILES 73203 . 75587 -) (FIND-SOURCE-FILES 75589 . 77327) (FIND-COMPILED-FILES 77329 . 79206) (FIND-UNLOADED-FILES 79208 . -80061) (FIND-LOADED-FILES 80063 . 80491) (FIND-MULTICOMPILED-FILES 80493 . 82073)) (82076 90507 ( -CREATED-AS 82086 . 86883) (SOURCE-FOR-COMPILED-P 86885 . 89812) (COMPILE-SOURCE-DATE-DIFF 89814 . -90505)) (90508 101271 (FIX-DIRECTORY-DATES 90518 . 93968) (FIX-EQUIV-DATES 93970 . 95495) ( -COPY-COMPARED-FILES 95497 . 97318) (COPY-MISSING-FILES 97320 . 99477) (COMPILED-ON-SAME-SOURCE 99479 - . 101269)) (101465 109303 (CDBROWSER 101475 . 105402) (CDBROWSER.STRINGS 105404 . 109301)) (109465 -111201 (CD.TABLEITEM 109475 . 109695) (CD.TABLEITEM.PRINTFN 109697 . 109896) (CD.TABLEITEM.COPYFN -109898 . 110956) (CDTABLEBROWSER.HEADING.REPAINTFN 110958 . 111199)) (111202 134851 ( -CDTABLEBROWSER.WHENSELECTEDFN 111212 . 111680) (CD.COMMANDSELECTEDFN 111682 . 116783) (CD-MENUFN -116785 . 123011) (CD-COMPARE-FILES 123013 . 126365) (CDBROWSER-COPY 126367 . 131115) ( -CDBROWSER-DELETE-FILE 131117 . 134330) (CD-SWAPDIRS 134332 . 134849))))) + (FILEMAP (NIL (2668 23647 (COMPAREDIRECTORIES 2678 . 8013) (COMPAREDIRECTORIES.INFOS 8015 . 11244) ( +COMPAREDIRECTORIES.CANDIDATES 11246 . 14631) (CDENTRIES.SELECT 14633 . 19535) ( +COMPAREDIRECTORIES.INFOS.TYPE 19537 . 20881) (MATCHNAME 20883 . 21563) (CD.INSURECDVALUE 21565 . 23179 +) (CD.UPDATEWIDTHS 23181 . 23645)) (23648 34353 (CDFILES 23658 . 29755) (CDFILES.MATCH 29757 . 31382) +(CDFILES.PATS 31384 . 34351)) (34354 52372 (CDPRINT 34364 . 36881) (CDPRINT.HEADER 36883 . 37780) ( +CDPRINT.LINE 37782 . 41211) (CDPRINT.MAXWIDTHS 41213 . 45328) (CDPRINT.COLHEADERS 45330 . 46615) ( +CDPRINT.COLUMNS 46617 . 51737) (CDTEDIT 51739 . 52370)) (52373 61494 (CDMAP 52383 . 53815) (CDENTRY +53817 . 54126) (CDSUBSET 54128 . 55567) (CDMERGE 55569 . 59553) (CDMERGE.COMMON 59555 . 60870) ( +CD.SORT 60872 . 61492)) (61495 69033 (BINCOMP 61505 . 65794) (EOLTYPE 65796 . 68358) (EOLTYPE.SHOW +68360 . 69031)) (69561 82088 (FIND-UNCOMPILED-FILES 69571 . 73214) (FIND-UNSOURCED-FILES 73216 . 75600 +) (FIND-SOURCE-FILES 75602 . 77340) (FIND-COMPILED-FILES 77342 . 79219) (FIND-UNLOADED-FILES 79221 . +80074) (FIND-LOADED-FILES 80076 . 80504) (FIND-MULTICOMPILED-FILES 80506 . 82086)) (82089 90520 ( +CREATED-AS 82099 . 86896) (SOURCE-FOR-COMPILED-P 86898 . 89825) (COMPILE-SOURCE-DATE-DIFF 89827 . +90518)) (90521 101284 (FIX-DIRECTORY-DATES 90531 . 93981) (FIX-EQUIV-DATES 93983 . 95508) ( +COPY-COMPARED-FILES 95510 . 97331) (COPY-MISSING-FILES 97333 . 99490) (COMPILED-ON-SAME-SOURCE 99492 + . 101282)) (101478 109356 (CDBROWSER 101488 . 105455) (CDBROWSER.STRINGS 105457 . 109354)) (109518 +111254 (CD.TABLEITEM 109528 . 109748) (CD.TABLEITEM.PRINTFN 109750 . 109949) (CD.TABLEITEM.COPYFN +109951 . 111009) (CDTABLEBROWSER.HEADING.REPAINTFN 111011 . 111252)) (111255 138020 ( +CDTABLEBROWSER.WHENSELECTEDFN 111265 . 111733) (CD.COMMANDSELECTEDFN 111735 . 117908) (CD-MENUFN +117910 . 124301) (CD-COMPARE-FILES 124303 . 127830) (CDBROWSER-COPY 127832 . 132894) ( +CDBROWSER-DELETE-FILE 132896 . 137499) (CD-SWAPDIRS 137501 . 138018))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index 0fb8ccd9..7569b398 100644 Binary files a/lispusers/COMPAREDIRECTORIES.LCOM and b/lispusers/COMPAREDIRECTORIES.LCOM differ diff --git a/lispusers/EXAMINEDEFS b/lispusers/EXAMINEDEFS index 0ec8b973..5c5ef0f1 100644 --- a/lispusers/EXAMINEDEFS +++ b/lispusers/EXAMINEDEFS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Oct-2025 10:24:30" {WMEDLEY}EXAMINEDEFS.;59 17123 +(FILECREATED "28-Oct-2025 14:24:17" {WMEDLEY}EXAMINEDEFS.;60 17313 :EDIT-BY rmk - :CHANGES-TO (FNS EXAMINEDEFS) + :CHANGES-TO (FNS EXAMINEFILES) - :PREVIOUS-DATE " 6-Apr-2025 23:54:50" {WMEDLEY}EXAMINEDEFS.;57) + :PREVIOUS-DATE "25-Oct-2025 10:24:30" {WMEDLEY}EXAMINEDEFS.;59) (PRETTYCOMPRINT EXAMINEDEFSCOMS) @@ -173,7 +173,8 @@ (EDITE DEF2]) (EXAMINEFILES - [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 19-Jul-2023 13:48 by rmk") + [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 28-Oct-2025 14:23 by rmk") + (* ; "Edited 19-Jul-2023 13:48 by rmk") (* ; "Edited 1-Feb-2022 23:15 by rmk") (* ; "Edited 25-Jan-2022 10:08 by rmk") (* ; "Edited 2-Jan-2022 23:15 by rmk") @@ -183,7 +184,8 @@ (CL:UNLESS REGION (SETQ REGION (GETREGION))) - (LIST (AND (INFILEP FILE1) + (LIST (AND (OR (STREAMP FILE1) + (INFILEP FILE1)) (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1) REGION 'RIGHT @@ -191,7 +193,8 @@ `(,REGION 0.5) (FETCH (REGION TOP) OF REGION)) NIL TITLE1)) - (AND (INFILEP FILE2) + (AND (OR (STREAMP FILE2) + (INFILEP FILE2)) (TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1) REGION 'LEFT @@ -284,6 +287,6 @@ (FILESLOAD (SYSLOAD) COMPARETEXT VERSIONDEFS) (DECLARE%: DONTCOPY - (FILEMAP (NIL (665 16892 (EXAMINEDEFS 675 . 11290) (EXAMINEFILES 11292 . 12774) (TEDITDEF 12776 . -15098) (EXVV 15100 . 16890))))) + (FILEMAP (NIL (666 17082 (EXAMINEDEFS 676 . 11291) (EXAMINEFILES 11293 . 12964) (TEDITDEF 12966 . +15288) (EXVV 15290 . 17080))))) STOP diff --git a/lispusers/EXAMINEDEFS.LCOM b/lispusers/EXAMINEDEFS.LCOM index 4db3ff8c..afc886ac 100644 Binary files a/lispusers/EXAMINEDEFS.LCOM and b/lispusers/EXAMINEDEFS.LCOM differ diff --git a/lispusers/GITFNS b/lispusers/GITFNS index 015d1e52..4b5cbe62 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "26-Oct-2025 00:01:44" {WMEDLEY}GITFNS.;565 135222 +(FILECREATED "28-Oct-2025 14:10:06" {WMEDLEY}GITFNS.;569 131593 :EDIT-BY rmk - :CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-CD-MENUFN GIT-MAKE-PROJECT GIT-CLONEP) + :CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-BRANCHES-COMPARE-DIRECTORIES) - :PREVIOUS-DATE "25-Oct-2025 10:37:40" {WMEDLEY}GITFNS.;562) + :PREVIOUS-DATE "28-Oct-2025 13:32:16" {WMEDLEY}GITFNS.;568) (PRETTYCOMPRINT GITFNSCOMS) @@ -59,7 +59,7 @@ (* ;; "File correspondents") (FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS) - (FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES) + (FNS TOGIT FROMGIT) (FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE) (FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME) @@ -720,46 +720,6 @@ (CONCAT GF " cannot be copied")) T) DEST]) - -(GIT-DELETE-FILE - [LAMBDA (FILE PROJECT) (* ; "Edited 8-May-2022 09:27 by rmk") - (* ; "Edited 18-Jan-2022 23:07 by rmk") - (* ; "Edited 19-Dec-2021 16:11 by rmk") - (* ; "Edited 16-Dec-2021 13:00 by rmk") - - (* ;; "This deletes a file in the local checkout git directory {UNIX}... FILE has to already be a full file name, for safety.") - - (* ;; "Since git files are on UNIX, we don't have to worry about older version numbers. ") - - (* ;; "We could make this undoable by copying it to deleted/, but git also can restore.") - - (GIT-CLONEP FILE NIL T) - (DELFILE FILE]) - -(MYMEDLEY-DELETE-FILES - [LAMBDA (FILE PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk") - (* ; "Edited 8-May-2022 23:31 by rmk") - - (* ;; "FILE is presumably the latest version of a file in the MyMedley directory, and we are presumably removing all versions of that file. If we left older versions, we would really trash ourselves.") - - (* ;; "But to guard against mistakes, %"deletion%" consists of moving all versions of the file from its current location to a deleted/ subdirectory of MEDLEYDIR, one that does not correspond to a git subdirectory.") - - (SETQ FILE (CONTRACT.PH FILE (FETCH WHOST OF PROJECT))) - (CL:WHEN (EQ (FILENAMEFIELD (FETCH WHOST OF PROJECT) - 'HOST) - (FILENAMEFIELD FILE 'HOST)) - (FOR F IN (DREVERSE (FILDIR (PACKFILENAME 'VERSION '* 'BODY FILE))) - COLLECT - - (* ;; - "Delete the earlier ones first, if it goes bad, you don't want them to persist") - - (CL:UNLESS (RENAMEFILE F (PACKFILENAME 'DIRECTORY (CONCAT "deleted>" - (FILENAMEFIELD F - 'DIRECTORY)) - 'BODY F)) - (ERROR "Could not delete " F)) - F))]) ) (DEFINEQ @@ -1846,7 +1806,8 @@ (LIST DIR1 DIR2 MAPPINGS))]) (GIT-BRANCHES-COMPARE-DIRECTORIES - [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 2-Oct-2025 23:12 by rmk") + [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 28-Oct-2025 14:01 by rmk") + (* ; "Edited 2-Oct-2025 23:12 by rmk") (* ; "Edited 12-Jun-2024 22:52 by mth") (* ; "Edited 10-Jun-2024 18:42 by mth") (* ; "Edited 1-May-2024 14:58 by rmk") @@ -1938,8 +1899,10 @@ (LENGTH (fetch (CDVALUE CDENTRIES) of CDVALUE)) " files") (LIST SHORT1 SHORT2) - `(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2 PROJECT - ,PROJECT) + `((LABELFN . GIT-CD-LABELFN) + (BRANCH1 ,@BRANCH1) + (BRANCH2 ,@BRANCH2) + (PROJECT ,@PROJECT)) GIT-CDBROWSER-SEPARATE-DIRECTIONS `(Compare See)) (SETQ NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVALUE))) @@ -1952,6 +1915,8 @@ (GIT-WORKING-COMPARE-DIRECTORIES [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) + (* ;; "Edited 28-Oct-2025 14:00 by rmk") + (* ;; "Edited 25-Oct-2025 23:32 by rmk") (* ;; "Edited 29-Apr-2025 15:14 by rmk") @@ -2031,9 +1996,12 @@ do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " " (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) " files")) - [CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2) - `(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN - GIT-CD-LABELFN PROJECT ,PROJECT) + [CDBROWSER CDVAL TITLE `(,WPROJ ,@BRANCH2) + `((BRANCH1 ,@WPROJ) + (BRANCH2 ,@BRANCH2) + (SUBDIR ,@SUBDIR) + (LABELFN . GIT-CD-LABELFN) + (PROJECT ,@PROJECT)) GIT-CDBROWSER-SEPARATE-DIRECTIONS `(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN) ,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T) @@ -2213,7 +2181,8 @@ (OR LABEL2 FILE2]) (GIT-CD-MENUFN - [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 25-Oct-2025 23:44 by rmk") + [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 28-Oct-2025 11:50 by rmk") + (* ; "Edited 25-Oct-2025 23:44 by rmk") (* ; "Edited 21-Sep-2022 21:34 by rmk") (* ; "Edited 22-May-2022 19:13 by rmk") (* ; "Edited 8-May-2022 09:26 by rmk") @@ -2221,35 +2190,9 @@ (* ;; "MENUITEM is of the form (display-atom . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom") - (DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY)) + (DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA PWINDOW)) (SELECTQ (OR (CADDR MENUITEM) (CAR MENUITEM)) - (Delete% -> (FLASHWINDOW PWINDOW) - (GIVE.TTY.PROCESS PWINDOW) - (CL:WHEN [OR (EQ KEY 'MIDDLE) - (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " LABEL2 " ? "] - (GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT)) - (TB.DELETE.ITEM CDBROWSER TBITEM))) - (|Delete ALL <-| - (FLASHWINDOW PWINDOW) - (GIVE.TTY.PROCESS PWINDOW) - (if (NAMEFIELD LABEL1 T) - then (CL:WHEN [OR (EQ KEY 'MIDDLE) - (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete ALL versions of " - (NAMEFIELD LABEL1 T) - " ? "] - (MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT)) - (TB.DELETE.ITEM CDBROWSER TBITEM)) - else (PRINTOUT T "Nothing to delete"))) - (Delete% BOTH (FLASHWINDOW PWINDOW) - (GIVE.TTY.PROCESS PWINDOW) - (CL:WHEN (EQ 'Y (ASKUSER NIL 'N (CONCAT - "Delete all Medley and git versions of " - (NAMEFIELD LABEL1 T) - " ? "))) - (GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT)) - (MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT)) - (TB.DELETE.ITEM CDBROWSER TBITEM))) (Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM))) (SHOULDNT]) @@ -2451,33 +2394,32 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4243 21049 (GIT-CLONEP 4253 . 5684) (GIT-INIT 5686 . 6316) (GIT-MAKE-PROJECT 6318 . -14107) (GIT-GET-PROJECT 14109 . 16034) (GIT-PUT-PROJECT-FIELD 16036 . 17677) (GIT-PROJECT-PATH 17679 - . 18723) (FIND-ANCESTOR-DIRECTORY 18725 . 19074) (GIT-FIND-CLONE 19076 . 20157) (GIT-MAINBRANCH 20159 - . 20554) (GIT-MAINBRANCH? 20556 . 21047)) (26512 31441 (PRC-COMMAND 26522 . 31439)) (31497 34285 ( -ALLSUBDIRS 31507 . 32793) (MEDLEYSUBDIRS 32795 . 33488) (GITSUBDIRS 33490 . 34283)) (34286 39076 ( -TOGIT 34296 . 35702) (FROMGIT 35704 . 36685) (GIT-DELETE-FILE 36687 . 37533) (MYMEDLEY-DELETE-FILES -37535 . 39074)) (39077 42080 (MYMEDLEYSUBDIR 39087 . 39543) (GITSUBDIR 39545 . 39988) (STRIPDIR 39990 - . 40361) (STRIPHOST 40363 . 40603) (STRIPNAME 40605 . 41358) (STRIPWHERE 41360 . 42078)) (42081 44316 - (GFILE4MFILE 42091 . 42787) (MFILE4GFILE 42789 . 43358) (GIT-REPO-FILENAME 43360 . 44314)) (44365 -54620 (GIT-COMMIT 44375 . 45201) (GIT-PUSH 45203 . 45963) (GIT-PULL 45965 . 46717) (GIT-APPROVAL 46719 - . 47068) (GIT-GET-FILE 47070 . 48985) (GIT-FILE-EXISTS? 48987 . 49261) (GIT-REMOTE-UPDATE 49263 . -50098) (GIT-REMOTE-ADD 50100 . 50407) (GIT-FILE-DATE 50409 . 51456) (GIT-FILE-HISTORY 51458 . 53392) ( -GIT-PRINT-FILE-HISTORY 53394 . 54444) (GIT-FETCH 54446 . 54618)) (54650 66130 (GIT-BRANCH-DIFF 54660 - . 61549) (GIT-COMMIT-DIFFS 61551 . 62442) (GIT-BRANCH-RELATIONS 62444 . 66128)) (66175 84914 ( -GIT-BRANCH-NUM 66185 . 66758) (GIT-CHECKOUT 66760 . 68046) (GIT-WHICH-BRANCH 68048 . 68455) ( -GIT-MAKE-BRANCH 68457 . 71036) (GIT-BRANCHES 71038 . 73633) (GIT-BRANCH-EXISTS? 73635 . 74506) ( -GIT-PICK-BRANCH 74508 . 74998) (GIT-BRANCH-MENU 75000 . 75881) (GIT-BRANCH-WHENSELECTEDFN 75883 . -77422) (GIT-PULL-REQUESTS 77424 . 81295) (GIT-SHORT-BRANCH-NAME 81297 . 81588) (GIT-LONG-NAME 81590 . -81907) (GIT-PRC-BRANCHES 81909 . 84912)) (84944 88392 (GIT-MY-CURRENT-BRANCH 84954 . 85324) ( -GIT-MY-BRANCHP 85326 . 85944) (GIT-MY-NEXT-BRANCH 85946 . 86440) (GIT-MY-BRANCHES 86442 . 88390)) ( -88438 92513 (GIT-ADD-WORKTREE 88448 . 90055) (GIT-REMOVE-WORKTREE 90057 . 90987) (GIT-LIST-WORKTREES -90989 . 91793) (WORKTREEDIR 91795 . 92511)) (92561 126762 (GIT-GET-DIFFERENT-FILES 92571 . 99479) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 99481 . 106920) (GIT-WORKING-COMPARE-DIRECTORIES 106922 . 112559) ( -GIT-COMPARE-WORKTREE 112561 . 116539) (GITCDOBJBUTTONFN 116541 . 121031) (GIT-CD-LABELFN 121033 . -122115) (GIT-CD-MENUFN 122117 . 124743) (GIT-WORKING-COMPARE-FILES 124745 . 125365) ( -GIT-BRANCHES-COMPARE-FILES 125367 . 126531) (GIT-PR-COMPARE 126533 . 126760)) (126832 135155 (CDGITDIR - 126842 . 127529) (GIT-COMMAND 127531 . 129089) (GITORIGIN 129091 . 129788) (GIT-INITIALS 129790 . -130094) (GIT-COMMAND-TO-FILE 130096 . 133581) (GIT-RESULT-TO-LINES 133583 . 134488) (STRIPLOCAL 134490 - . 135153))))) + (FILEMAP (NIL (4196 21002 (GIT-CLONEP 4206 . 5637) (GIT-INIT 5639 . 6269) (GIT-MAKE-PROJECT 6271 . +14060) (GIT-GET-PROJECT 14062 . 15987) (GIT-PUT-PROJECT-FIELD 15989 . 17630) (GIT-PROJECT-PATH 17632 + . 18676) (FIND-ANCESTOR-DIRECTORY 18678 . 19027) (GIT-FIND-CLONE 19029 . 20110) (GIT-MAINBRANCH 20112 + . 20507) (GIT-MAINBRANCH? 20509 . 21000)) (26465 31394 (PRC-COMMAND 26475 . 31392)) (31450 34238 ( +ALLSUBDIRS 31460 . 32746) (MEDLEYSUBDIRS 32748 . 33441) (GITSUBDIRS 33443 . 34236)) (34239 36640 ( +TOGIT 34249 . 35655) (FROMGIT 35657 . 36638)) (36641 39644 (MYMEDLEYSUBDIR 36651 . 37107) (GITSUBDIR +37109 . 37552) (STRIPDIR 37554 . 37925) (STRIPHOST 37927 . 38167) (STRIPNAME 38169 . 38922) ( +STRIPWHERE 38924 . 39642)) (39645 41880 (GFILE4MFILE 39655 . 40351) (MFILE4GFILE 40353 . 40922) ( +GIT-REPO-FILENAME 40924 . 41878)) (41929 52184 (GIT-COMMIT 41939 . 42765) (GIT-PUSH 42767 . 43527) ( +GIT-PULL 43529 . 44281) (GIT-APPROVAL 44283 . 44632) (GIT-GET-FILE 44634 . 46549) (GIT-FILE-EXISTS? +46551 . 46825) (GIT-REMOTE-UPDATE 46827 . 47662) (GIT-REMOTE-ADD 47664 . 47971) (GIT-FILE-DATE 47973 + . 49020) (GIT-FILE-HISTORY 49022 . 50956) (GIT-PRINT-FILE-HISTORY 50958 . 52008) (GIT-FETCH 52010 . +52182)) (52214 63694 (GIT-BRANCH-DIFF 52224 . 59113) (GIT-COMMIT-DIFFS 59115 . 60006) ( +GIT-BRANCH-RELATIONS 60008 . 63692)) (63739 82478 (GIT-BRANCH-NUM 63749 . 64322) (GIT-CHECKOUT 64324 + . 65610) (GIT-WHICH-BRANCH 65612 . 66019) (GIT-MAKE-BRANCH 66021 . 68600) (GIT-BRANCHES 68602 . 71197 +) (GIT-BRANCH-EXISTS? 71199 . 72070) (GIT-PICK-BRANCH 72072 . 72562) (GIT-BRANCH-MENU 72564 . 73445) ( +GIT-BRANCH-WHENSELECTEDFN 73447 . 74986) (GIT-PULL-REQUESTS 74988 . 78859) (GIT-SHORT-BRANCH-NAME +78861 . 79152) (GIT-LONG-NAME 79154 . 79471) (GIT-PRC-BRANCHES 79473 . 82476)) (82508 85956 ( +GIT-MY-CURRENT-BRANCH 82518 . 82888) (GIT-MY-BRANCHP 82890 . 83508) (GIT-MY-NEXT-BRANCH 83510 . 84004) + (GIT-MY-BRANCHES 84006 . 85954)) (86002 90077 (GIT-ADD-WORKTREE 86012 . 87619) (GIT-REMOVE-WORKTREE +87621 . 88551) (GIT-LIST-WORKTREES 88553 . 89357) (WORKTREEDIR 89359 . 90075)) (90125 123133 ( +GIT-GET-DIFFERENT-FILES 90135 . 97043) (GIT-BRANCHES-COMPARE-DIRECTORIES 97045 . 104672) ( +GIT-WORKING-COMPARE-DIRECTORIES 104674 . 110470) (GIT-COMPARE-WORKTREE 110472 . 114450) ( +GITCDOBJBUTTONFN 114452 . 118942) (GIT-CD-LABELFN 118944 . 120026) (GIT-CD-MENUFN 120028 . 121114) ( +GIT-WORKING-COMPARE-FILES 121116 . 121736) (GIT-BRANCHES-COMPARE-FILES 121738 . 122902) ( +GIT-PR-COMPARE 122904 . 123131)) (123203 131526 (CDGITDIR 123213 . 123900) (GIT-COMMAND 123902 . +125460) (GITORIGIN 125462 . 126159) (GIT-INITIALS 126161 . 126465) (GIT-COMMAND-TO-FILE 126467 . +129952) (GIT-RESULT-TO-LINES 129954 . 130859) (STRIPLOCAL 130861 . 131524))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index bab7dfcc..da2bc98b 100644 Binary files a/lispusers/GITFNS.LCOM and b/lispusers/GITFNS.LCOM differ diff --git a/scripts/loadups/loadup-init.sh b/scripts/loadups/loadup-init.sh index 4a42bd00..c1d5b75e 100755 --- a/scripts/loadups/loadup-init.sh +++ b/scripts/loadups/loadup-init.sh @@ -11,6 +11,7 @@ main() { (* "make init files; this file is loaded as a 'greet' file by scripts/loadup-init.sh") (SETQ MEDLEYDIR NIL) + (SETATOMVAL (QUOTE MEDLEY-INIT-VARS) (QUOTE NOBIND)) (LOAD (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM")) (MEDLEY-INIT-VARS) (PUTASSOC (QUOTE MEDLEY) (LIST (UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))) SYSOUTCOMMITS) diff --git a/scripts/loadups/loadup-lisp-from-mid.sh b/scripts/loadups/loadup-lisp-from-mid.sh index df4999b6..42ddb959 100755 --- a/scripts/loadups/loadup-lisp-from-mid.sh +++ b/scripts/loadups/loadup-lisp-from-mid.sh @@ -12,6 +12,7 @@ main() { (PROGN (SETQ LOADUP-SUCCESS NIL) + (SETATOMVAL (QUOTE MEDLEY-INIT-VARS) (QUOTE NOBIND)) (LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE MEDLEYDIR)) (QUOTE /sources/MEDLEYDIR.LCOM))) (MEDLEY-INIT-VARS) (LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-LISP.LCOM))) diff --git a/sources/FONT b/sources/FONT index 6e40fa42..fb086c1f 100644 --- a/sources/FONT +++ b/sources/FONT @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Oct-2025 19:43:25" {WMEDLEY}FONT.;621 286216 +(FILECREATED "29-Nov-2025 16:32:59" {WMEDLEY}FONT.;638 280293 :EDIT-BY rmk :CHANGES-TO (VARS FONTCOMS) - (FNS MONOSPACEFONTP) - :PREVIOUS-DATE "13-Oct-2025 21:33:14" {WMEDLEY}FONT.;620) + :PREVIOUS-DATE "28-Nov-2025 14:28:16" {WMEDLEY}FONT.;637) (PRETTYCOMPRINT FONTCOMS) @@ -16,21 +15,18 @@ [ (* ;; "font functions ") - (DECLARE%: EVAL@COMPILE DONTCOPY (* ; - "Can't be loaded/not needed during INIT, load at end of LOAD-LISP.") - (FILES (SYSLOAD) - MULTI-ALIST)) (FNS CHARWIDTH CHARWIDTHY STRINGWIDTH \CHARWIDTH.DISPLAY \STRINGWIDTH.DISPLAY \STRINGWIDTH.GENERIC) (COMS (FNS DEFAULTFONT FONTCLASS FONTCLASSUNPARSE FONTCLASSCOMPONENT SETFONTCLASSCOMPONENT GETFONTCLASSCOMPONENT) (MACROS \GETFONTCLASSCOMPONENT \SETFONTCLASSCOMPONENT)) (VARS NSFONTFAMILIES ALTOFONTFAMILIES) + (INITVARS MCCSFONTFAMILIES) (COMS (* ;; "Creation: ") - (FNS FONTCREATE FONTCREATE1 FONTCREATE.SLUGFD \FONT.CHECKARGS \FONT.CHECKARGS1 - \FONTCREATE1.NOFN FONTFILEP \READCHARSET) + (FNS FONTCREATE FONTCREATE1 FONTCREATE.SLUGFD \FONT.CHECKARGS1 \FONTCREATE1.NOFN + FONTFILEP \READCHARSET) (FNS \FONT.CHECKARGS \CHARSET.CHECK) (FNS COERCEFONTSPEC) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS COERCEFONTSPEC.MATCH COERCEFONTSPEC.TARGET)) @@ -63,15 +59,20 @@ (FNS FONTCOPY FONTP FONTUNPARSE SETFONTDESCRIPTOR \STREAMCHARWIDTH \COERCECHARSET \BUILDSLUGCSINFO \FONTSYMBOL \DEVICESYMBOL \FONTFACE \FONTFACE.COLOR SETFONTCHARENCODING ) - (FNS FONTSAVAILABLE FONTEXISTS? \SEARCHFONTFILES FLUSHFONTSINCORE FINDFONTFILES SORTFONTSPECS - ) + (FNS FONTSAVAILABLE FONTEXISTS? \SEARCHFONTFILES FLUSHFONTCACHE FLUSHFONTSINCORE + FINDFONTFILES SORTFONTSPECS) (FNS MATCHFONTFACE MAKEFONTFACE FONTFACETOATOM) - (INITVARS \FONTSINCORE \FONTEXISTS?-CACHE \DEFAULTDEVICEFONTS) + (INITVARS \FONTSINCORE \FONTEXISTS?-CACHE \FONTSAVAILABLEFILECACHE \DEFAULTDEVICEFONTS) + + (* ;; "The INITVARS value of MEDLEY-INIT-VARS in MEDLEY dalso includes these entries. That's because FONT is in the INIT, so these entries would be lost when MEDLEY-INIT-VARS is reinitialized when the Lisp loadup starts") + + (ADDVARS (MEDLEY-INIT-VARS (\FONTEXISTS?-CACHE NIL RESET) + (\FONTSAVAILABLEFILECACHE NIL RESET))) [COMS (GLOBALVARS \DEFAULTDEVICEFONTS \UNITWIDTHSVECTOR) (INITVARS \UNITWIDTHSVECTOR) (FNS \UNITWIDTHSVECTOR) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\UNITWIDTHSVECTOR] - (DECLARE%: DONTCOPY (EXPORT (RECORDS FONTCLASS FONTDESCRIPTOR FONTFACE CHARSETINFO FONTSPEC) + (DECLARE%: DONTCOPY [EXPORT (RECORDS FONTCLASS FONTDESCRIPTOR FONTFACE CHARSETINFO FONTSPEC) (MACROS FONTASCENT FONTDESCENT FONTHEIGHT \FGETOFFSET \FSETOFFSET \FGETWIDTH \FSETWIDTH \FGETCHARWIDTH \FSETCHARWIDTH \FGETIMAGEWIDTH \FSETIMAGEWIDTH) @@ -79,8 +80,7 @@ \CREATECSINFOELEMENT \CREATEFONTCHARSETVECTOR CHARSETPROP) (PROP ARGNAMES CHARSETPROP) (CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) - (SLUGCHARSET (ADD1 \MAXCHARSET))) - (MACROS LEGACYFONTS)) + (SLUGCHARSET (ADD1 \MAXCHARSET] (MACROS INDIRECTCHARSETP)) (FNS FONTDESCRIPTOR.DEFPRINT FONTCLASS.DEFPRINT) (INITRECORDS FONTCLASS FONTDESCRIPTOR CHARSETINFO) @@ -210,11 +210,6 @@ (* ;; "font functions ") -(DECLARE%: EVAL@COMPILE DONTCOPY - -(FILESLOAD (SYSLOAD) - MULTI-ALIST) -) (DEFINEQ (CHARWIDTH @@ -505,6 +500,8 @@ (RPAQQ ALTOFONTFAMILIES (TIMESROMAN TIMESROMAND HELVETICA HELVETICAD CLARITY BRAVOX TONTO CREAM OLDENGLISH)) +(RPAQ? MCCSFONTFAMILIES NIL) + (* ;; "Creation: ") @@ -620,111 +617,6 @@ else (for CS from 0 to (ADD1 \MAXCHARSET) do (\SETCHARSETINFO FONTDESC CS SLUGCSINFO))) FONTDESC]) -(\FONT.CHECKARGS - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 28-Aug-2025 14:46 by rmk") - (* ; "Edited 23-Aug-2025 11:54 by rmk") - (* ; "Edited 17-Aug-2025 19:15 by rmk") - (* ; "Edited 12-Aug-2025 22:36 by rmk") - (* ; "Edited 10-Aug-2025 12:06 by rmk") - (* ; "Edited 8-Aug-2025 09:57 by rmk") - (* ; "Edited 27-Jul-2025 13:30 by rmk") - (* ; "Edited 22-Jul-2025 23:07 by rmk") - (* ; "Edited 21-Jul-2025 09:22 by rmk") - (* ; "Edited 14-Jul-2025 20:09 by rmk") - (* ; "Edited 11-Jul-2025 10:15 by rmk") - (* ; "Edited 5-Jul-2025 13:37 by rmk") - (* ; "Edited 2-Jul-2025 16:50 by rmk") - (* ; "Edited 27-Jun-2025 10:42 by rmk") - (* ; "Edited 15-Jun-2025 00:25 by rmk") - - (* ;; "DON'T BREAK, TRACE, OR UNSAVE THIS UNLESS ALL SYSTEM FONTS HAVE ALREADY BEEN INSTANTIATED") - - (* ;; "Decodes and checks the various ways of specifying the arguments to font lookup functions.") - - (* ;; "If FAMILY can be coerced to a font descriptor and none of its properties are overwritten by the other aguments, then that font descriptor is returned. Otherwise the value is the coerced fontspec (family size face rotation device).") - - (LET (FONTX) - (CL:WHEN (AND (EQ 'CLASS (CAR (LISTP FAMILY))) - (LITATOM (CADR FAMILY))) - - (* ;; "This used to be at the entry to FONTCREATE, and it returned the FONTCLASS. That seemed wrong--FONTCREATE should always return a fontdescriptor. So here we build a throwaway fontclass, coerce it to its device font, and fall through.") - - (SETQ FAMILY (\FONT.CHECKARGS1 (FONTCLASS (CADR FAMILY) - (CDDR FAMILY)) - DEVICE))) - (CL:UNLESS (AND FAMILY (LITATOM FAMILY) - (NEQ FAMILY T)) - - (* ;; "FAMILY T or NIL produces an error below") - - [if (LISTP FAMILY) - then - (* ;; "Presumably a FONTSPEC. The variables here override the FONTX properties, as with the fontdescriptor below ") - - (SETQ FONTX (CL:IF (EQ 'FONT (CAR FAMILY)) - (CDR FAMILY) - FAMILY)) - (SETQ FAMILY (fetch (FONTSPEC FSFAMILY) of FONTX)) - (SETQ SIZE (OR SIZE (fetch (FONTSPEC FSSIZE) of FONTX))) - (SETQ FACE (OR FACE (fetch (FONTSPEC FSFACE) of FONTX))) - (SETQ ROTATION (OR ROTATION (fetch (FONTSPEC FSROTATION) of FONTX))) - (SETQ DEVICE (OR DEVICE (fetch (FONTSPEC FSDEVICE) of FONTX))) - (SETQ FONTX NIL) - elseif (SETQ FONTX (CL:IF (type? FONTDESCRIPTOR FAMILY) - FAMILY - (\FONT.CHECKARGS1 FAMILY DEVICE T))) - then - (* ;; - "FAMILY was a spec for a font descriptor. Are any of its properties overwritten?") - - (SETQ FAMILY (fetch (FONTDESCRIPTOR FONTFAMILY) of FONTX)) - (CL:UNLESS SIZE - (SETQ SIZE (fetch (FONTDESCRIPTOR FONTSIZE) of FONTX))) - (CL:UNLESS FACE - (SETQ FACE (fetch (FONTDESCRIPTOR FONTFACE) of FONTX))) - (CL:UNLESS ROTATION - (SETQ ROTATION (fetch (FONTDESCRIPTOR ROTATION) of FONTX))) - (CL:UNLESS DEVICE - (SETQ DEVICE (fetch (FONTDESCRIPTOR FONTDEVICE) of FONTX)))]) - - (* ;; "We have decoded the arguments, fill in defaults and validate") - - (SETQ DEVICE (if (NULL DEVICE) - then 'DISPLAY - elseif (OR (AND (LITATOM DEVICE) - (NEQ DEVICE T)) - (STRINGP DEVICE)) - then (\DEVICESYMBOL DEVICE) - elseif [AND (SETQ DEVICE (\GETSTREAM DEVICE 'OUTPUT T)) - (CAR (MKLIST (IMAGESTREAMTYPE DEVICE] - else (\ILLEGAL.ARG DEVICE))) - (CL:UNLESS (AND FAMILY (LITATOM FAMILY) - (NEQ FAMILY T)) - (ERROR "Illegal font family" FAMILY)) - (SETQ FAMILY (U-CASE FAMILY)) - (CL:UNLESS (OR (AND (FIXP SIZE) - (IGREATERP SIZE 0)) - (EQ SIZE '*)) - (ERROR "Illegal font size" SIZE)) - (CL:UNLESS (EQ FACE '*) - (SETQ FACE (\FONTFACE FACE NIL DEVICE))) - (if (NULL ROTATION) - then (SETQ ROTATION 0) - elseif (AND (FIXP ROTATION) - (IGEQ ROTATION 0)) - elseif (EQ ROTATION '*) - else (\ILLEGAL.ARG ROTATION)) - (CL:WHEN FONTX - - (* ;; "Return FONTX only if no fields were overwritten") - - (CL:UNLESS (AND (EQ SIZE (fetch (FONTDESCRIPTOR FONTSIZE) of FONTX)) - (EQUAL FACE (fetch (FONTDESCRIPTOR FONTFACE) of FONTX)) - (EQ ROTATION (fetch (FONTDESCRIPTOR ROTATION) of FONTX)) - (EQ DEVICE (fetch (FONTDESCRIPTOR FONTDEVICE) of FONTX))) - (SETQ FONTX NIL))) - (OR FONTX (MAKEFONTSPEC FAMILY SIZE FACE ROTATION DEVICE]) - (\FONT.CHECKARGS1 [LAMBDA (SPEC STREAM NOERRORFLG) (* ; "Edited 22-Jul-2025 18:47 by rmk") (* ; "Edited 14-Jul-2025 19:40 by rmk") @@ -821,7 +713,8 @@ (CLOSEF? STRM))))]) (\READCHARSET - [LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 2-Sep-2025 23:57 by rmk") + [LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 11-Nov-2025 14:30 by rmk") + (* ; "Edited 2-Sep-2025 23:57 by rmk") (* ; "Edited 28-Aug-2025 23:17 by rmk") (* ; "Edited 25-Aug-2025 12:03 by rmk") (* ; "Edited 16-Aug-2025 18:00 by rmk") @@ -855,17 +748,15 @@ (* ;; "The file didn't know its own encoding") (SETQ FAMILY (fetch (FONTSPEC FSFAMILY) of FONTSPEC)) - (CHARSETPROP CSINFO 'CSCHARENCODING (if (NEQ CHARSET 0) - then 'MCCS - elseif (MEMB FAMILY - NSFONTFAMILIES - ) - then 'XCCS$ - elseif (MEMB FAMILY - ALTOFONTFAMILIES - ) - then 'ALTOTEXT - else FAMILY))) + (CHARSETPROP CSINFO 'CSCHARENCODING + (if (OR (NEQ CHARSET 0) + (MEMB FAMILY MCCSFONTFAMILIES)) + then 'MCCS + elseif (MEMB FAMILY NSFONTFAMILIES) + then 'XCCS$ + elseif (MEMB FAMILY ALTOFONTFAMILIES) + then 'ALTOTEXT + else FAMILY))) (* ;; "Remember the file that this basic charset information came from, before any character coercions, for informational purposes. Path and version won't be valid if sysout moves, or if PSEUDOFILENAME's aren't aligned. Don't want files to be new atoms, for loadup.") @@ -883,7 +774,8 @@ (DEFINEQ (\FONT.CHECKARGS - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 28-Aug-2025 14:46 by rmk") + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE ALWAYSFONTSPEC) (* ; "Edited 22-Nov-2025 11:31 by rmk") + (* ; "Edited 28-Aug-2025 14:46 by rmk") (* ; "Edited 23-Aug-2025 11:54 by rmk") (* ; "Edited 17-Aug-2025 19:15 by rmk") (* ; "Edited 12-Aug-2025 22:36 by rmk") @@ -980,7 +872,8 @@ (* ;; "Return FONTX only if no fields were overwritten") - (CL:UNLESS (AND (EQ SIZE (fetch (FONTDESCRIPTOR FONTSIZE) of FONTX)) + (CL:UNLESS (AND (NOT ALWAYSFONTSPEC) + (EQ SIZE (fetch (FONTDESCRIPTOR FONTSIZE) of FONTX)) (EQUAL FACE (fetch (FONTDESCRIPTOR FONTFACE) of FONTX)) (EQ ROTATION (fetch (FONTDESCRIPTOR ROTATION) of FONTX)) (EQ DEVICE (fetch (FONTDESCRIPTOR FONTDEVICE) of FONTX))) @@ -998,7 +891,8 @@ (DEFINEQ (COERCEFONTSPEC - [LAMBDA (FONTSPEC COERCIONS) (* ; "Edited 5-Oct-2025 09:41 by rmk") + [LAMBDA (FONTSPEC COERCIONS) (* ; "Edited 9-Nov-2025 17:54 by rmk") + (* ; "Edited 5-Oct-2025 09:41 by rmk") (* ; "Edited 28-Aug-2025 14:41 by rmk") (* ; "Edited 25-Aug-2025 10:22 by rmk") (* ; "Edited 17-Aug-2025 19:15 by rmk") @@ -1012,11 +906,14 @@ (* ;; "Doesn't make sense to coerce the device, DEVICE and also CHARSET are just carried along.") + (CL:WHEN (LITATOM COERCIONS) + [SETQ COERCIONS (FONTDEVICEPROP FONTSPEC (OR COERCIONS 'FONTCOERCIONS]) + (* ;; "A NIL match component matches everything, and a NIL target component denotes the corresponding argument.") (for C MATCH TARGET MFAMILY MSIZE MFACE MROTATION TFAMILY TSIZE TFACE TROTATION COERCED FAMILY - SIZE FACE ROTATION DEVICE in (OR COERCIONS (FONTDEVICEPROP FONTSPEC 'FONTCOERCIONS)) - first (SPREADFONTSPEC FONTSPEC) eachtime (SETQ MATCH (MKLIST (CAR C))) + SIZE FACE ROTATION DEVICE in COERCIONS first (SPREADFONTSPEC FONTSPEC) + eachtime (SETQ MATCH (MKLIST (CAR C))) when [AND (COERCEFONTSPEC.MATCH (pop MATCH) FAMILY) (COERCEFONTSPEC.MATCH (pop MATCH) @@ -1092,17 +989,22 @@ (DEFINEQ (MAKEFONTSPEC - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 28-Aug-2025 14:32 by rmk") + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE BASE) (* ; "Edited 7-Nov-2025 07:52 by rmk") + (* ; "Edited 28-Aug-2025 14:32 by rmk") (* ; "Edited 17-Aug-2025 20:44 by rmk") (* ;; "This is a function, not a macro, so that it can be used in the loadup sequence to create the FONTSPEC for the \GUARANTEEDDISPLAYFONT. That font is created by \CREATEFONT and therefore is not dependent on \FONT.CHECKARGS or on the multi-alist multi-key indexing functions. The strategy might change if MULTI-ALIST is moved earlier in the loadup sequence.") + (* ;; "BASE (fontspec or font) provides defaults for NIL arguments, essentialy models a (create using BASE...)") + + (CL:WHEN (FONTP BASE) + (SETQ BASE (FONTPROP BASE 'SPEC))) (create FONTSPEC - FSFAMILY _ FAMILY - FSSIZE _ SIZE - FSFACE _ FACE - FSROTATION _ ROTATION - FSDEVICE _ DEVICE]) + FSFAMILY _ (OR FAMILY (fetch (FONTSPEC FSFAMILY) of BASE)) + FSSIZE _ (OR SIZE (fetch (FONTSPEC FSSIZE) of BASE)) + FSFACE _ (OR FACE (fetch (FONTSPEC FSFACE) of BASE)) + FSROTATION _ (OR ROTATION (fetch (FONTSPEC FSROTATION) of BASE)) + FSDEVICE _ (OR DEVICE (fetch (FONTSPEC FSDEVICE) of BASE]) ) (DEFINEQ @@ -2092,7 +1994,8 @@ 'EXTENSION EXTENSION]) (FONTSPECFROMFILENAME - [LAMBDA (FONTFILE DEVICE) (* ; "Edited 30-Aug-2025 10:05 by rmk") + [LAMBDA (FONTFILE DEVICE) (* ; "Edited 23-Nov-2025 21:42 by rmk") + (* ; "Edited 30-Aug-2025 10:05 by rmk") (* ; "Edited 28-Aug-2025 14:28 by rmk") (* ; "Edited 25-Aug-2025 10:16 by rmk") (* ; "Edited 23-Aug-2025 10:42 by rmk") @@ -2128,17 +2031,23 @@ (SETQ NAME (U-CASE NAME)) (SETQ FACE (SUBSTRING NAME SIZEEND)) (* ;  "don't need name, but checks for lowercase face") - [SETQ FACE (LIST (SELCHARQ (NTHCHARCODE FACE 1) + (SETQ FACE (LIST (SELCHARQ (NTHCHARCODE FACE 1) (B 'BOLD) (L 'LIGHT) - 'MEDIUM) + (M 'MEDIUM) + NIL) (SELCHARQ (NTHCHARCODE FACE 2) (I 'ITALIC) - 'REGULAR) + (R 'REGULAR) + NIL) (SELCHARQ (NTHCHARCODE FACE 3) (C 'COMPRESSED) (E 'EXPANDED) - 'REGULAR] + (R 'REGULAR) + NIL))) + (CL:WHEN (MEMB NIL FACE) (* ; + "Named didn't have a recognizable face") + (SETQ FACE NIL)) (CL:WHEN (SETQ CHARSET (STRPOS "-c" NAME NIL NIL NIL T UPPERCASEARRAY)) [SETQ CHARSET (FIXP (MKATOM (CONCAT (SUBSTRING NAME CHARSET) "Q"]) @@ -2795,7 +2704,9 @@ (DEFINEQ (FONTSAVAILABLE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHECKFILESTOO?) (* ; "Edited 25-Sep-2025 18:39 by rmk") + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHECKFILESTOO?) (* ; "Edited 22-Nov-2025 11:32 by rmk") + (* ; "Edited 6-Nov-2025 13:50 by rmk") + (* ; "Edited 25-Sep-2025 18:39 by rmk") (* ; "Edited 30-Aug-2025 13:55 by rmk") (* ; "Edited 28-Aug-2025 14:43 by rmk") (* ; "Edited 23-Aug-2025 10:51 by rmk") @@ -2810,48 +2721,63 @@ (* ;;; "returns a list of the fonts fitting a description that are available. FAMILY SIZE FACE or ROTATION can be * which means get them all. if CHECKFILESTOO? is NIL, only fonts in core will be considered. If ONLY, fonts in memory will be ignored. ") - (DECLARE (GLOBALVARS \FONTSINCORE)) - (LET ((FONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE))) - (if (EQ '* (fetch (FONTSPEC FSDEVICE) of FONTSPEC)) - then - (* ;; + (DECLARE (GLOBALVARS \FONTSINCORE \FONTSAVAILABLEFILECACHE)) + (LET + ((FONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE T)) + FILEFONTS) + (if (EQ '* (fetch (FONTSPEC FSDEVICE) of FONTSPEC)) + then + (* ;;  "The results for each device will be grouped together, because the sort happens in the clause below") - (for I in IMAGESTREAMTYPES join (FONTSAVAILABLE FONTSPEC NIL NIL NIL (CAR I) - CHECKFILESTOO?)) - else (SPREADFONTSPEC FONTSPEC) (* ; "For easier matching code") - (SORTFONTSPECS (UNION (CL:UNLESS (EQ 'ONLY CHECKFILESTOO?) - [COLLECTMULTI \FONTSINCORE - (FUNCTION (LAMBDA (FM S FC R D FONT) - (DECLARE (USEDFREE $$COLLECT)) - (CL:WHEN - [AND (OR (EQ FAMILY FM) - (EQ FAMILY '*)) - (OR (EQ SIZE S) - (EQ SIZE '*)) - (MATCHFONTFACE FACE FC) - (OR (EQ ROTATION R) - (EQ ROTATION '*)) - (OR (EQ DEVICE D) - (EQ DEVICE '*] - (push $$COLLECT - (create FONTSPEC - FSFAMILY _ FM - FSSIZE _ S - FSFACE _ FC - FSROTATION _ R - FSDEVICE _ D)))]) - (CL:WHEN CHECKFILESTOO?(* ; + (for I in IMAGESTREAMTYPES join (FONTSAVAILABLE FONTSPEC NIL NIL NIL (CAR I) + CHECKFILESTOO?)) + else + (SPREADFONTSPEC FONTSPEC) (* ; "For easier matching code") + (SORTFONTSPECS + (UNION (CL:UNLESS (EQ 'ONLY CHECKFILESTOO?) + [COLLECTMULTI \FONTSINCORE + (FUNCTION (LAMBDA (FM S FC R D FONT) + (DECLARE (USEDFREE $$COLLECT)) + (CL:WHEN [AND (OR (EQ FAMILY FM) + (EQ FAMILY '*)) + (OR (EQ SIZE S) + (EQ SIZE '*)) + (MATCHFONTFACE FACE FC) + (OR (EQ ROTATION R) + (EQ ROTATION '*)) + (OR (EQ DEVICE D) + (EQ DEVICE '*] + (push $$COLLECT + (create FONTSPEC + FSFAMILY _ FM + FSSIZE _ S + FSFACE _ FC + FSROTATION _ R + FSDEVICE _ D)))]) + (CL:WHEN CHECKFILESTOO? (* ;  "apply the device font lookup function.") - (LET [(FN (OR (CAR (GETMULTI IMAGESTREAMTYPES DEVICE - 'FONTSAVAILABLE)) - (FUNCTION \SEARCHFONTFILES] + (SETQ FILEFONTS (SGETMULTI \FONTSAVAILABLEFILECACHE FAMILY SIZE FACE ROTATION + DEVICE)) - (* ;; "Until all the device functions take a FONTSPEC") + (* ;; "APPEND the cache value because of the SORT") - (CL:IF (EQ 1 (NARGS FN)) - (APPLY* FN FONTSPEC) - (APPLY* FN FAMILY SIZE FACE ROTATION DEVICE))))]) + (APPEND (if (NULL FILEFONTS) + then (LET [(FN (OR (CAR (GETMULTI IMAGESTREAMTYPES DEVICE + 'FONTSAVAILABLE)) + (FUNCTION \SEARCHFONTFILES] + + (* ;; "Until all the device functions take a FONTSPEC") + + (SETQ FILEFONTS (CL:IF (EQ 1 (NARGS FN)) + (APPLY* FN FONTSPEC) + (APPLY* FN FAMILY SIZE FACE ROTATION + DEVICE))) + (SPUTMULTI \FONTSAVAILABLEFILECACHE FAMILY SIZE FACE + ROTATION DEVICE (OR FILEFONTS 'NONE)) + FILEFONTS) + elseif (NEQ FILEFONTS 'NONE) + then FILEFONTS)))]) (FONTEXISTS? [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOCOERCIONS) (* ; "Edited 26-Sep-2025 10:10 by rmk") @@ -2952,47 +2878,52 @@ FONTSFOUND) do (push FONTSFOUND THISFONT))) finally (RETURN (DREVERSE FONTSFOUND]) +(FLUSHFONTCACHE + [LAMBDA (TYPE FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 27-Nov-2025 10:02 by rmk") + (* ; "Edited 22-Nov-2025 15:52 by rmk") + + (* ;; + "Removes information for font(s) from the TYPE cache, if TYPE is NIL, all caches are flushed") + + (CL:UNLESS TYPE + (SETQ TYPE '(:INCORE :EXISTS :AVAILABLE))) + (if (LISTP TYPE) + then (for TY in TYPE collect (FLUSHFONTCACHE TY FAMILY SIZE FACE ROTATION DEVICE)) + else + (* ;; "If all NILs, don't want the default font") + + (SPREADFONTSPEC (\FONT.CHECKARGS (OR FAMILY '*) + (OR SIZE '*) + (OR FACE '*) + (OR ROTATION '*) + (OR DEVICE '*) + T)) + (LET ((NFLUSHED 0) + FONTX) + (DECLARE (SPECVARS NFLUSHED)) + [MAPMULTI (SELECTQ TYPE + (:INCORE \FONTSINCORE) + (:EXISTS \FONTEXISTS?-CACHE) + (:AVAILABLE \FONTSAVAILABLEFILECACHE) + (\ILLEGAL.ARG TYPE)) + (FUNCTION (LAMBDA (FM S FC R DPAIR) + (CL:WHEN (AND (OR (EQ FAMILY FM) + (EQ FAMILY '*)) + (OR (EQ SIZE S) + (EQ SIZE '*)) + (MATCHFONTFACE FACE FC) + (OR (EQ ROTATION R) + (EQ ROTATION '*)) + (OR (EQ DEVICE (CAR DPAIR)) + (EQ DEVICE '*)) + (CDR DPAIR)) + (ADD NFLUSHED 1) + (RPLACD DPAIR))] + (LIST TYPE NFLUSHED]) + (FLUSHFONTSINCORE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 26-Sep-2025 10:04 by rmk") - (* ; "Edited 4-Sep-2025 10:14 by rmk") - (* ; "Edited 28-Aug-2025 14:44 by rmk") - (* ; "Edited 18-Aug-2025 00:33 by rmk") - (* ; "Edited 12-Aug-2025 21:07 by rmk") - (* ; "Edited 21-Jul-2025 08:59 by rmk") - (* ; "Edited 21-Jun-2025 11:19 by rmk") - (DECLARE (SPECVARS . T) - (GLOBALVARS \FONTSINCORE \FONTEXISTS?-CACHE)) - (SPREADFONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE)) - (LET ((INCOREFLUSHED 0) - (EXISTSFLUSHED 0)) - (DECLARE (SPECVARS INCOREFLUSHED EXISTSFLUSHED)) - [MAPMULTI \FONTSINCORE (FUNCTION (LAMBDA (FM S FC R DPAIR) - (CL:WHEN (AND (OR (EQ FAMILY FM) - (EQ FAMILY '*)) - (OR (EQ SIZE S) - (EQ SIZE '*)) - (MATCHFONTFACE FACE FC) - (OR (EQ ROTATION R) - (EQ ROTATION '*)) - (OR (EQ DEVICE (CAR DPAIR)) - (EQ DEVICE '*)) - (CDR DPAIR)) - (ADD INCOREFLUSHED 1) - (RPLACD DPAIR))] - [MAPMULTI \FONTEXISTS?-CACHE (FUNCTION (LAMBDA (FM S FC R DPAIR) - (CL:WHEN (AND (OR (EQ FAMILY FM) - (EQ FAMILY '*)) - (OR (EQ SIZE S) - (EQ SIZE '*)) - (MATCHFONTFACE FACE FC) - (OR (EQ ROTATION R) - (EQ ROTATION '*)) - (OR (EQ DEVICE (CAR DPAIR)) - (EQ DEVICE '*)) - (CDR DPAIR)) - (ADD EXISTSFLUSHED 1) - (RPLACD DPAIR))] - (LIST INCOREFLUSHED EXISTSFLUSHED]) + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 22-Nov-2025 10:23 by rmk") + (FLUSHFONTCACHE :INCORE FAMILY SIZE FACE ROTATION DEVICE]) (FINDFONTFILES [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE DIRLST EXTLST) (* ; "Edited 28-Aug-2025 14:45 by rmk") @@ -3095,7 +3026,10 @@ (EQ PEXPANSION '*]) (MAKEFONTFACE - [LAMBDA (WEIGHT SLOPE EXPANSION BASE COLOR) (* ; "Edited 30-Aug-2025 10:22 by rmk") + [LAMBDA (WEIGHT SLOPE EXPANSION BASE COLOR) (* ; "Edited 7-Nov-2025 08:50 by rmk") + (* ; "Edited 30-Aug-2025 10:22 by rmk") + (CL:WHEN (FONTP BASE) + (SETQ BASE (FONTPROP BASE 'FACE))) (CL:UNLESS WEIGHT (SETQ WEIGHT (CL:IF BASE (fetch (FONTFACE WEIGHT) of BASE) @@ -3154,7 +3088,19 @@ (RPAQ? \FONTEXISTS?-CACHE NIL) +(RPAQ? \FONTSAVAILABLEFILECACHE NIL) + (RPAQ? \DEFAULTDEVICEFONTS NIL) + + + +(* ;; +"The INITVARS value of MEDLEY-INIT-VARS in MEDLEY dalso includes these entries. That's because FONT is in the INIT, so these entries would be lost when MEDLEY-INIT-VARS is reinitialized when the Lisp loadup starts" +) + + +(ADDTOVAR MEDLEY-INIT-VARS (\FONTEXISTS?-CACHE NIL RESET) + (\FONTSAVAILABLEFILECACHE NIL RESET)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \DEFAULTDEVICEFONTS \UNITWIDTHSVECTOR) @@ -3422,19 +3368,6 @@ (CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) (SLUGCHARSET (ADD1 \MAXCHARSET))) ) -(DECLARE%: EVAL@COMPILE - -(PUTPROPS LEGACYFONTS MACRO ((F . FORMS) (* ; - "Execute FORMS in a legacy font environment") - (RESETLST - (RESETSAVE \FONTSINCORE NIL) - (RESETSAVE \FONTEXISTS?-CACHE) - (RESETSAVE DISPLAYFONTCOERCIONS) - (RESETSAVE DISPLAYCHARCOERCIONS) - (RESETSAVE DISPLAYFONTEXTENSIONS '(DISPLAYFONT)) - (RESETSAVE DISPLAYFONTDIRECTORIES (MEDLEYDIR "fonts>displayfonts>")) - (PROGN F . FORMS)))) -) (* "END EXPORTED DEFINITIONS") @@ -4650,44 +4583,44 @@ (ADDTOVAR LAMA FONTCOPY) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (12132 21845 (CHARWIDTH 12142 . 12927) (CHARWIDTHY 12929 . 14446) (STRINGWIDTH 14448 . -15541) (\CHARWIDTH.DISPLAY 15543 . 15956) (\STRINGWIDTH.DISPLAY 15958 . 16382) (\STRINGWIDTH.GENERIC -16384 . 21843)) (21846 28366 (DEFAULTFONT 21856 . 23141) (FONTCLASS 23143 . 25305) (FONTCLASSUNPARSE -25307 . 26206) (FONTCLASSCOMPONENT 26208 . 26796) (SETFONTCLASSCOMPONENT 26798 . 27240) ( -GETFONTCLASSCOMPONENT 27242 . 28364)) (30045 54426 (FONTCREATE 30055 . 33300) (FONTCREATE1 33302 . -35917) (FONTCREATE.SLUGFD 35919 . 37401) (\FONT.CHECKARGS 37403 . 43993) (\FONT.CHECKARGS1 43995 . -48518) (\FONTCREATE1.NOFN 48520 . 48734) (FONTFILEP 48736 . 49624) (\READCHARSET 49626 . 54424)) ( -54427 61344 (\FONT.CHECKARGS 54437 . 61027) (\CHARSET.CHECK 61029 . 61342)) (61345 64428 ( -COERCEFONTSPEC 61355 . 64426)) (66498 67288 (MAKEFONTSPEC 66508 . 67286)) (67289 75466 (COMPLETE.FONT -67299 . 69822) (COMPLETEFONTP 69824 . 70447) (COMPLETE.CHARSET 70449 . 73134) (PRUNESLUGCSINFOS 73136 - . 74061) (MONOSPACEFONTP 74063 . 75464)) (75505 83426 (FONTASCENT 75515 . 75899) (FONTDESCENT 75901 - . 76386) (FONTHEIGHT 76388 . 76790) (FONTPROP 76792 . 82703) (\AVGCHARWIDTH 82705 . 83424)) (84083 -84991 (FONTDEVICEPROP 84093 . 84989)) (85037 85891 (EDITCHAR 85047 . 85889)) (85937 98127 ( -GETCHARBITMAP 85947 . 87071) (PUTCHARBITMAP 87073 . 89231) (\GETCHARBITMAP.CSINFO 89233 . 91249) ( -\PUTCHARBITMAP.CSINFO 91251 . 98125)) (98128 118608 (MOVECHARBITMAP 98138 . 100032) (MOVEFONTCHARS -100034 . 103994) (\MOVEFONTCHAR 103996 . 108839) (\MOVEFONTCHARS.SOURCEDATA 108841 . 114946) ( -\MAKESLUGCHAR 114948 . 117483) (SLUGCHARP.DISPLAY 117485 . 118606)) (119541 139679 (FONTFILES 119551 - . 121384) (\FINDFONTFILE 121386 . 123103) (\FONTFILENAMES 123105 . 124100) (\FONTFILENAME 124102 . -128085) (\FONTFILENAME.OLD 128087 . 131036) (\FONTFILENAME.NEW 131038 . 133295) (FONTSPECFROMFILENAME -133297 . 137398) (\FONTINFOFROMFILENAME.OLD 137400 . 139677)) (139946 175749 (FONTCOPY 139956 . 145019 -) (FONTP 145021 . 145320) (FONTUNPARSE 145322 . 147041) (SETFONTDESCRIPTOR 147043 . 148507) ( -\STREAMCHARWIDTH 148509 . 152673) (\COERCECHARSET 152675 . 155270) (\BUILDSLUGCSINFO 155272 . 158895) -(\FONTSYMBOL 158897 . 159547) (\DEVICESYMBOL 159549 . 160418) (\FONTFACE 160420 . 167610) ( -\FONTFACE.COLOR 167612 . 174532) (SETFONTCHARENCODING 174534 . 175747)) (175750 196301 (FONTSAVAILABLE - 175760 . 180615) (FONTEXISTS? 180617 . 184595) (\SEARCHFONTFILES 184597 . 187682) (FLUSHFONTSINCORE -187684 . 190857) (FINDFONTFILES 190859 . 194073) (SORTFONTSPECS 194075 . 196299)) (196302 199725 ( -MATCHFONTFACE 196312 . 197127) (MAKEFONTFACE 197129 . 197969) (FONTFACETOATOM 197971 . 199723)) ( -199953 200445 (\UNITWIDTHSVECTOR 199963 . 200443)) (215788 217855 (FONTDESCRIPTOR.DEFPRINT 215798 . -217377) (FONTCLASS.DEFPRINT 217379 . 217853)) (221684 224474 (\CREATEKERNELEMENT 221694 . 222052) ( -\FSETLEFTKERN 222054 . 222545) (\FGETLEFTKERN 222547 . 224472)) (224475 234111 (\CREATEFONT 224485 . -225924) (\CREATECHARSET 225926 . 229862) (\INSTALLCHARSETINFO 229864 . 233198) ( -\INSTALLCHARSETINFO.CHARENCODING 233200 . 234109)) (234433 235797 (\FONTRESETCHARWIDTHS 234443 . -235795)) (236427 246474 (\CREATEDISPLAYFONT 236437 . 238286) (\CREATECHARSET.DISPLAY 238288 . 243997) -(\FONTEXISTS?.DISPLAY 243999 . 246472)) (246475 261340 (STRIKEFONT.FILEP 246485 . 247373) ( -STRIKEFONT.GETCHARSET 247375 . 252967) (WRITESTRIKEFONTFILE 252969 . 257880) (STRIKECSINFO 257882 . -261338)) (261371 277688 (MAKEBOLD.CHARSET 261381 . 265030) (MAKEBOLD.CHAR 265032 . 266784) ( -MAKEITALIC.CHARSET 266786 . 270459) (MAKEITALIC.CHAR 270461 . 272807) (\SFMAKEBOLD 272809 . 275033) ( -\SFMAKEITALIC 275035 . 277686)) (277689 281838 (\SFMAKEROTATEDFONT 277699 . 279100) (\SFROTATECSINFO -279102 . 279739) (\SFROTATEFONTCHARACTERS 279741 . 280121) (\SFROTATECSINFOOFFSETS 280123 . 281836)) ( -281839 283220 (\SFMAKECOLOR 281849 . 283218))))) + (FILEMAP (NIL (12144 21857 (CHARWIDTH 12154 . 12939) (CHARWIDTHY 12941 . 14458) (STRINGWIDTH 14460 . +15553) (\CHARWIDTH.DISPLAY 15555 . 15968) (\STRINGWIDTH.DISPLAY 15970 . 16394) (\STRINGWIDTH.GENERIC +16396 . 21855)) (21858 28378 (DEFAULTFONT 21868 . 23153) (FONTCLASS 23155 . 25317) (FONTCLASSUNPARSE +25319 . 26218) (FONTCLASSCOMPONENT 26220 . 26808) (SETFONTCLASSCOMPONENT 26810 . 27252) ( +GETFONTCLASSCOMPONENT 27254 . 28376)) (30091 47595 (FONTCREATE 30101 . 33346) (FONTCREATE1 33348 . +35963) (FONTCREATE.SLUGFD 35965 . 37447) (\FONT.CHECKARGS1 37449 . 41972) (\FONTCREATE1.NOFN 41974 . +42188) (FONTFILEP 42190 . 43078) (\READCHARSET 43080 . 47593)) (47596 54672 (\FONT.CHECKARGS 47606 . +54355) (\CHARSET.CHECK 54357 . 54670)) (54673 57933 (COERCEFONTSPEC 54683 . 57931)) (60003 61342 ( +MAKEFONTSPEC 60013 . 61340)) (61343 69520 (COMPLETE.FONT 61353 . 63876) (COMPLETEFONTP 63878 . 64501) +(COMPLETE.CHARSET 64503 . 67188) (PRUNESLUGCSINFOS 67190 . 68115) (MONOSPACEFONTP 68117 . 69518)) ( +69559 77480 (FONTASCENT 69569 . 69953) (FONTDESCENT 69955 . 70440) (FONTHEIGHT 70442 . 70844) ( +FONTPROP 70846 . 76757) (\AVGCHARWIDTH 76759 . 77478)) (78137 79045 (FONTDEVICEPROP 78147 . 79043)) ( +79091 79945 (EDITCHAR 79101 . 79943)) (79991 92181 (GETCHARBITMAP 80001 . 81125) (PUTCHARBITMAP 81127 + . 83285) (\GETCHARBITMAP.CSINFO 83287 . 85303) (\PUTCHARBITMAP.CSINFO 85305 . 92179)) (92182 112662 ( +MOVECHARBITMAP 92192 . 94086) (MOVEFONTCHARS 94088 . 98048) (\MOVEFONTCHAR 98050 . 102893) ( +\MOVEFONTCHARS.SOURCEDATA 102895 . 109000) (\MAKESLUGCHAR 109002 . 111537) (SLUGCHARP.DISPLAY 111539 + . 112660)) (113595 134168 (FONTFILES 113605 . 115438) (\FINDFONTFILE 115440 . 117157) (\FONTFILENAMES + 117159 . 118154) (\FONTFILENAME 118156 . 122139) (\FONTFILENAME.OLD 122141 . 125090) ( +\FONTFILENAME.NEW 125092 . 127349) (FONTSPECFROMFILENAME 127351 . 131887) (\FONTINFOFROMFILENAME.OLD +131889 . 134166)) (134435 170238 (FONTCOPY 134445 . 139508) (FONTP 139510 . 139809) (FONTUNPARSE +139811 . 141530) (SETFONTDESCRIPTOR 141532 . 142996) (\STREAMCHARWIDTH 142998 . 147162) ( +\COERCECHARSET 147164 . 149759) (\BUILDSLUGCSINFO 149761 . 153384) (\FONTSYMBOL 153386 . 154036) ( +\DEVICESYMBOL 154038 . 154907) (\FONTFACE 154909 . 162099) (\FONTFACE.COLOR 162101 . 169021) ( +SETFONTCHARENCODING 169023 . 170236)) (170239 190538 (FONTSAVAILABLE 170249 . 175603) (FONTEXISTS? +175605 . 179583) (\SEARCHFONTFILES 179585 . 182670) (FLUSHFONTCACHE 182672 . 184895) (FLUSHFONTSINCORE + 184897 . 185094) (FINDFONTFILES 185096 . 188310) (SORTFONTSPECS 188312 . 190536)) (190539 194148 ( +MATCHFONTFACE 190549 . 191364) (MAKEFONTFACE 191366 . 192392) (FONTFACETOATOM 192394 . 194146)) ( +194779 195271 (\UNITWIDTHSVECTOR 194789 . 195269)) (209865 211932 (FONTDESCRIPTOR.DEFPRINT 209875 . +211454) (FONTCLASS.DEFPRINT 211456 . 211930)) (215761 218551 (\CREATEKERNELEMENT 215771 . 216129) ( +\FSETLEFTKERN 216131 . 216622) (\FGETLEFTKERN 216624 . 218549)) (218552 228188 (\CREATEFONT 218562 . +220001) (\CREATECHARSET 220003 . 223939) (\INSTALLCHARSETINFO 223941 . 227275) ( +\INSTALLCHARSETINFO.CHARENCODING 227277 . 228186)) (228510 229874 (\FONTRESETCHARWIDTHS 228520 . +229872)) (230504 240551 (\CREATEDISPLAYFONT 230514 . 232363) (\CREATECHARSET.DISPLAY 232365 . 238074) +(\FONTEXISTS?.DISPLAY 238076 . 240549)) (240552 255417 (STRIKEFONT.FILEP 240562 . 241450) ( +STRIKEFONT.GETCHARSET 241452 . 247044) (WRITESTRIKEFONTFILE 247046 . 251957) (STRIKECSINFO 251959 . +255415)) (255448 271765 (MAKEBOLD.CHARSET 255458 . 259107) (MAKEBOLD.CHAR 259109 . 260861) ( +MAKEITALIC.CHARSET 260863 . 264536) (MAKEITALIC.CHAR 264538 . 266884) (\SFMAKEBOLD 266886 . 269110) ( +\SFMAKEITALIC 269112 . 271763)) (271766 275915 (\SFMAKEROTATEDFONT 271776 . 273177) (\SFROTATECSINFO +273179 . 273816) (\SFROTATEFONTCHARACTERS 273818 . 274198) (\SFROTATECSINFOOFFSETS 274200 . 275913)) ( +275916 277297 (\SFMAKECOLOR 275926 . 277295))))) STOP diff --git a/sources/FONT.LCOM b/sources/FONT.LCOM index 98ce344a..767c19f9 100644 Binary files a/sources/FONT.LCOM and b/sources/FONT.LCOM differ diff --git a/sources/MEDLEYDIR b/sources/MEDLEYDIR index 124a06c6..ef363133 100644 --- a/sources/MEDLEYDIR +++ b/sources/MEDLEYDIR @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Aug-2025 17:25:03" {DSK}larry>il>medley>sources>MEDLEYDIR.;36 12210 +(FILECREATED "26-Nov-2025 21:51:39" {WMEDLEY}MEDLEYDIR.;43 15970 - :EDIT-BY "lmm" + :EDIT-BY rmk - :CHANGES-TO (FNS MEDLEYDIR) + :CHANGES-TO (VARS MEDLEYDIRCOMS) - :PREVIOUS-DATE "18-Aug-2025 11:19:10" {DSK}larry>il>medley>sources>MEDLEYDIR.;34) + :PREVIOUS-DATE "26-Nov-2025 17:12:16" {WMEDLEY}MEDLEYDIR.;42) (PRETTYCOMPRINT MEDLEYDIRCOMS) @@ -25,7 +25,47 @@ (* ;; "**WARNING** The EVALed expressions get run early in the lodup.") - (VARS MEDLEY-INIT-VARS) + + (* ;; "The INITVARS prevents this from accumulating entries from other files that happen to have been loaded when this is worked on and saved. The loadup scripts set MEDLEY-INIT-VARS to NOBIND to make sure that these are the initial values (as opposed to whatever there was in the startup sysout. But the FONT cache variables have to be specified here, because FONT is in the INIT and the resetting to NOBIND would wipe out these entries even if they were already correct in the init sysout.") + + [INITVARS (MEDLEY-INIT-VARS '((\FONTEXISTS?-CACHE NIL RESET) + (\FONTSAVAILABLEFILECACHE NIL RESET) + [LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" + "internal" + "greetfiles" + "doctools"] + [LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"] + (LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES)) + (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo")) + (IRM.DINFOGRAPH) + (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES + )) + (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV + "LOGINDIR") + (UNIX-GETENV + "HOME"] + (AND (GETD 'PSEUDOHOSTS) + (TARGETHOST 'LI) + (PSEUDOHOST 'LI LHD)) + LHD) + RESET) + (USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM)) + (CONS LOGINHOST/DIR '("INIT"] + RESET) + (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts" + "fonts/displayfonts") + NIL NIL T)) + (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts" + ) + NIL NIL T)) + (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts") + NIL NIL T)) + (UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox") + NIL NIL T)) + (XCL::*WHERE-IS-CASH-FILES* (MEDLEYDIR '("loadups") + "whereis.hash" NIL T)) + (LOADUPSDIRECTORIES (MEDLEYDIR '("loadups") + NIL NIL T] (DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS]) @@ -201,50 +241,49 @@ (* ;; "**WARNING** The EVALed expressions get run early in the lodup.") -(RPAQQ MEDLEY-INIT-VARS - ((ShellBrowser) - (ShellOpener) - [LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"] - [LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"] - (LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES)) - (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo")) - (IRM.DINFOGRAPH) - (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES)) - (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") - (UNIX-GETENV "HOME"] - (AND (GETD 'PSEUDOHOSTS) - (TARGETHOST 'LI) - (PSEUDOHOST 'LI LHD)) - LHD)) - [USERGREETFILES (LIST (CONS LOGINHOST/DIR '("INIT" COM)) - (CONS LOGINHOST/DIR '("INIT"] - (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts" "fonts/displayfonts") - NIL NIL T)) - (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts") - NIL NIL T)) - (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts") - NIL NIL T)) - (UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox") - NIL NIL T)) - (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") - (UNIX-GETENV "HOME"] - (AND (GETD 'PSEUDOHOSTS) - (TARGETHOST 'LI) - (PSEUDOHOST 'LI LHD)) - LHD) - RESET) - (USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM)) - (CONS LOGINHOST/DIR '("INIT"] - RESET) - (XCL::*WHERE-IS-CASH-FILES* (MEDLEYDIR '("loadups") - "whereis.hash" NIL T)) - (LOADUPSDIRECTORIES (MEDLEYDIR '("loadups") - NIL NIL T)))) + + +(* ;; +"The INITVARS prevents this from accumulating entries from other files that happen to have been loaded when this is worked on and saved. The loadup scripts set MEDLEY-INIT-VARS to NOBIND to make sure that these are the initial values (as opposed to whatever there was in the startup sysout. But the FONT cache variables have to be specified here, because FONT is in the INIT and the resetting to NOBIND would wipe out these entries even if they were already correct in the init sysout." +) + + +(RPAQ? MEDLEY-INIT-VARS + '((\FONTEXISTS?-CACHE NIL RESET) + (\FONTSAVAILABLEFILECACHE NIL RESET) + [LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"] + [LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"] + (LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES)) + (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo")) + (IRM.DINFOGRAPH) + (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES)) + (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") + (UNIX-GETENV "HOME"] + (AND (GETD 'PSEUDOHOSTS) + (TARGETHOST 'LI) + (PSEUDOHOST 'LI LHD)) + LHD) + RESET) + (USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM)) + (CONS LOGINHOST/DIR '("INIT"] + RESET) + (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts" "fonts/displayfonts") + NIL NIL T)) + (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts") + NIL NIL T)) + (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts") + NIL NIL T)) + (UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox") + NIL NIL T)) + (XCL::*WHERE-IS-CASH-FILES* (MEDLEYDIR '("loadups") + "whereis.hash" NIL T)) + (LOADUPSDIRECTORIES (MEDLEYDIR '("loadups") + NIL NIL T)))) (DECLARE%: EVAL@COMPILE DOCOPY (ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1675 9578 (MEDLEY-INIT-VARS 1685 . 5163) (MEDLEYDIR 5165 . 8378) (MEDLEYSUBSTDIR 8380 - . 9358) (SET-SYSOUT-COMMIT 9360 . 9576))))) + (FILEMAP (NIL (5329 13232 (MEDLEY-INIT-VARS 5339 . 8817) (MEDLEYDIR 8819 . 12032) (MEDLEYSUBSTDIR +12034 . 13012) (SET-SYSOUT-COMMIT 13014 . 13230))))) STOP diff --git a/sources/MEDLEYDIR.LCOM b/sources/MEDLEYDIR.LCOM index c6e924a0..8ad061fb 100644 Binary files a/sources/MEDLEYDIR.LCOM and b/sources/MEDLEYDIR.LCOM differ