diff --git a/docs/internal/FONTCODECHANGES.tedit b/docs/internal/FONTCODECHANGES.tedit index c92e4098f..8bcbf2644 100644 Binary files a/docs/internal/FONTCODECHANGES.tedit and b/docs/internal/FONTCODECHANGES.tedit differ diff --git a/library/UNIXUTILS b/library/UNIXUTILS index 59253a493..9f9491d99 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 514dfbb9e..96e1669b9 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 4a42bd000..c1d5b75e5 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 df4999b64..42ddb9598 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 6e40fa42a..fb086c1fa 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)) + + (* ;; "APPEND the cache value because of the SORT") + + (APPEND (if (NULL FILEFONTS) + then (LET [(FN (OR (CAR (GETMULTI IMAGESTREAMTYPES DEVICE + 'FONTSAVAILABLE)) + (FUNCTION \SEARCHFONTFILES] - (* ;; "Until all the device functions take a FONTSPEC") + (* ;; "Until all the device functions take a FONTSPEC") - (CL:IF (EQ 1 (NARGS FN)) - (APPLY* FN FONTSPEC) - (APPLY* FN FAMILY SIZE FACE ROTATION DEVICE))))]) + (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 98ce344aa..767c19f91 100644 Binary files a/sources/FONT.LCOM and b/sources/FONT.LCOM differ diff --git a/sources/MEDLEYDIR b/sources/MEDLEYDIR index 124a06c67..ef3631335 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 c6e924a0a..8ad061fbf 100644 Binary files a/sources/MEDLEYDIR.LCOM and b/sources/MEDLEYDIR.LCOM differ