Better control over source of fonts
This commit is contained in:
rmkaplan
195
sources/FONT
195
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}<sources>FONT.;780 256466
|
||||
(FILECREATED "17-Apr-2026 08:42:29" {MEDLEY}<sources>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}<sources>FONT.;779)
|
||||
:PREVIOUS-DATE "15-Apr-2026 22:12:03" {WMEDLEY}<sources>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
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "12-Apr-2026 00:46:54" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;306 63906
|
||||
(FILECREATED "17-Apr-2026 09:32:49" {MEDLEY}<sources>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}<sources>MEDLEYFONTFORMAT.;304)
|
||||
:PREVIOUS-DATE "15-Apr-2026 23:17:13" {WMEDLEY}<sources>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
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user