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/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/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 e5ea0bb5..fb086c1f 100644 --- a/sources/FONT +++ b/sources/FONT @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Nov-2025 13:54:22" {WMEDLEY}FONT.;623 285863 +(FILECREATED "29-Nov-2025 16:32:59" {WMEDLEY}FONT.;638 280293 :EDIT-BY rmk :CHANGES-TO (VARS FONTCOMS) - (FNS FONTSAVAILABLE) - :PREVIOUS-DATE "20-Oct-2025 09:54:15" {WMEDLEY}FONT.;622) + :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,10 +59,15 @@ (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 \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) @@ -209,11 +210,6 @@ (* ;; "font functions ") -(DECLARE%: EVAL@COMPILE DONTCOPY - -(FILESLOAD (SYSLOAD) - MULTI-ALIST) -) (DEFINEQ (CHARWIDTH @@ -504,6 +500,8 @@ (RPAQQ ALTOFONTFAMILIES (TIMESROMAN TIMESROMAND HELVETICA HELVETICAD CLARITY BRAVOX TONTO CREAM OLDENGLISH)) +(RPAQ? MCCSFONTFAMILIES NIL) + (* ;; "Creation: ") @@ -619,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") @@ -820,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") @@ -854,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.") @@ -882,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") @@ -979,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))) @@ -997,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") @@ -1011,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) @@ -1091,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 @@ -2091,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") @@ -2127,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"]) @@ -2794,7 +2704,8 @@ (DEFINEQ (FONTSAVAILABLE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHECKFILESTOO?) (* ; "Edited 6-Nov-2025 13:50 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") @@ -2812,7 +2723,7 @@ (DECLARE (GLOBALVARS \FONTSINCORE \FONTSAVAILABLEFILECACHE)) (LET - ((FONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE)) + ((FONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE T)) FILEFONTS) (if (EQ '* (fetch (FONTSPEC FSDEVICE) of FONTSPEC)) then @@ -2967,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") @@ -3110,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) @@ -3172,6 +3091,16 @@ (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) @@ -4654,44 +4583,44 @@ (ADDTOVAR LAMA FONTCOPY) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (12098 21811 (CHARWIDTH 12108 . 12893) (CHARWIDTHY 12895 . 14412) (STRINGWIDTH 14414 . -15507) (\CHARWIDTH.DISPLAY 15509 . 15922) (\STRINGWIDTH.DISPLAY 15924 . 16348) (\STRINGWIDTH.GENERIC -16350 . 21809)) (21812 28332 (DEFAULTFONT 21822 . 23107) (FONTCLASS 23109 . 25271) (FONTCLASSUNPARSE -25273 . 26172) (FONTCLASSCOMPONENT 26174 . 26762) (SETFONTCLASSCOMPONENT 26764 . 27206) ( -GETFONTCLASSCOMPONENT 27208 . 28330)) (30011 54392 (FONTCREATE 30021 . 33266) (FONTCREATE1 33268 . -35883) (FONTCREATE.SLUGFD 35885 . 37367) (\FONT.CHECKARGS 37369 . 43959) (\FONT.CHECKARGS1 43961 . -48484) (\FONTCREATE1.NOFN 48486 . 48700) (FONTFILEP 48702 . 49590) (\READCHARSET 49592 . 54390)) ( -54393 61310 (\FONT.CHECKARGS 54403 . 60993) (\CHARSET.CHECK 60995 . 61308)) (61311 64394 ( -COERCEFONTSPEC 61321 . 64392)) (66464 67254 (MAKEFONTSPEC 66474 . 67252)) (67255 75432 (COMPLETE.FONT -67265 . 69788) (COMPLETEFONTP 69790 . 70413) (COMPLETE.CHARSET 70415 . 73100) (PRUNESLUGCSINFOS 73102 - . 74027) (MONOSPACEFONTP 74029 . 75430)) (75471 83392 (FONTASCENT 75481 . 75865) (FONTDESCENT 75867 - . 76352) (FONTHEIGHT 76354 . 76756) (FONTPROP 76758 . 82669) (\AVGCHARWIDTH 82671 . 83390)) (84049 -84957 (FONTDEVICEPROP 84059 . 84955)) (85003 85857 (EDITCHAR 85013 . 85855)) (85903 98093 ( -GETCHARBITMAP 85913 . 87037) (PUTCHARBITMAP 87039 . 89197) (\GETCHARBITMAP.CSINFO 89199 . 91215) ( -\PUTCHARBITMAP.CSINFO 91217 . 98091)) (98094 118574 (MOVECHARBITMAP 98104 . 99998) (MOVEFONTCHARS -100000 . 103960) (\MOVEFONTCHAR 103962 . 108805) (\MOVEFONTCHARS.SOURCEDATA 108807 . 114912) ( -\MAKESLUGCHAR 114914 . 117449) (SLUGCHARP.DISPLAY 117451 . 118572)) (119507 139645 (FONTFILES 119517 - . 121350) (\FINDFONTFILE 121352 . 123069) (\FONTFILENAMES 123071 . 124066) (\FONTFILENAME 124068 . -128051) (\FONTFILENAME.OLD 128053 . 131002) (\FONTFILENAME.NEW 131004 . 133261) (FONTSPECFROMFILENAME -133263 . 137364) (\FONTINFOFROMFILENAME.OLD 137366 . 139643)) (139912 175715 (FONTCOPY 139922 . 144985 -) (FONTP 144987 . 145286) (FONTUNPARSE 145288 . 147007) (SETFONTDESCRIPTOR 147009 . 148473) ( -\STREAMCHARWIDTH 148475 . 152639) (\COERCECHARSET 152641 . 155236) (\BUILDSLUGCSINFO 155238 . 158861) -(\FONTSYMBOL 158863 . 159513) (\DEVICESYMBOL 159515 . 160384) (\FONTFACE 160386 . 167576) ( -\FONTFACE.COLOR 167578 . 174498) (SETFONTCHARENCODING 174500 . 175713)) (175716 196655 (FONTSAVAILABLE - 175726 . 180969) (FONTEXISTS? 180971 . 184949) (\SEARCHFONTFILES 184951 . 188036) (FLUSHFONTSINCORE -188038 . 191211) (FINDFONTFILES 191213 . 194427) (SORTFONTSPECS 194429 . 196653)) (196656 200079 ( -MATCHFONTFACE 196666 . 197481) (MAKEFONTFACE 197483 . 198323) (FONTFACETOATOM 198325 . 200077)) ( -200349 200841 (\UNITWIDTHSVECTOR 200359 . 200839)) (215435 217502 (FONTDESCRIPTOR.DEFPRINT 215445 . -217024) (FONTCLASS.DEFPRINT 217026 . 217500)) (221331 224121 (\CREATEKERNELEMENT 221341 . 221699) ( -\FSETLEFTKERN 221701 . 222192) (\FGETLEFTKERN 222194 . 224119)) (224122 233758 (\CREATEFONT 224132 . -225571) (\CREATECHARSET 225573 . 229509) (\INSTALLCHARSETINFO 229511 . 232845) ( -\INSTALLCHARSETINFO.CHARENCODING 232847 . 233756)) (234080 235444 (\FONTRESETCHARWIDTHS 234090 . -235442)) (236074 246121 (\CREATEDISPLAYFONT 236084 . 237933) (\CREATECHARSET.DISPLAY 237935 . 243644) -(\FONTEXISTS?.DISPLAY 243646 . 246119)) (246122 260987 (STRIKEFONT.FILEP 246132 . 247020) ( -STRIKEFONT.GETCHARSET 247022 . 252614) (WRITESTRIKEFONTFILE 252616 . 257527) (STRIKECSINFO 257529 . -260985)) (261018 277335 (MAKEBOLD.CHARSET 261028 . 264677) (MAKEBOLD.CHAR 264679 . 266431) ( -MAKEITALIC.CHARSET 266433 . 270106) (MAKEITALIC.CHAR 270108 . 272454) (\SFMAKEBOLD 272456 . 274680) ( -\SFMAKEITALIC 274682 . 277333)) (277336 281485 (\SFMAKEROTATEDFONT 277346 . 278747) (\SFROTATECSINFO -278749 . 279386) (\SFROTATEFONTCHARACTERS 279388 . 279768) (\SFROTATECSINFOOFFSETS 279770 . 281483)) ( -281486 282867 (\SFMAKECOLOR 281496 . 282865))))) + (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 51df1d80..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