diff --git a/library/IMPORTFONTS b/library/IMPORTFONTS index 5c960d3e..153a7346 100644 --- a/library/IMPORTFONTS +++ b/library/IMPORTFONTS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) -(FILECREATED " 5-Apr-2026 14:27:30" {WMEDLEY}IMPORTFONTS.;94 59200 +(FILECREATED "16-Apr-2026 22:39:37" {WMEDLEY}IMPORTFONTS.;98 60135 :EDIT-BY rmk - :CHANGES-TO (FNS IMPORTFONTS IMPORTFONTS.DIRECTORY FAKEFACE) + :CHANGES-TO (FNS LEGACYDISPLAYFONT) - :PREVIOUS-DATE " 5-Apr-2026 11:51:28" {WMEDLEY}IMPORTFONTS.;92) + :PREVIOUS-DATE "15-Apr-2026 22:10:41" {WMEDLEY}IMPORTFONTS.;97) (PRETTYCOMPRINT IMPORTFONTSCOMS) @@ -29,6 +29,7 @@ (IMPORTFONTS [LAMBDA (PHASE FONTSPECS DEVICE FROMDIRECTORY TODIRECTORY IMPORTFN NODRIBBLE) + (* ; "Edited 11-Apr-2026 10:55 by rmk") (* ; "Edited 5-Apr-2026 14:22 by rmk") (* ; "Edited 3-Apr-2026 08:15 by rmk") (* ; "Edited 1-Apr-2026 08:25 by rmk") @@ -61,7 +62,8 @@ (IMPORTFONTS.CONTEXT PHASE FROMDIRECTORY TODIRECTORY DEVICE)) (IMPORTFONTS.CLEAR PHASE FONTSPECS TODIRECTORY DEVICE) (SETQ FONTSPECS (IMPORTFONTS.FONTSPECS PHASE FONTSPECS FROMDIRECTORY DEVICE)) - (CL:WHEN (AND (CDR FONTSPECS) + (CL:WHEN (AND (IGEQ (LENGTH FONTSPECS) + 5) (NOT NODRIBBLE)) (* ;  "Put all the dribbles together one up") [DRIBBLE (PSEUDOFILENAME (PACKFILENAME 'BODY @@ -195,7 +197,8 @@ 'REGION]))]) (FONT.TO.MCCS - [LAMBDA (FONT) (* ; "Edited 10-Mar-2026 00:23 by rmk") + [LAMBDA (FONT) (* ; "Edited 11-Apr-2026 15:43 by rmk") + (* ; "Edited 10-Mar-2026 00:23 by rmk") (* ; "Edited 7-Mar-2026 12:55 by rmk") (* ; "Edited 1-Mar-2026 13:43 by rmk") (* ; "Edited 7-Oct-2025 17:13 by rmk") @@ -212,20 +215,20 @@ (LET [(PAIRS (MCCSMAPPAIRS (FONTPROP FONT 'CHARENCODING] (CL:WHEN PAIRS (MOVEFONTCHARS PAIRS FONT FONT) + (replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with NIL) (* ;; "Keep the map function even for coerced MCCS fonts--can still be used for code conversion (e.g. Tedit file updating) ") [replace (FONTDESCRIPTOR FONTTOMCCSFN) of FONT with (MCCSMAPFN (FONTPROP FONT 'CHARENCODING] - (replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with NIL) (CL:WHEN (MEMB (FONTPROP FONT 'CHARENCODING) - '(GACHA XCCS$ ALTOTEXT PALATINO UNICODE)) + '(GACHA XCCS$ ALTOTEXT PALATINO UNICODE HIPPO CYRILLIC)) (replace (FONTDESCRIPTOR FONTCHARENCODING) of FONT with 'MCCS) (* ; "These fonts made it all the way") (CHARSETPROP (\GETCHARSETINFO FONT 0) 'CSCHARENCODING 'MCCS)) - T)]) + FONT)]) (IMPORTFONTS.FONTSPECS [LAMBDA (PHASE FONTSPECS FROMDIRECTORY DEVICE) (* ; "Edited 4-Apr-2026 11:41 by rmk") @@ -678,7 +681,9 @@ (IMPORTFONTS 'IMPORT FONTSPECS 'DISPLAY NIL NIL (FUNCTION LEGACYDISPLAYFONT]) (LEGACYDISPLAYFONT - [LAMBDA (FONTSPEC FROMDIRECTORY) (* ; "Edited 31-Mar-2026 15:01 by rmk") + [LAMBDA (FONTSPEC FROMDIRECTORY) (* ; "Edited 16-Apr-2026 22:37 by rmk") + (* ; "Edited 12-Apr-2026 13:22 by rmk") + (* ; "Edited 31-Mar-2026 15:01 by rmk") (* ; "Edited 28-Mar-2026 09:27 by rmk") (* ;; "Loads legacy display fonts (ac or strike format, gacha, terminal, helevetica...) from FROMDIRECTORY. If NIL, the current directory") @@ -691,9 +696,9 @@ FROMDIRECTORY) `(PROGN (FONTDEVICEPROP 'DISPLAY 'FONTEXTENSIONS OLDVALUE] (for CSNO CSINFO (FONT ← (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC 255)) from 0 to 255 - do [SETQ CSINFO (\READCHARSET FONTSPEC CSNO FONT '((AC ACFONT.FILEP ACFONT.GETCHARSET) - (STRIKE STRIKEFONT.FILEP - STRIKEFONT.GETCHARSET] + do (SETQ CSINFO (\READCHARSET FONT CSNO '((AC ACFONT.FILEP ACFONT.GETCHARSET) + (STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET)) + FROMDIRECTORY)) (* ;; "NIL means empty") @@ -746,22 +751,28 @@ (DEFINEQ (PEF - [LAMBDA (PHASE FONTSPEC CHARSET DIRECTORY) (* ; "Edited 30-Mar-2026 09:14 by rmk") + [LAMBDA (PHASE FONTSPEC CHARSET DIRECTORY) (* ; "Edited 12-Apr-2026 19:32 by rmk") + (* ; "Edited 30-Mar-2026 09:14 by rmk") (* ; "Edited 25-Mar-2026 00:11 by rmk") (* ; "Edited 22-Mar-2026 00:19 by rmk") (* ; "Edited 16-Mar-2026 08:43 by rmk") (* ; "Edited 13-Mar-2026 10:33 by rmk") - (CL:UNLESS CHARSET (SETQ CHARSET 0)) (if (type? FONTSPEC FONTSPEC) then (SETQ FONTSPEC (\FONT.CHECKARGS FONTSPEC NIL NIL NIL NIL T)) else (SETQ FONTSPEC (FONTSPECFROMFILENAME FONTSPEC))) (LET* ((DIR (IMPORTFONTS.DIRECTORY FONTSPEC DIRECTORY (IMPORTFONTS.SUBDIR PHASE))) (FONTFILE (MEDLEYFONT.FILENAME FONTSPEC DIR)) TITLETAG CHARSETNAME) - (if (NLSETQ (MEDLEYFONT.FILEP FONTFILE)) - then (SETQ CHARSET (OR (CHARSET.DECODE CHARSET) - 0)) - (SETQ TITLETAG (CL:IF (EQ PHASE 'MCCS) + (SETQ CHARSET (if (EQ CHARSET T) + then (for C in (MEDLEYFONT.GETFILEPROP FONTFILE 'CHARSETS) + unless (OR (KANJICHARSETP C) + (CHINESECHARSETP C)) collect C) + elseif (CHARSET.DECODE CHARSET) + else 0)) + (if (LISTP CHARSET) + then (for C in CHARSET do (PEF PHASE FONTSPEC C DIRECTORY T)) + elseif (NLSETQ (MEDLEYFONT.FILEP FONTFILE)) + then (SETQ TITLETAG (CL:IF (EQ PHASE 'MCCS) 'MCCS (L-CASE PHASE T))) (SETQ CHARSETNAME (CHARSET.ENCODE CHARSET)) @@ -892,15 +903,15 @@ (FILESLOAD EDITFONT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1215 32446 (IMPORTFONTS 1225 . 12900) (FONT.TO.MCCS 12902 . 15025) ( -IMPORTFONTS.FONTSPECS 15027 . 22493) (IMPORTFONTS.CONTEXT 22495 . 26086) (IMPORTFONTS.NOCACHE 26088 . -26339) (IMPORTFONTS.DIRECTORY 26341 . 28506) (IMPORTFONTS.CLEAR 28508 . 31075) (IMPORTFONTS.SUBDIR -31077 . 31825) (IMPORTFONTS.DIRSIZE 31827 . 32444)) (32447 35871 (IMPORTFONTS.AVAILABLE 32457 . 33072) - (IMPORTFONTS.EXISTS? 33074 . 33680) (IMPORTFONTS.DEPLOY 33682 . 35869)) (35872 42467 (FAKEFACE 35882 - . 39619) (FAKEFACE.FROMFILE 39621 . 41777) (FAKEFACE.FROMFONT 41779 . 42465)) (42468 45798 ( -IMPORTFONTS.PHASES 42478 . 43219) (MISSINGFACE 43221 . 45796)) (45842 47607 (IMPORT.DISPLAY 45852 . -46175) (LEGACYDISPLAYFONT 46177 . 47605)) (47656 49870 (IPF 47666 . 48433) (IPFSIZES 48435 . 49868)) ( -49871 55607 (PEF 49881 . 51945) (AEF 51947 . 52691) (IEF 52693 . 53296) (MEF 53298 . 53899) (CEF 53901 - . 54506) (FEF 54508 . 55327) (EFCLOSE 55329 . 55605)) (55608 59155 (SHOWCHARS 55618 . 57648) ( -CSSOURCE 57650 . 58363) (FONTDEFFONTS 58365 . 59153))))) + (FILEMAP (NIL (1190 32701 (IMPORTFONTS 1200 . 13028) (FONT.TO.MCCS 13030 . 15280) ( +IMPORTFONTS.FONTSPECS 15282 . 22748) (IMPORTFONTS.CONTEXT 22750 . 26341) (IMPORTFONTS.NOCACHE 26343 . +26594) (IMPORTFONTS.DIRECTORY 26596 . 28761) (IMPORTFONTS.CLEAR 28763 . 31330) (IMPORTFONTS.SUBDIR +31332 . 32080) (IMPORTFONTS.DIRSIZE 32082 . 32699)) (32702 36126 (IMPORTFONTS.AVAILABLE 32712 . 33327) + (IMPORTFONTS.EXISTS? 33329 . 33935) (IMPORTFONTS.DEPLOY 33937 . 36124)) (36127 42722 (FAKEFACE 36137 + . 39874) (FAKEFACE.FROMFILE 39876 . 42032) (FAKEFACE.FROMFONT 42034 . 42720)) (42723 46053 ( +IMPORTFONTS.PHASES 42733 . 43474) (MISSINGFACE 43476 . 46051)) (46097 48043 (IMPORT.DISPLAY 46107 . +46430) (LEGACYDISPLAYFONT 46432 . 48041)) (48092 50306 (IPF 48102 . 48869) (IPFSIZES 48871 . 50304)) ( +50307 56542 (PEF 50317 . 52880) (AEF 52882 . 53626) (IEF 53628 . 54231) (MEF 54233 . 54834) (CEF 54836 + . 55441) (FEF 55443 . 56262) (EFCLOSE 56264 . 56540)) (56543 60090 (SHOWCHARS 56553 . 58583) ( +CSSOURCE 58585 . 59298) (FONTDEFFONTS 59300 . 60088))))) STOP diff --git a/library/IMPORTFONTS.LCOM b/library/IMPORTFONTS.LCOM index cbbabb6a..46192322 100644 Binary files a/library/IMPORTFONTS.LCOM and b/library/IMPORTFONTS.LCOM differ diff --git a/sources/FONT b/sources/FONT index 0ed9facd..ac0a9d55 100644 --- a/sources/FONT +++ b/sources/FONT @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) -(FILECREATED "11-Apr-2026 10:11:29" {WMEDLEY}FONT.;780 256466 +(FILECREATED "17-Apr-2026 08:42:29" {MEDLEY}FONT.;788 259513 :EDIT-BY rmk - :CHANGES-TO (FNS \CREATEDISPLAYFONT) + :CHANGES-TO (FNS FAKEFACE.CHARSET \READCHARSET FONTFILES) + (OPTIMIZERS FONTPROP) - :PREVIOUS-DATE " 5-Apr-2026 11:55:11" {WMEDLEY}FONT.;779) + :PREVIOUS-DATE "15-Apr-2026 22:12:03" {WMEDLEY}FONT.;785) (PRETTYCOMPRINT FONTCOMS) @@ -619,7 +620,9 @@ (CLOSEF? STRM))))]) (\READCHARSET - [LAMBDA (FONTSPEC CHARSET FONT CHARSETFNS) (* ; "Edited 2-Apr-2026 15:52 by rmk") + [LAMBDA (FONT CHARSET CHARSETFNS) (* ; "Edited 16-Apr-2026 22:38 by rmk") + (* ; "Edited 12-Apr-2026 12:59 by rmk") + (* ; "Edited 2-Apr-2026 15:52 by rmk") (* ; "Edited 28-Mar-2026 07:51 by rmk") (* ; "Edited 17-Mar-2026 08:57 by rmk") (* ; "Edited 12-Mar-2026 13:39 by rmk") @@ -639,13 +642,13 @@ (* ;; "This finds the first file in the directories/extensions order that contains information about charset, determines its format, and reads it in. The assumption is that the first such existing file is the one we want. ") - (CL:WHEN (AND FONTSPEC (EQ 0 (fetch (FONTSPEC FSROTATION) of FONTSPEC))) + (CL:WHEN (EQ 0 (FONTPROP FONT 'ROTATION)) (RESETLST - (for FILE STRM CSINFO in (FONTFILES FONTSPEC CHARSET) + (for FILE STRM CSINFO in (FONTFILES FONT CHARSET) do (* ;; "We know that FILE exists and is the best source of information about charset--maybe none. We assume FILE is one of the valid formats, we open it separately for each format-type, and ensure it is closed on exit. We can't used CL:WITHOPEN-FILE because that doesn't exist in the loadup when the first font is created.") - (for FNS in [OR CHARSETFNS (FONTDEVICEPROP FONTSPEC 'CHARSETFNS) + (for FNS in [OR CHARSETFNS (FONTDEVICEPROP FONT 'CHARSETFNS) '((MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET] do [RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT)) `(PROGN (CLOSEF? OLDVALUE] @@ -662,11 +665,12 @@ (* ;; "The file didn't know its own encoding") (CHARSETPROP CSINFO 'CSCHARENCODING - (APPLY* (OR (FONTDEVICEPROP FONTSPEC 'ENCODINGFN) + (APPLY* (OR (FONTDEVICEPROP FONT 'ENCODINGFN) (FUNCTION NILL)) FONTSPEC))) (CL:UNLESS (CHARSETPROP CSINFO 'SOURCE) - (CHARSETPROP CSINFO 'SOURCE (create FONTSPEC using FONTSPEC))) + [CHARSETPROP CSINFO 'SOURCE (create FONTSPEC + using (FONTPROP FONT 'DEVICESPEC]) (replace (CHARSETINFO CHARSETNO) of CSINFO with CHARSET) (RETURN))) @@ -932,7 +936,8 @@ (DEFINEQ (MAKEFONTSPEC - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE BASE) (* ; "Edited 7-Nov-2025 07:52 by rmk") + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE BASE) (* ; "Edited 15-Apr-2026 00:25 by rmk") + (* ; "Edited 7-Nov-2025 07:52 by rmk") (* ; "Edited 28-Aug-2025 14:32 by rmk") (* ; "Edited 17-Aug-2025 20:44 by rmk") @@ -940,12 +945,13 @@ (* ;; "BASE (fontspec or font) provides defaults for NIL arguments, essentialy models a (create using BASE...)") - (CL:WHEN (FONTP BASE) - (SETQ BASE (FONTPROP BASE 'SPEC))) + (CL:WHEN FACE + (SETQ FACE (\FONTFACE FACE))) (create FONTSPEC FSFAMILY ← (OR FAMILY (fetch (FONTSPEC FSFAMILY) of BASE)) FSSIZE ← (OR SIZE (fetch (FONTSPEC FSSIZE) of BASE)) - FSFACE ← (OR FACE (fetch (FONTSPEC FSFACE) of BASE)) + FSFACE ← (OR (AND FACE (\FONTFACE FACE)) + (fetch (FONTSPEC FSFACE) of BASE)) FSROTATION ← (OR ROTATION (fetch (FONTSPEC FSROTATION) of BASE)) FSDEVICE ← (OR DEVICE (fetch (FONTSPEC FSDEVICE) of BASE]) @@ -1136,7 +1142,8 @@ (fetch (FONTDESCRIPTOR \SFHeight) of (FONTCREATE FONTSPEC]) (FONTPROP - [LAMBDA (FONT PROP) (* ; "Edited 28-Mar-2026 07:51 by rmk") + [LAMBDA (FONT PROP) (* ; "Edited 12-Apr-2026 12:52 by rmk") + (* ; "Edited 28-Mar-2026 07:51 by rmk") (* ; "Edited 18-Mar-2026 23:11 by rmk") (* ; "Edited 25-Jan-2026 20:08 by rmk") (* ; "Edited 2-Dec-2025 16:01 by rmk") @@ -1167,6 +1174,8 @@ (BACKCOLOR (ffetch BACKCOLOR of (ffetch FONTFACE of FONT))) (ROTATION (ffetch ROTATION of FONT)) (DEVICE (ffetch FONTDEVICE of FONT)) + (FILENAME (CL:WHEN (ffetch FONTFILENAME of FONT) + (INFILEP (ffetch FONTFILENAME of FONT)))) (CHARENCODING [OR (ffetch FONTCHARENCODING of FONT) (freplace FONTCHARENCODING of FONT with (if (MEMB (fetch (FONTDESCRIPTOR FONTFAMILY) of FONT) @@ -1258,6 +1267,7 @@ (FONTTOMCCSFN `(fetch (FONTDESCRIPTOR FONTTOMCCSFN) of ,(CAR ARGS))) (MAXCHARSET `(MAXCHARSET ,(CAR ARGS))) + (FILENAME `(fetch (FONTDESCRIPTOR FONTFILENAME) of ,(CAR ARGS))) 'IGNOREMACRO)) (* "END EXPORTED DEFINITIONS") @@ -1860,7 +1870,8 @@ (DEFINEQ (FONTFILES - [LAMBDA (FONTSPEC CHARSET DIRLST EXTLST) (* ; "Edited 28-Aug-2025 14:42 by rmk") + [LAMBDA (FONTSPEC CHARSET DIRLST EXTLST) (* ; "Edited 16-Apr-2026 22:26 by rmk") + (* ; "Edited 28-Aug-2025 14:42 by rmk") (* ; "Edited 25-Aug-2025 10:22 by rmk") (* ; "Edited 16-Aug-2025 21:03 by rmk") (* ; "Edited 11-Jul-2025 09:42 by rmk") @@ -1871,15 +1882,27 @@ (* ; "Edited 17-May-2025 00:06 by rmk") (* ; "Edited 15-May-2025 16:29 by rmk") - (* ;; "Considers all posible names for font files that respect the given characteristics, returns a list of the names of files that actually exist somewhere in DIRLST. Does not validate their contents.") + (* ;; "Considers all posible names for font files that respect the given characteristics, returns a list of the names of files that actually exist somewhere in DIRLST. If FONTSPEC is a FONT with a FILENAME that exists, that is the only one returned. Does not validate their contents.") - (LET (FAMILY SIZE FACE ROTATION DEVICE) - (SPREADFONTSPEC FONTSPEC) - [SETQ DIRLST (MKLIST (OR DIRLST (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES] - [SETQ EXTLST (MKLIST (OR EXTLST (FONTDEVICEPROP DEVICE 'FONTEXTENSIONS] - (CL:UNLESS CHARSET (SETQ CHARSET \DEFAULTCHARSET)) - (APPEND (MKLIST (\FINDFONTFILE FAMILY SIZE FACE ROTATION DEVICE 'NOCHARSET DIRLST EXTLST)) - (MKLIST (\FINDFONTFILE FAMILY SIZE FACE ROTATION DEVICE CHARSET DIRLST EXTLST]) + (if (type? FONTDESCRIPTOR FONTSPEC) + then + (* ;; "Prefer the same version, but maybe a different version if coming up in a new environment? Or always the latest version?") + + (OR [MKLIST (INFILEP (FONTPROP FONTSPEC 'FILENAME] + [AND (FONTPROP FONTSPEC 'FILENAME) + (MKLIST (INFILEP (PACKFILENAME 'VERSION NIL 'BODY (FONTPROP FONTSPEC + 'FILENAME] + (FONTFILES (FONTPROP FONTSPEC 'DEVICESPEC) + CHARSET DIRLST EXTLST)) + else (LET (FAMILY SIZE FACE ROTATION DEVICE) + (SETQ FONTSPEC (\FONT.CHECKARGS FONTSPEC NIL NIL NIL NIL T)) + (SPREADFONTSPEC FONTSPEC) + [SETQ DIRLST (MKLIST (OR DIRLST (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES] + [SETQ EXTLST (MKLIST (OR EXTLST (FONTDEVICEPROP DEVICE 'FONTEXTENSIONS] + (CL:UNLESS CHARSET (SETQ CHARSET \DEFAULTCHARSET)) + (APPEND (MKLIST (\FINDFONTFILE FAMILY SIZE FACE ROTATION DEVICE 'NOCHARSET DIRLST + EXTLST)) + (MKLIST (\FINDFONTFILE FAMILY SIZE FACE ROTATION DEVICE CHARSET DIRLST EXTLST]) (\FINDFONTFILE [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET DIRLST EXTLST) @@ -1918,7 +1941,8 @@ (for EXT inside EXTENSIONS collect (\FONTFILENAME FAMILY SIZE FACE EXT 0]) (\FONTFILENAME - [LAMBDA (FAMILY SIZE FACE EXTENSION CHARSET) (* ; "Edited 22-Jan-2026 14:25 by rmk") + [LAMBDA (FAMILY SIZE FACE EXTENSION CHARSET) (* ; "Edited 15-Apr-2026 00:44 by rmk") + (* ; "Edited 22-Jan-2026 14:25 by rmk") (* ; "Edited 11-Jul-2025 09:39 by rmk") (* ; "Edited 15-May-2025 15:51 by rmk") (* ; "Edited 5-Mar-93 16:10 by rmk:") @@ -1947,14 +1971,15 @@ (* ;; "Fortunately, PACKFILENAME ignores packages") - (SETQ FILENAME (PACKFILENAME.STRING 'NAME (CONCAT (CL:IF CSETNAME + [SETQ FILENAME (PACKFILENAME.STRING 'NAME (CONCAT (CL:IF CSETNAME (CONCAT "c" CSETNAME ">") "") FAMILY SIZEPATT "-" (FONTFACETOATOM FACE) (CL:IF CSETNAME (CONCAT "-C" CSETNAME) "")) - 'EXTENSION EXTENSION)) + 'EXTENSION + (OR EXTENSION (CAR (MKLIST (FONTDEVICEPROP DEVICE 'FONTEXTENSIONS] (* ;;  " Avoid adjacent wildcards because some devices (notably old DSK) get exponentially slower.") @@ -2802,13 +2827,15 @@ do (push FONTSFOUND THISFONT))) finally (RETURN (DREVERSE FONTSFOUND]) (FLUSHFONTCACHE - [LAMBDA (CACHES FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 4-Apr-2026 23:04 by rmk") + [LAMBDA (CACHES FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 15-Apr-2026 22:11 by rmk") + (* ; "Edited 12-Apr-2026 11:54 by rmk") + (* ; "Edited 4-Apr-2026 23:04 by rmk") (* ; "Edited 27-Nov-2025 10:02 by rmk") (* ; "Edited 22-Nov-2025 15:52 by rmk") (* ;; "Removes information for font(s) from the caches in CACHES, if CACHES is NIL, all caches are flushed") - (for CACHE NFLUSHED inside (OR CACHES '(:INCORE :EXISTS :AVAILABLE)) declare (SPEVARS NFLUSHED) + (for CACHE NFLUSHED inside (OR CACHES '(:INCORE :EXISTS :AVAILABLE)) declare (SPECVARS NFLUSHED) first (CL:WHEN (type? FONTSPEC FAMILY) (SPREADFONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE T))) (CL:UNLESS FAMILY @@ -2827,6 +2854,7 @@ (:AVAILABLE \FONTSAVAILABLEFILECACHE) (\ILLEGAL.ARG CACHE)) (FUNCTION (LAMBDA (FM S FC R DPAIR) + (DECLARE (USEDFREE NFLUSHED)) (CL:WHEN (AND (OR (EQ FAMILY FM) (EQ FAMILY '*)) (OR (EQ SIZE S) @@ -3089,7 +3117,7 @@ (NIL SIGNEDWORD) (* ; "Was FBBDX") (NIL SIGNEDWORD) (* ; "Was FBBDY") (FONTTOMCCSFN POINTER) (* ; "Was \SFLKerns. Function that translates codes in the font's pre-MCCS encoding into MCCS (e.g. Hippo A to Greek,Alpha) ") - (NIL POINTER) (* ; "Was \SFRWidths") + (FONTFILENAME POINTER) (* ; "For a font read from a Medleyfont file, the name of that file. For access to future properties and to instantiate future charsets.") (FONTDEVICESPEC POINTER) (* ;  "Holds the spec by which the font is known to the printing device, if coercion has been done") (OTHERDEVICEFONTPROPS POINTER) (* ; @@ -3477,7 +3505,7 @@ (NIL SIGNEDWORD) (NIL SIGNEDWORD) (FONTTOMCCSFN POINTER) - (NIL POINTER) + (FONTFILENAME POINTER) (FONTDEVICESPEC POINTER) (OTHERDEVICEFONTPROPS POINTER) (FONTSCALE POINTER) @@ -3541,7 +3569,8 @@ (DEFINEQ (\CREATEFONT - [LAMBDA (FONTSPEC) (* ; "Edited 4-Apr-2026 23:29 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 15-Apr-2026 00:13 by rmk") + (* ; "Edited 4-Apr-2026 23:29 by rmk") (* ; "Edited 2-Apr-2026 23:01 by rmk") (* ; "Edited 31-Mar-2026 22:55 by rmk") (* ; "Edited 18-Mar-2026 22:44 by rmk") @@ -3562,7 +3591,8 @@ 'FONTCREATE] (if FN then (APPLY* FN FONTSPEC) - elseif (MEDLEYFONT.READ.FONT FONTSPEC NIL T) + elseif (MEDLEYFONT.READ.FONT (CAR (FONTFILES FONTSPEC)) + NIL T) else (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC)) elseif [SETQ COERCIONSPEC (CAR (COERCEFONTSPEC FONTSPEC 'FONTCOERCIONS] then @@ -3584,7 +3614,8 @@ then (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC (MAXCHARSET (\CREATEFONT COERCIONSPEC]) (\CREATECHARSET - [LAMBDA (CHARSET FONT GETCHARSETFN) (* ; "Edited 4-Apr-2026 14:39 by rmk") + [LAMBDA (CHARSET FONT GETCHARSETFN) (* ; "Edited 12-Apr-2026 18:47 by rmk") + (* ; "Edited 4-Apr-2026 14:39 by rmk") (* ; "Edited 31-Mar-2026 17:44 by rmk") (* ; "Edited 29-Mar-2026 10:33 by rmk") (* ; "Edited 27-Mar-2026 07:52 by rmk") @@ -3605,16 +3636,16 @@ (* ;; "Creates and returns the CHARSETINFO for charset CHARSET in fontdesc FONT, installing it in FONT's FONTCHARSETVECTOR") (OR (\GETCHARSETINFO FONT CHARSET) - (LET ((FONTSPEC (FONTPROP FONT 'DEVICESPEC)) - CSINFO) (* ; + (LET (CSINFO) (* ;  "Use DEVICESPEC in case it was coerced") (SETQ CSINFO (if [OR GETCHARSETFN (SETQ GETCHARSETFN (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTDESCRIPTOR FONTDEVICE) of FONT) 'CREATECHARSET] - then (APPLY* GETCHARSETFN FONTSPEC FONT CHARSET) - else (\READCHARSET FONTSPEC CHARSET FONT))) + then (APPLY* GETCHARSETFN (FONTPROP FONT 'DEVICESPEC) + FONT CHARSET) + else (\READCHARSET FONT CHARSET))) (CL:WHEN CSINFO (* ;  "CSINFO could be a slug, an instantiated charset, or NIL meaning uninstantiated") (\INSTALLCHARSETINFO FONT CSINFO CHARSET))]) @@ -3732,7 +3763,8 @@ (DEFINEQ (\CREATEDISPLAYFONT - [LAMBDA (FONTSPEC) (* ; "Edited 11-Apr-2026 10:10 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 15-Apr-2026 00:20 by rmk") + (* ; "Edited 11-Apr-2026 10:10 by rmk") (* ; "Edited 29-Mar-2026 10:23 by rmk") (* ; "Edited 16-Mar-2026 12:39 by rmk") (* ; "Edited 28-Aug-2025 16:00 by rmk") @@ -3750,10 +3782,12 @@ (* ;; "FONTEXISTS? has determined that there is at least one source file for this font, so the font exists in at least some character sets.") - (MEDLEYFONT.READ.FONT FONTSPEC NIL T]) + (MEDLEYFONT.READ.FONT (CAR (FONTFILES FONTSPEC)) + NIL T]) (\CREATECHARSET.DISPLAY - [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 5-Apr-2026 10:02 by rmk") + [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 12-Apr-2026 18:52 by rmk") + (* ; "Edited 5-Apr-2026 10:02 by rmk") (* ; "Edited 1-Apr-2026 10:32 by rmk") (* ; "Edited 29-Mar-2026 10:30 by rmk") (* ; "Edited 17-Mar-2026 16:11 by rmk") @@ -3771,7 +3805,7 @@ (* ;; "") - (if (\READCHARSET FONTSPEC CHARSET FONT) + (if (\READCHARSET FONT CHARSET) else (* ;; "Successful transformations must set the CSINFO so that it can be returned.") @@ -3827,7 +3861,8 @@ (DEFINEQ (FAKEFACE.CHARSET - [LAMBDA (FONT CHARSET FAKEFN SOURCEFONT) (* ; "Edited 5-Apr-2026 00:25 by rmk") + [LAMBDA (FONT CHARSET FAKEFN SOURCEFONT) (* ; "Edited 17-Apr-2026 08:42 by rmk") + (* ; "Edited 5-Apr-2026 00:25 by rmk") (* ; "Edited 1-Apr-2026 09:10 by rmk") (* ; "Edited 31-Mar-2026 00:39 by rmk") (* ; "Edited 24-Mar-2026 10:26 by rmk") @@ -3850,7 +3885,7 @@ (CL:WHEN (AND (SETQ SCSINFO (\GETCHARSETINFO SOURCEFONT CHARSET)) (NOT (fetch (CHARSETINFO CSSLUGP) of SCSINFO))) (if (OR (KANJICHARSETP CHARSET) - (CHINESECHARSETP CHARSET)) + (UNIHANCHARSETP CHARSET)) then (SETQ FCSINFO (COPYALL SCSINFO)) (* ; "Copy and set up an indirect") (CHARSETPROP FCSINFO 'SOURCE (FONTPROP SOURCEFONT 'DEVICESPEC)) (\INSTALLCHARSETINFO FONT FCSINFO CHARSET) @@ -4075,41 +4110,41 @@ (ADDTOVAR LAMA FONTCOPY FONTDEVICEPROP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6426 16093 (CHARWIDTH 6436 . 7225) (CHARWIDTHY 7227 . 8744) (STRINGWIDTH 8746 . 9783) ( -\CHARWIDTH.DISPLAY 9785 . 10200) (\STRINGWIDTH.DISPLAY 10202 . 10630) (\STRINGWIDTH.GENERIC 10632 . -16091)) (16094 22726 (DEFAULTFONT 16104 . 17389) (FONTCLASS 17391 . 19663) (FONTCLASSUNPARSE 19665 . -20566) (FONTCLASSCOMPONENT 20568 . 21156) (SETFONTCLASSCOMPONENT 21158 . 21600) (GETFONTCLASSCOMPONENT - 21602 . 22724)) (24174 43430 (FONTCREATE 24184 . 27429) (FONTCREATE1 27431 . 30090) ( -FONTCREATE.SLUGFD 30092 . 32656) (\FONT.CHECKARGS1 32658 . 37363) (\FONTCREATE1.NOFN 37365 . 37579) ( -FONTFILEP 37581 . 38469) (\READCHARSET 38471 . 43010) (FONTCHARSETS 43012 . 43428)) (43431 50507 ( -\FONT.CHECKARGS 43441 . 50190) (\CHARSET.CHECK 50192 . 50505)) (50508 56868 (COERCEFONTSPEC 50518 . -56179) (COERCEFONTSPEC.TARGETFACE 56181 . 56866)) (59063 62042 (MAKEFONTSPEC 59073 . 60410) ( -FONTSPEC.TO.FONTDESCRIPTOR 60412 . 62040)) (62043 71705 (COMPLETE.FONT 62053 . 64078) (COMPLETEFONTP -64080 . 64818) (COMPLETE.CHARSET 64820 . 68886) (PRUNESLUGCSINFOS 68888 . 70199) (MONOSPACEFONTP 70201 - . 71703)) (71744 81312 (FONTASCENT 71754 . 72138) (FONTDESCENT 72140 . 72625) (FONTHEIGHT 72627 . -73029) (FONTPROP 73031 . 80589) (\AVGCHARWIDTH 80591 . 81310)) (82035 83905 (FONTDEVICEPROP 82045 . -83903)) (84022 84876 (EDITCHAR 84032 . 84874)) (84922 97112 (GETCHARBITMAP 84932 . 86056) ( -PUTCHARBITMAP 86058 . 88216) (\GETCHARBITMAP.CSINFO 88218 . 90234) (\PUTCHARBITMAP.CSINFO 90236 . -97110)) (97113 119454 (MOVECHARBITMAP 97123 . 99017) (MOVEFONTCHARS 99019 . 104169) (\MOVEFONTCHAR -104171 . 109043) (\MOVEFONTCHARS.SOURCEDATA 109045 . 115800) (\MAKESLUGCHAR 115802 . 118337) ( -SLUGCHARP 118339 . 119452)) (120369 132218 (FONTFILES 120379 . 122212) (\FINDFONTFILE 122214 . 124191) - (\FONTFILENAMES 124193 . 124753) (\FONTFILENAME 124755 . 127666) (FONTSPECFROMFILENAME 127668 . -132216)) (132219 168552 (FONTCOPY 132229 . 137312) (FONTP 137314 . 137613) (FONTUNPARSE 137615 . -139338) (SETFONTDESCRIPTOR 139340 . 140804) (\STREAMCHARWIDTH 140806 . 144817) (\COERCECHARSET 144819 - . 148208) (\BUILDSLUGCSINFO 148210 . 151903) (\FONTSYMBOL 151905 . 152559) (\DEVICESYMBOL 152561 . -153345) (\FONTFACE 153347 . 160551) (\FONTFACE.COLOR 160553 . 167335) (SETFONTCHARENCODING 167337 . -168550)) (168553 189124 (FONTSAVAILABLE 168563 . 173927) (FONTEXISTS? 173929 . 177737) ( -\SEARCHFONTFILES 177739 . 180953) (FLUSHFONTCACHE 180955 . 183199) (FINDFONTFILES 183201 . 186417) ( -SORTFONTSPECS 186419 . 189122)) (189125 194663 (MATCHFONTFACE 189135 . 190210) (MAKEFONTFACE 190212 . -191246) (FONTFACETOATOM 191248 . 193498) (FONTFACE.STARS 193500 . 194661)) (195294 195786 ( -\UNITWIDTHSVECTOR 195304 . 195784)) (212590 214657 (FONTDESCRIPTOR.DEFPRINT 212600 . 214179) ( -FONTCLASS.DEFPRINT 214181 . 214655)) (218570 221360 (\CREATEKERNELEMENT 218580 . 218938) ( -\FSETLEFTKERN 218940 . 219431) (\FGETLEFTKERN 219433 . 221358)) (221361 232242 (\CREATEFONT 221371 . -224814) (\CREATECHARSET 224816 . 227993) (\INSTALLCHARSETINFO 227995 . 231329) ( -\INSTALLCHARSETINFO.CHARENCODING 231331 . 232240)) (232564 233932 (\FONTRESETCHARWIDTHS 232574 . -233930)) (234455 242071 (\CREATEDISPLAYFONT 234465 . 236230) (\CREATECHARSET.DISPLAY 236232 . 239656) -(\FONTEXISTS?.DISPLAY 239658 . 242069)) (242072 250342 (FAKEFACE.CHARSET 242082 . 246036) ( -MAKEBOLD.CHAR 246038 . 247891) (MAKEITALIC.CHAR 247893 . 250340)) (250373 254628 (\SFROTATECSINFO -250383 . 252525) (\SFROTATEFONTCHARACTERS 252527 . 252911) (\SFROTATECSINFOOFFSETS 252913 . 254626)) ( -254629 255803 (\SFMAKECOLOR 254639 . 255801))))) + (FILEMAP (NIL (6486 16153 (CHARWIDTH 6496 . 7285) (CHARWIDTHY 7287 . 8804) (STRINGWIDTH 8806 . 9843) ( +\CHARWIDTH.DISPLAY 9845 . 10260) (\STRINGWIDTH.DISPLAY 10262 . 10690) (\STRINGWIDTH.GENERIC 10692 . +16151)) (16154 22786 (DEFAULTFONT 16164 . 17449) (FONTCLASS 17451 . 19723) (FONTCLASSUNPARSE 19725 . +20626) (FONTCLASSCOMPONENT 20628 . 21216) (SETFONTCLASSCOMPONENT 21218 . 21660) (GETFONTCLASSCOMPONENT + 21662 . 22784)) (24234 43749 (FONTCREATE 24244 . 27489) (FONTCREATE1 27491 . 30150) ( +FONTCREATE.SLUGFD 30152 . 32716) (\FONT.CHECKARGS1 32718 . 37423) (\FONTCREATE1.NOFN 37425 . 37639) ( +FONTFILEP 37641 . 38529) (\READCHARSET 38531 . 43329) (FONTCHARSETS 43331 . 43747)) (43750 50826 ( +\FONT.CHECKARGS 43760 . 50509) (\CHARSET.CHECK 50511 . 50824)) (50827 57187 (COERCEFONTSPEC 50837 . +56498) (COERCEFONTSPEC.TARGETFACE 56500 . 57185)) (59382 62504 (MAKEFONTSPEC 59392 . 60872) ( +FONTSPEC.TO.FONTDESCRIPTOR 60874 . 62502)) (62505 72167 (COMPLETE.FONT 62515 . 64540) (COMPLETEFONTP +64542 . 65280) (COMPLETE.CHARSET 65282 . 69348) (PRUNESLUGCSINFOS 69350 . 70661) (MONOSPACEFONTP 70663 + . 72165)) (72206 82020 (FONTASCENT 72216 . 72600) (FONTDESCENT 72602 . 73087) (FONTHEIGHT 73089 . +73491) (FONTPROP 73493 . 81297) (\AVGCHARWIDTH 81299 . 82018)) (82843 84713 (FONTDEVICEPROP 82853 . +84711)) (84830 85684 (EDITCHAR 84840 . 85682)) (85730 97920 (GETCHARBITMAP 85740 . 86864) ( +PUTCHARBITMAP 86866 . 89024) (\GETCHARBITMAP.CSINFO 89026 . 91042) (\PUTCHARBITMAP.CSINFO 91044 . +97918)) (97921 120262 (MOVECHARBITMAP 97931 . 99825) (MOVEFONTCHARS 99827 . 104977) (\MOVEFONTCHAR +104979 . 109851) (\MOVEFONTCHARS.SOURCEDATA 109853 . 116608) (\MAKESLUGCHAR 116610 . 119145) ( +SLUGCHARP 119147 . 120260)) (121177 134229 (FONTFILES 121187 . 124024) (\FINDFONTFILE 124026 . 126003) + (\FONTFILENAMES 126005 . 126565) (\FONTFILENAME 126567 . 129677) (FONTSPECFROMFILENAME 129679 . +134227)) (134230 170563 (FONTCOPY 134240 . 139323) (FONTP 139325 . 139624) (FONTUNPARSE 139626 . +141349) (SETFONTDESCRIPTOR 141351 . 142815) (\STREAMCHARWIDTH 142817 . 146828) (\COERCECHARSET 146830 + . 150219) (\BUILDSLUGCSINFO 150221 . 153914) (\FONTSYMBOL 153916 . 154570) (\DEVICESYMBOL 154572 . +155356) (\FONTFACE 155358 . 162562) (\FONTFACE.COLOR 162564 . 169346) (SETFONTCHARENCODING 169348 . +170561)) (170564 191422 (FONTSAVAILABLE 170574 . 175938) (FONTEXISTS? 175940 . 179748) ( +\SEARCHFONTFILES 179750 . 182964) (FLUSHFONTCACHE 182966 . 185497) (FINDFONTFILES 185499 . 188715) ( +SORTFONTSPECS 188717 . 191420)) (191423 196961 (MATCHFONTFACE 191433 . 192508) (MAKEFONTFACE 192510 . +193544) (FONTFACETOATOM 193546 . 195796) (FONTFACE.STARS 195798 . 196959)) (197592 198084 ( +\UNITWIDTHSVECTOR 197602 . 198082)) (215005 217072 (FONTDESCRIPTOR.DEFPRINT 215015 . 216594) ( +FONTCLASS.DEFPRINT 216596 . 217070)) (220994 223784 (\CREATEKERNELEMENT 221004 . 221362) ( +\FSETLEFTKERN 221364 . 221855) (\FGETLEFTKERN 221857 . 223782)) (223785 234939 (\CREATEFONT 223795 . +227403) (\CREATECHARSET 227405 . 230690) (\INSTALLCHARSETINFO 230692 . 234026) ( +\INSTALLCHARSETINFO.CHARENCODING 234028 . 234937)) (235261 236629 (\FONTRESETCHARWIDTHS 235271 . +236627)) (237152 245010 (\CREATEDISPLAYFONT 237162 . 239069) (\CREATECHARSET.DISPLAY 239071 . 242595) +(\FONTEXISTS?.DISPLAY 242597 . 245008)) (245011 253389 (FAKEFACE.CHARSET 245021 . 249083) ( +MAKEBOLD.CHAR 249085 . 250938) (MAKEITALIC.CHAR 250940 . 253387)) (253420 257675 (\SFROTATECSINFO +253430 . 255572) (\SFROTATEFONTCHARACTERS 255574 . 255958) (\SFROTATECSINFOOFFSETS 255960 . 257673)) ( +257676 258850 (\SFMAKECOLOR 257686 . 258848))))) STOP diff --git a/sources/FONT.LCOM b/sources/FONT.LCOM index e219801d..a86162b0 100644 Binary files a/sources/FONT.LCOM and b/sources/FONT.LCOM differ diff --git a/sources/MEDLEYFONTFORMAT b/sources/MEDLEYFONTFORMAT index 3c2c630b..58ca4b32 100644 --- a/sources/MEDLEYFONTFORMAT +++ b/sources/MEDLEYFONTFORMAT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "12-Apr-2026 00:46:54" {WMEDLEY}MEDLEYFONTFORMAT.;306 63906 +(FILECREATED "17-Apr-2026 09:32:49" {MEDLEY}MEDLEYFONTFORMAT.;310 64484 :EDIT-BY rmk - :CHANGES-TO (FNS MEDLEYFONT.READ.FONT MEDLEYFONT.FILENAME) + :CHANGES-TO (FNS MEDLEYFONT.FILEVERSION MEDLEYFONT.GETFILEPROP) - :PREVIOUS-DATE " 6-Apr-2026 09:45:18" {WMEDLEY}MEDLEYFONTFORMAT.;304) + :PREVIOUS-DATE "15-Apr-2026 23:17:13" {WMEDLEY}MEDLEYFONTFORMAT.;308) (PRETTYCOMPRINT MEDLEYFONTFORMATCOMS) @@ -145,7 +145,9 @@ (FULLNAME STREAM]) (MEDLEYFONT.GETCHARSET - [LAMBDA (STREAM CHARSET FONT DIRECTORY) (* ; "Edited 6-Apr-2026 09:45 by rmk") + [LAMBDA (STREAM CHARSET FONT) (* ; "Edited 15-Apr-2026 13:29 by rmk") + (* ; "Edited 12-Apr-2026 22:14 by rmk") + (* ; "Edited 6-Apr-2026 09:45 by rmk") (* ; "Edited 30-Mar-2026 08:42 by rmk") (* ; "Edited 24-Mar-2026 00:04 by rmk") (* ; "Edited 21-Mar-2026 15:28 by rmk") @@ -162,47 +164,49 @@ (SETQ CHARSET (CHARSET.DECODE CHARSET)) (RESETLST (CL:UNLESS (\GETSTREAM STREAM 'INPUT T) - (CL:WHEN (type? FONTSPEC STREAM) - (SETQ STREAM (MEDLEYFONT.FILENAME STREAM DIRECTORY))) [RESETSAVE (SETQ STREAM (OPENSTREAM STREAM 'INPUT)) `(PROGN (CLOSEF? OLDVALUE]) (MEDLEYFONT.FILEVERSION STREAM 1) - (CL:IF (IGREATERP CHARSET (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET)) - (SLUGCSINFO FONT) - (MEDLEYFONT.GETCHARSET.INTERNAL STREAM CHARSET FONT (\FIXPIN STREAM))))]) + (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET) + (MEDLEYFONT.GETCHARSET.INTERNAL STREAM CHARSET FONT (\FIXPIN STREAM)))]) (MEDLEYFONT.GETCHARSET.INTERNAL - [LAMBDA (STREAM CHARSET FONT CSLOC) (* ; "Edited 29-Mar-2026 22:42 by rmk") + [LAMBDA (STREAM CHARSET FONT CSLOC) (* ; "Edited 15-Apr-2026 11:09 by rmk") + (* ; "Edited 12-Apr-2026 14:04 by rmk") + (* ; "Edited 29-Mar-2026 22:42 by rmk") (* ;; "Caller guarantees STREAM and CSLOC as the location of the charset info. CHARSET is less than (MAXCHARSTE FONT).") - (LET (CSINFO FILECHARSET ALLOTHERS) - (if (ILESSP CSLOC 0) - then - (* ;; + (if (IGREATERP CHARSET (fetch (FONTDESCRIPTOR MAXCHARSET) of FONT)) + then (SLUGCSINFO FONT) + else (LET (CSINFO FILECHARSET ALLOTHERS) + (if (ILESSP CSLOC 0) + then + (* ;;  "File contains at most one instantiated charset, others are either all empty or all uninstantiated") - (SETFILEPTR STREAM (IMINUS CSLOC)) - (SETQ FILECHARSET (\FIXPIN STREAM)) - (SETQ ALLOTHERS (BIN STREAM)) (* ; "If not the one we wanted") - [SELECTQ FILECHARSET - (-1 (* ; "All empty") - (SLUGCSINFO FONT)) - (-2 (* ; "All uninstantiated") - NIL) - (PROGN (if (IEQP CHARSET FILECHARSET) - then (MEDLEYFONT.READ.CHARSET STREAM CHARSET) - elseif (EQ 1 ALLOTHERS) - then (SLUGCSINFO FONT] - else - (* ;; "CSLOC points to the vector, what does it say about the requested CHARSET?") + (SETFILEPTR STREAM (IMINUS CSLOC)) + (SETQ FILECHARSET (\FIXPIN STREAM)) + (SETQ ALLOTHERS (BIN STREAM)) (* ; "If not the one we wanted") + [SELECTQ FILECHARSET + (-1 (* ; "All empty") + (SLUGCSINFO FONT)) + (-2 (* ; "All uninstantiated") + NIL) + (PROGN (if (IEQP CHARSET FILECHARSET) + then (MEDLEYFONT.READ.CHARSET STREAM CHARSET) + elseif (EQ 1 ALLOTHERS) + then (SLUGCSINFO FONT] + else + (* ;; + "CSLOC points to the vector, what does it say about the requested CHARSET?") - (SETFILEPTR STREAM (IPLUS CSLOC (UNFOLD CHARSET BYTESPERCELL))) - (SELECTQ (SETQ CSLOC (\FIXPIN STREAM)) - (0 NIL) - (-1 (SLUGCSINFO FONT)) - (PROGN (SETFILEPTR STREAM CSLOC) - (MEDLEYFONT.READ.CHARSET STREAM CHARSET FONT]) + (SETFILEPTR STREAM (IPLUS CSLOC (UNFOLD CHARSET BYTESPERCELL))) + (SELECTQ (SETQ CSLOC (\FIXPIN STREAM)) + (0 NIL) + (-1 (SLUGCSINFO FONT)) + (PROGN (SETFILEPTR STREAM CSLOC) + (MEDLEYFONT.READ.CHARSET STREAM CHARSET FONT]) (MEDLEYFONT.CHARSET? [LAMBDA (FILE CHARSET) (* ; "Edited 16-Mar-2026 00:31 by rmk") @@ -218,7 +222,10 @@ CHARSETS)]) (MEDLEYFONT.GETFILEPROP - [LAMBDA (FILE PROP) (* ; "Edited 31-Mar-2026 14:43 by rmk") + [LAMBDA (FILE PROP) (* ; "Edited 16-Apr-2026 22:30 by rmk") + (* ; "Edited 15-Apr-2026 00:19 by rmk") + (* ; "Edited 12-Apr-2026 19:31 by rmk") + (* ; "Edited 31-Mar-2026 14:43 by rmk") (* ; "Edited 28-Mar-2026 22:59 by rmk") (* ; "Edited 24-Mar-2026 10:56 by rmk") (* ; "Edited 20-Mar-2026 13:23 by rmk") @@ -229,24 +236,25 @@ (* ; "Edited 21-May-2025 11:36 by rmk") (* ; "Edited 17-May-2025 19:07 by rmk") (* ; "Edited 14-May-2025 17:46 by rmk") - [if (\GETSTREAM FILE 'INPUT T) - then (* ; "Shouldn't need to reopen") - (SETQ FILE (FULLNAME FILE)) - elseif (OR (LITATOM FILE) - (STRINGP FILE)) - else (SETQ FILE (CAR (FONTFILES (FONTPROP (FONTCREATE FILE) - 'SPEC] + (* ; "FONTPROP version") + (SETQ FILE (if (\GETSTREAM FILE 'INPUT T) + then (* ; "Shouldn't need to reopen") + (FULLNAME FILE) + elseif (CAR (FONTFILES FILE)) + else (ERROR "FILE NOT FOUND" FILE))) (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) - (LET (HEADERPROPS CSLOC SINGLECS) + (LET (HEADERPROPS CSLOC SINGLECS MAXCHARSET) (CL:UNLESS (SETQ HEADERPROPS (MEDLEYFONT.FILEP STREAM)) (ERROR "Not a MEDLEYFONT file" (FULLNAME STREAM))) - (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET) + (SETQ MAXCHARSET (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET)) (SETQ CSLOC (\FIXPIN STREAM)) (SELECTQ PROP (OTHERPROPS (CDDR HEADERPROPS)) (DATE (CADR HEADERPROPS)) + (MAXCHARSET MAXCHARSET) (FONTPROPS (MEDLEYFONT.READ.FONTPROPS STREAM)) - (CHARSETS (if (ILESSP CSLOC 0) + (CHARSETS (* ; "Skips slugs and indirects") + (if (ILESSP CSLOC 0) then (* ;; "File contains only one instantiated charset ") @@ -255,8 +263,8 @@ (CL:WHEN (IGEQ SINGLECS 0) (CONS SINGLECS)) else (SETFILEPTR STREAM CSLOC) - (for CS from 0 to \MAXCHARSET when (IGREATERP (\FIXPIN STREAM) - 0) collect CS))) + (for CS from 0 to MAXCHARSET when (IGREATERP (\FIXPIN STREAM) + 0) collect CS))) (INDIRECTS (CADR (ASSOC 'INDIRECTS (MEDLEYFONT.READ.FONTPROPS STREAM)))) (ERROR "Unknown MEDLEYFONT property"]) @@ -296,14 +304,17 @@ ,@(MEDLEYFONT.READ.ITEM STREAM 'OTHERFONTPROPS])])]) (MEDLEYFONT.FILEVERSION - [LAMBDA (FILE REQUIRED) (* ; "Edited 4-Apr-2026 00:10 by rmk") + [LAMBDA (FILE REQUIRED) (* ; "Edited 17-Apr-2026 09:32 by rmk") + (* ; "Edited 4-Apr-2026 00:10 by rmk") (* ; "Edited 30-Mar-2026 12:08 by rmk") (* ; "Edited 29-Mar-2026 11:21 by rmk") - (LET [(FILEVERSION (CADR (ASSOC 'VERSION (MEDLEYFONT.FILEP FILE] - (CL:WHEN (AND REQUIRED (NEQ REQUIRED FILEVERSION)) - (ERROR (CONCAT "Medley font version is " FILEVERSION ", " REQUIRED " is required") - FILE)) - FILEVERSION]) + (LET* [(PROPS (OR (MEDLEYFONT.FILEP FILE) + (ERROR "Not a Medley font" FILE))) + (FILEVERSION (CADR (ASSOC 'VERSION PROPS] + (CL:WHEN (AND REQUIRED (NEQ REQUIRED FILEVERSION)) + (ERROR (CONCAT "Medley font version is " FILEVERSION ", " REQUIRED " is required") + FILE)) + FILEVERSION]) ) @@ -313,7 +324,8 @@ (DEFINEQ (MEDLEYFONT.READ.FONT - [LAMBDA (FILE CHARSETS NOERROR DIRECTORY) (* ; "Edited 12-Apr-2026 00:30 by rmk") + [LAMBDA (FILE CHARSETS NOERROR DIRECTORY) (* ; "Edited 15-Apr-2026 00:50 by rmk") + (* ; "Edited 12-Apr-2026 00:30 by rmk") (* ; "Edited 6-Apr-2026 09:07 by rmk") (* ; "Edited 4-Apr-2026 15:29 by rmk") (* ; "Edited 31-Mar-2026 22:53 by rmk") @@ -330,34 +342,34 @@ (* ; "Edited 9-Jul-2025 00:06 by rmk") (* ; "Edited 6-Jul-2025 11:45 by rmk") - (* ;; "Returns a font descriptor containing the requested charsets from FILE. If FILE is not given, the filename is determined from the FONTSPEC and the FONTDEVICEPROP's for its FSDEVICE.") + (* ;; "Returns a font descriptor containing the requested charsets from FILE. If FILE is a FONTSPEC, it is coerced to a standard font name on DIRECTORY.") - (SETQ FILE (MEDLEYFONT.FILENAME FILE DIRECTORY)) - (if (NOT (INFILEP FILE)) - then (CL:UNLESS NOERROR (ERROR "FILE NOT FOUND" FILE)) - elseif [OR (MEMB CHARSETS '(NIL ALL)) + (CL:WHEN [OR (MEMB CHARSETS '(NIL ALL)) (SETQ CHARSETS (SORT (CHARSET.DECODE (MKLIST CHARSETS) NOERROR] - then (RESETLST - (LET (STREAM FONT CSLOC MAXCHARSET) (* ; + (RESETLST + (PROG ((FILENAME (MEDLEYFONT.FILENAME FILE DIRECTORY)) + STREAM FONT CSLOC MAXCHARSET) (* ;  "CL:OPEN-FILE doesn't exist in the init") - [RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT)) - '(PROGN (CLOSEF? OLDVALUE] - (MEDLEYFONT.FILEVERSION STREAM 1) - (SETQ MAXCHARSET (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET)) - (SETQ CSLOC (\FIXPIN STREAM)) (* ; + [RESETSAVE (SETQ STREAM (OPENSTREAM FILENAME 'INPUT)) + '(PROGN (CLOSEF? OLDVALUE] + (MEDLEYFONT.FILEVERSION STREAM 1) + (SETQ MAXCHARSET (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET)) + (SETQ CSLOC (\FIXPIN STREAM)) (* ;  "CSLOC here so MEDLEYFONT.GETCHARSET can skip over the font stuff.") - (SETQ FONT (MEDLEYFONT.READ.VERIFIEDFONT STREAM)) - (for CSNO from 0 to MAXCHARSET while CHARSETS - when (if (EQ CHARSETS 'ALL) - elseif (EQ CSNO (CAR CHARSETS)) - then (pop CHARSETS)) do (\SETCHARSETINFO FONT CSNO - (MEDLEYFONT.GETCHARSET.INTERNAL - STREAM CSNO FONT CSLOC))) - FONT))]) + (SETQ FONT (MEDLEYFONT.READ.VERIFIEDFONT STREAM)) + (for CSNO from 0 to MAXCHARSET while CHARSETS + when (if (EQ CHARSETS 'ALL) + elseif (EQ CSNO (CAR CHARSETS)) + then (pop CHARSETS)) do (\SETCHARSETINFO FONT CSNO + (MEDLEYFONT.GETCHARSET.INTERNAL STREAM + CSNO FONT CSLOC))) + (RETURN FONT))))]) (MEDLEYFONT.READ.CHARSET - [LAMBDA (STREAM CHARSET FONT) (* ; "Edited 30-Mar-2026 08:36 by rmk") + [LAMBDA (STREAM CHARSET FONT) (* ; "Edited 14-Apr-2026 22:32 by rmk") + (* ; "Edited 12-Apr-2026 13:59 by rmk") + (* ; "Edited 30-Mar-2026 08:36 by rmk") (* ; "Edited 22-Mar-2026 00:21 by rmk") (* ; "Edited 17-Mar-2026 10:00 by rmk") (* ; "Edited 14-Feb-2026 00:36 by rmk") @@ -376,7 +388,7 @@ (MEDLEYFONT.GETCHARSET (MEDLEYFONT.FILENAME (MEDLEYFONT.READ.ITEM STREAM 'INDIRECTCHARSET) - STREAM) + (FULLNAME STREAM)) CHARSET FONT) else (bind PAIR LABEL ITEM (CSINFO _ (create CHARSETINFO WIDTHS _ NIL @@ -523,7 +535,9 @@ (bind PAIR until [EQ 'STOP (CAR (SETQ PAIR (MEDLEYFONT.READ.ITEM STREAM] collect PAIR]) (MEDLEYFONT.READ.VERIFIEDFONT - [LAMBDA (STREAM FONT) (* ; "Edited 28-Mar-2026 17:03 by rmk") + [LAMBDA (STREAM FONT) (* ; "Edited 15-Apr-2026 23:16 by rmk") + (* ; "Edited 12-Apr-2026 12:51 by rmk") + (* ; "Edited 28-Mar-2026 17:03 by rmk") (* ; "Edited 23-Mar-2026 11:37 by rmk") (* ; "Edited 19-Mar-2026 11:48 by rmk") (* ; "Edited 18-Mar-2026 08:18 by rmk") @@ -589,6 +603,9 @@ (INDIRECTS (* ; "Only a file prop")) (\SFFACECODE (* ; "to be deprecated")) (HELP "UNKNOWN FONTDESCRIPTOR PROPERTY: P"))) + (replace (FONTDESCRIPTOR FONTFILENAME) of FONT with (PSEUDOFILENAME (FULLNAME STREAM))) + (* ; + "PSEUDOFILENAME so that a deployed fontfile is redirected in a new sysout/makesys environment ") (replace (FONTDESCRIPTOR FONTCHARSETVECTOR) of FONT with (\CREATEFONTCHARSETVECTOR FONT)) FONT]) ) @@ -879,34 +896,16 @@ (DEFINEQ (MEDLEYFONT.FILENAME - [LAMBDA (FILE DIRECTORY EXTENSION) (* ; "Edited 12-Apr-2026 00:41 by rmk") - (* ; "Edited 6-Apr-2026 09:31 by rmk") - (* ; "Edited 1-Apr-2026 09:46 by rmk") - (* ; "Edited 30-Mar-2026 09:19 by rmk") - (* ; "Edited 17-Mar-2026 10:15 by rmk") - (* ; "Edited 2-Mar-2026 22:45 by rmk") + [LAMBDA (FILE DIRECTORY) (* ; "Edited 15-Apr-2026 00:41 by rmk") (* ; "Edited 23-Jan-2026 15:10 by rmk") (* ; "Edited 7-Oct-2025 11:50 by rmk") (* ; "Edited 4-Sep-2025 08:48 by rmk") (* ; "Edited 10-Jun-2025 11:02 by rmk") (* ; "Edited 19-May-2025 17:42 by rmk") - - (* ;; "Defaults to components of DIRECTORY, e.g. host/directory. Current directory if T, device directory if NIL. ") - - (LET (FONTSPEC HOST DIR EXT) - (if (type? FONTSPEC FILE) - then (SETQ FONTSPEC FILE) - (SETQ FILE (\FONTFILENAME (\FONT.CHECKARGS FILE NIL NIL NIL NIL T))) - else (SETQ FONTSPEC (FONTSPECFROMFILENAME FILE))) - (SETQ DIRECTORY (SELECTQ DIRECTORY - (NIL (* ; "Deployed font directory") - [CAR (MKLIST (FONTDEVICEPROP FONTSPEC 'FONTDIRECTORIES]) - (T (* ; "Connected directory") - (DIRECTORYNAME T)) - DIRECTORY)) - (SETQ HOST (FILENAMEFIELD DIRECTORY 'HOST)) - (PACKFILENAME 'BODY FILE 'HOST HOST 'DIRECTORY DIRECTORY 'EXTENSION - (OR EXTENSION (CAR (MKLIST (FONTDEVICEPROP FONTSPEC 'FONTEXTENSIONS]) + (PACKFILENAME 'BODY (CL:IF (type? FONTSPEC FILE) + (\FONTFILENAME (\FONT.CHECKARGS FILE NIL NIL NIL NIL T)) + FILE) + 'BODY DIRECTORY]) ) (ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT) @@ -957,12 +956,12 @@ ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2201 19416 (MEDLEYFONT.WRITE.FONT 2211 . 8614) (MEDLEYFONT.GETCHARSET 8616 . 10664) ( -MEDLEYFONT.GETCHARSET.INTERNAL 10666 . 12403) (MEDLEYFONT.CHARSET? 12405 . 13283) ( -MEDLEYFONT.GETFILEPROP 13285 . 16349) (MEDLEYFONT.FILEP 16351 . 18779) (MEDLEYFONT.FILEVERSION 18781 - . 19414)) (19442 41377 (MEDLEYFONT.READ.FONT 19452 . 23020) (MEDLEYFONT.READ.CHARSET 23022 . 28069) ( -MEDLEYFONT.READ.ITEM 28071 . 34220) (MEDLEYFONT.PEEK.ITEM 34222 . 35084) (MEDLEYFONT.READ.FONTPROPS -35086 . 35551) (MEDLEYFONT.READ.VERIFIEDFONT 35553 . 41375)) (41403 60753 (MEDLEYFONT.WRITE.CHARSET -41413 . 46052) (MEDLEYFONT.WRITE.ITEM 46054 . 55107) (MEDLEYFONT.WRITE.FONTPROPS 55109 . 59878) ( -MEDLEYFONT.WRITE.HEADER 59880 . 60751)) (60754 63021 (MEDLEYFONT.FILENAME 60764 . 63019))))) + (FILEMAP (NIL (2205 20684 (MEDLEYFONT.WRITE.FONT 2215 . 8618) (MEDLEYFONT.GETCHARSET 8620 . 10701) ( +MEDLEYFONT.GETCHARSET.INTERNAL 10703 . 12956) (MEDLEYFONT.CHARSET? 12958 . 13836) ( +MEDLEYFONT.GETFILEPROP 13838 . 17417) (MEDLEYFONT.FILEP 17419 . 19847) (MEDLEYFONT.FILEVERSION 19849 + . 20682)) (20710 43327 (MEDLEYFONT.READ.FONT 20720 . 24236) (MEDLEYFONT.READ.CHARSET 24238 . 29514) ( +MEDLEYFONT.READ.ITEM 29516 . 35665) (MEDLEYFONT.PEEK.ITEM 35667 . 36529) (MEDLEYFONT.READ.FONTPROPS +36531 . 36996) (MEDLEYFONT.READ.VERIFIEDFONT 36998 . 43325)) (43353 62703 (MEDLEYFONT.WRITE.CHARSET +43363 . 48002) (MEDLEYFONT.WRITE.ITEM 48004 . 57057) (MEDLEYFONT.WRITE.FONTPROPS 57059 . 61828) ( +MEDLEYFONT.WRITE.HEADER 61830 . 62701)) (62704 63599 (MEDLEYFONT.FILENAME 62714 . 63597))))) STOP diff --git a/sources/MEDLEYFONTFORMAT.LCOM b/sources/MEDLEYFONTFORMAT.LCOM index e760235f..e6753f29 100644 Binary files a/sources/MEDLEYFONTFORMAT.LCOM and b/sources/MEDLEYFONTFORMAT.LCOM differ