Documentation and cleanup
This commit is contained in:
rmkaplan
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED "16-Apr-2026 22:39:37" {WMEDLEY}<library>IMPORTFONTS.;98 60135
|
||||
(FILECREATED " 4-May-2026 15:26:51" {MEDLEY}<library>IMPORTFONTS.;115 58063
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS LEGACYDISPLAYFONT)
|
||||
:CHANGES-TO (FNS IMPORT.DISPLAY)
|
||||
|
||||
:PREVIOUS-DATE "15-Apr-2026 22:10:41" {WMEDLEY}<library>IMPORTFONTS.;97)
|
||||
:PREVIOUS-DATE " 4-May-2026 13:49:39" {MEDLEY}<library>IMPORTFONTS.;113)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT IMPORTFONTSCOMS)
|
||||
@@ -14,21 +14,21 @@
|
||||
(RPAQQ IMPORTFONTSCOMS
|
||||
((FNS IMPORTFONTS FONT.TO.MCCS IMPORTFONTS.FONTSPECS IMPORTFONTS.CONTEXT IMPORTFONTS.NOCACHE
|
||||
IMPORTFONTS.DIRECTORY IMPORTFONTS.CLEAR IMPORTFONTS.SUBDIR IMPORTFONTS.DIRSIZE)
|
||||
(FNS IMPORTFONTS.AVAILABLE IMPORTFONTS.EXISTS? IMPORTFONTS.DEPLOY)
|
||||
(FNS IMPORTFONTS.AVAILABLE IMPORTFONTS.EXISTS?)
|
||||
(FNS FAKEFACE FAKEFACE.FROMFILE FAKEFACE.FROMFONT)
|
||||
(FNS IMPORTFONTS.PHASES MISSINGFACE)
|
||||
(COMS (* ; "For legacy display imports")
|
||||
(FNS IMPORT.DISPLAY LEGACYDISPLAYFONT)
|
||||
(FILES ACFONT))
|
||||
(COMS (* ; "For testing")
|
||||
(FNS IPF IPFSIZES)
|
||||
(FNS PEF AEF IEF MEF CEF FEF EFCLOSE)
|
||||
(FNS PEF AEF IEF MEF CEF FEF DEF EFCLOSE)
|
||||
(FNS SHOWCHARS CSSOURCE FONTDEFFONTS)
|
||||
(FILES EDITFONT))))
|
||||
(DEFINEQ
|
||||
|
||||
(IMPORTFONTS
|
||||
[LAMBDA (PHASE FONTSPECS DEVICE FROMDIRECTORY TODIRECTORY IMPORTFN NODRIBBLE)
|
||||
[LAMBDA (PHASE FONTSPECS DEVICE FROMDIR TODIR IMPORTFN NODRIBBLE)
|
||||
(* ; "Edited 4-May-2026 13:49 by rmk")
|
||||
(* ; "Edited 11-Apr-2026 10:55 by rmk")
|
||||
(* ; "Edited 5-Apr-2026 14:22 by rmk")
|
||||
(* ; "Edited 3-Apr-2026 08:15 by rmk")
|
||||
@@ -48,7 +48,7 @@
|
||||
(* ;; "Unless TODIRECTORY=DONT, writes the resultiing fonts Medley fontfiles, otherwise collects and returns them in a list (which will eat up storage). ")
|
||||
|
||||
(CL:UNLESS (MEMB (SETQ PHASE (U-CASE PHASE))
|
||||
'(IMPORT MCCS COMPLETE FAKE))
|
||||
'(IMPORT MCCS COMPLETE FAKE DEPLOY))
|
||||
(\ILLEGAL.ARG PHASE))
|
||||
(CL:UNLESS DEVICE
|
||||
(SETQ DEVICE 'DISPLAY))
|
||||
@@ -58,18 +58,17 @@
|
||||
(PROG1
|
||||
(RESETLST (* ;
|
||||
"Close dribble outside of this context")
|
||||
(CL:MULTIPLE-VALUE-SETQ (FROMDIRECTORY TODIRECTORY)
|
||||
(IMPORTFONTS.CONTEXT PHASE FROMDIRECTORY TODIRECTORY DEVICE))
|
||||
(IMPORTFONTS.CLEAR PHASE FONTSPECS TODIRECTORY DEVICE)
|
||||
(SETQ FONTSPECS (IMPORTFONTS.FONTSPECS PHASE FONTSPECS FROMDIRECTORY DEVICE))
|
||||
(CL:MULTIPLE-VALUE-SETQ (FROMDIR TODIR)
|
||||
(IMPORTFONTS.CONTEXT PHASE FROMDIR TODIR DEVICE))
|
||||
(IMPORTFONTS.CLEAR PHASE FONTSPECS TODIR DEVICE)
|
||||
(SETQ FONTSPECS (IMPORTFONTS.FONTSPECS PHASE FONTSPECS FROMDIR DEVICE))
|
||||
(CL:WHEN (AND (IGEQ (LENGTH FONTSPECS)
|
||||
5)
|
||||
(NOT NODRIBBLE)) (* ;
|
||||
"Put all the dribbles together one up")
|
||||
[DRIBBLE (PSEUDOFILENAME (PACKFILENAME 'BODY
|
||||
(OR (SUBSTRING TODIRECTORY 1
|
||||
(STRPOS ">" TODIRECTORY -2 NIL NIL NIL NIL
|
||||
T))
|
||||
(OR (SUBSTRING TODIR 1
|
||||
(STRPOS ">" TODIR -2 NIL NIL NIL NIL T))
|
||||
LOGINHOST/DIR)
|
||||
'NAME PHASE 'EXTENSION 'DRIBBLE]
|
||||
(PRINTOUT T "Dribbling to " (FULLNAME (DRIBBLEFILE))
|
||||
@@ -79,23 +78,23 @@
|
||||
(MCCS "MCCS recoding ")
|
||||
(COMPLETE "Completing ")
|
||||
(FAKE "Faking ")
|
||||
(DEPLOY "Deploying ")
|
||||
NIL)
|
||||
(LENGTH FONTSPECS)
|
||||
" " DEVICE " font" (CL:IF (IGEQ (LENGTH FONTSPECS)
|
||||
2)
|
||||
"s"
|
||||
""))
|
||||
(if TODIRECTORY
|
||||
then (PRINTOUT T 3 "from " FROMDIRECTORY 3 "to " TODIRECTORY T)
|
||||
else (PRINTOUT T " from " FROMDIRECTORY T 3 "(but not writing)" T))
|
||||
(if TODIR
|
||||
then (PRINTOUT T 3 "from " FROMDIR 3 "to " TODIR T)
|
||||
else (PRINTOUT T " from " FROMDIR T 3 "(but not writing)" T))
|
||||
(BKSYSBUF " ")
|
||||
(IMPORTFONTS.CLEAR PHASE FONTSPECS TODIRECTORY DEVICE)
|
||||
(IMPORTFONTS.CLEAR PHASE FONTSPECS TODIR DEVICE)
|
||||
(for FS FONT FONT FONTSTART TOFILE FROMFILE CAPTIONS THISTIME FROMSIZE TOSIZE CHANGED
|
||||
NOTINSTANTIATED TOTALTIME TODIRSIZE (FROMDIRSIZE ← (CL:IF (EQ PHASE 'IMPORT)
|
||||
0
|
||||
(IMPORTFONTS.DIRSIZE PHASE
|
||||
DEVICE FROMDIRECTORY))
|
||||
)
|
||||
DEVICE FROMDIR)))
|
||||
(NNOCHARSETS ← 0) in FONTSPECS as I from 1 first (SETQ TOTALTIME (CLOCK 0))
|
||||
eachtime (PRINTOUT T .I3 I ". " (fetch (FONTSPEC FSFAMILY) of FS)
|
||||
" " .I2 (fetch (FONTSPEC FSSIZE) of FS)
|
||||
@@ -103,10 +102,10 @@
|
||||
(FONTFACETOATOM (fetch (FONTSPEC FSFACE) of FS)))
|
||||
(SETQ THISTIME (CLOCK 0))
|
||||
collect (SELECTQ PHASE
|
||||
(IMPORT (SETQ FONT (APPLY* IMPORTFN FS FROMDIRECTORY))
|
||||
(IMPORT (SETQ FONT (APPLY* IMPORTFN FS FROMDIR))
|
||||
(SETQ CHANGED T))
|
||||
((MCCS COMPLETE)
|
||||
(SETQ FROMFILE (INFILEP (MEDLEYFONT.FILENAME FS FROMDIRECTORY)))
|
||||
(SETQ FROMFILE (INFILEP (MEDLEYFONT.FILENAME FS FROMDIR)))
|
||||
(if FROMFILE
|
||||
then (SETQ FONT (MEDLEYFONT.READ.FONT FROMFILE 'ALL))
|
||||
(SETQ FROMSIZE (GETFILEINFO FROMFILE 'LENGTH))
|
||||
@@ -117,14 +116,16 @@
|
||||
(COMPLETE (COMPLETE.FONT FONT T))
|
||||
NIL)))
|
||||
(FAKE (CL:MULTIPLE-VALUE-SETQ (FONT FROMFILE)
|
||||
(FAKEFACE.FROMFONT FS FROMDIRECTORY))
|
||||
(FAKEFACE.FROMFONT FS FROMDIR))
|
||||
(SETQ FROMSIZE (GETFILEINFO FROMFILE 'LENGTH))
|
||||
(SETQ CHANGED (FAKEFACE FONT)))
|
||||
(DEPLOY (SETQ FROMFILE (MEDLEYFONT.FILENAME FS FROMDIR))
|
||||
(SETQ FROMSIZE (GETFILEINFO FROMFILE 'LENGTH)))
|
||||
NIL)
|
||||
(CL:WHEN [SETQ NOTINSTANTIATED (EQ 0 (FONTPROP FONT 'NINSTANTIATEDCHARSETS]
|
||||
(add NNOCHARSETS 1))
|
||||
(CL:WHEN TODIRECTORY
|
||||
(SETQ TOFILE (MEDLEYFONT.FILENAME FS TODIRECTORY))
|
||||
(CL:WHEN TODIR
|
||||
(SETQ TOFILE (MEDLEYFONT.FILENAME FS TODIR))
|
||||
(SETQ TOFILE (CL:IF CHANGED
|
||||
(MEDLEYFONT.WRITE.FONT FONT TOFILE)
|
||||
(COPYFILE FROMFILE TOFILE))))
|
||||
@@ -137,7 +138,7 @@
|
||||
then (SETQ TOSIZE (GETFILEINFO TOFILE 'LENGTH))
|
||||
(SELECTQ PHASE
|
||||
(IMPORT (PRINTOUT T 25 .I6 TOSIZE " " .F7.2 THISTIME))
|
||||
((MCCS COMPLETE FAKE)
|
||||
((MCCS COMPLETE FAKE DEPLOY)
|
||||
(if CHANGED
|
||||
then (PRINTOUT T 25 .I6 FROMSIZE " -> " .I6 TOSIZE " "
|
||||
.F6.2 THISTIME 50 .I5 (IDIFFERENCE TOSIZE
|
||||
@@ -146,7 +147,7 @@
|
||||
))
|
||||
NIL))
|
||||
(TERPRI T)
|
||||
(CL:IF TODIRECTORY
|
||||
(CL:IF TODIR
|
||||
TOFILE
|
||||
FONT) finally (SETQ TOTALTIME (FIXR (FQUOTIENT (IDIFFERENCE (CLOCK 0)
|
||||
TOTALTIME)
|
||||
@@ -163,10 +164,11 @@
|
||||
(MCCS "recoded to MCCS")
|
||||
(COMPLETE "completed")
|
||||
(FAKE "faked")
|
||||
(DEPLOY "deployed")
|
||||
NIL))
|
||||
(if TODIRECTORY
|
||||
then (SETQ TODIRSIZE (IMPORTFONTS.DIRSIZE PHASE DEVICE
|
||||
TODIRECTORY))
|
||||
(if TODIR
|
||||
then (SETQ TODIRSIZE (IMPORTFONTS.DIRSIZE PHASE DEVICE TODIR
|
||||
))
|
||||
(PRINTOUT T " and written in " TOTALTIME " seconds" 4
|
||||
"Total size is " (FIXR (FQUOTIENT TODIRSIZE 1024
|
||||
))
|
||||
@@ -178,9 +180,9 @@
|
||||
(CL:UNLESS (EQ 0 NNOCHARSETS)
|
||||
(PRINTOUT T 4 NNOCHARSETS
|
||||
" fonts had no character sets" T))
|
||||
(CL:WHEN (AND TODIRECTORY (IGEQ (LENGTH $$VAL)
|
||||
5))
|
||||
(SETQ $$VAL TODIRECTORY))
|
||||
(CL:WHEN (AND TODIR (IGEQ (LENGTH $$VAL)
|
||||
5))
|
||||
(SETQ $$VAL TODIR))
|
||||
else (PRINTOUT T " (but not written) in " TOTALTIME " seconds"
|
||||
T))))
|
||||
(CL:WHEN (DRIBBLEFILE)
|
||||
@@ -231,7 +233,8 @@
|
||||
FONT)])
|
||||
|
||||
(IMPORTFONTS.FONTSPECS
|
||||
[LAMBDA (PHASE FONTSPECS FROMDIRECTORY DEVICE) (* ; "Edited 4-Apr-2026 11:41 by rmk")
|
||||
[LAMBDA (PHASE FONTSPECS FROMDIR DEVICE) (* ; "Edited 4-May-2026 08:59 by rmk")
|
||||
(* ; "Edited 4-Apr-2026 11:41 by rmk")
|
||||
(* ; "Edited 3-Apr-2026 00:51 by rmk")
|
||||
(* ; "Edited 1-Apr-2026 12:50 by rmk")
|
||||
(* ; "Edited 30-Mar-2026 23:27 by rmk")
|
||||
@@ -241,14 +244,14 @@
|
||||
(* ; "Edited 13-Mar-2026 10:53 by rmk")
|
||||
(* ; "Edited 4-Mar-2026 10:44 by rmk")
|
||||
|
||||
(* ;; "Crucially, the fontspecs for COMPLETE and FAKEFACE must be ordered so that coercions or faces come before the fontspecs that depend on them. E.g. the order of faces has to be MRR MIR/BRR BIR. That means that the TODIRECTORY can be the source for the completion/faking of later fonts.")
|
||||
(* ;; "Crucially, the fontspecs for COMPLETE and FAKEFACE must be ordered so that coercions or faces come before the fontspecs that depend on them. E.g. the order of faces has to be MRR MIR/BRR BIR. That means that the TODIR can be the source for the completion/faking of later fonts.")
|
||||
|
||||
(CL:UNLESS DEVICE
|
||||
(SETQ DEVICE 'DISPLAY))
|
||||
(SETQ FROMDIRECTORY (IMPORTFONTS.DIRECTORY DEVICE FROMDIRECTORY (IMPORTFONTS.SUBDIR PHASE)))
|
||||
(SETQ FROMDIR (IMPORTFONTS.DIRECTORY DEVICE FROMDIR PHASE))
|
||||
(RESETLST
|
||||
(IMPORTFONTS.NOCACHE)
|
||||
[RESETSAVE (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES FROMDIRECTORY)
|
||||
[RESETSAVE (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES FROMDIR)
|
||||
`(PROGN (FONTDEVICEPROP ',DEVICE 'FONTDIRECTORIES OLDVALUE]
|
||||
(LET [(EXPANDED (CL:REMOVE-DUPLICATES
|
||||
(for F inside (CL:IF (type? FONTSPEC FONTSPECS)
|
||||
@@ -262,13 +265,13 @@
|
||||
FSROTATION ← 0))
|
||||
elseif (LITATOM F)
|
||||
then
|
||||
(* ;; "Looks in FROMDIRECTORY")
|
||||
(* ;; "Looks in FROMDIR")
|
||||
|
||||
(IMPORTFONTS.AVAILABLE PHASE (MAKEFONTSPEC
|
||||
(OR F '*)
|
||||
'*
|
||||
'* 0 DEVICE)
|
||||
FROMDIRECTORY)
|
||||
FROMDIR)
|
||||
else (\ILLEGAL.ARG F)))
|
||||
:TEST
|
||||
(FUNCTION EQUAL]
|
||||
@@ -280,7 +283,7 @@
|
||||
do (for F in (DREVERSE (CONS FONTSPEC (COERCEFONTSPEC FONTSPEC
|
||||
'CHARCOERCIONS T)))
|
||||
unless (MEMBER F NEWFONTS) when (IMPORTFONTS.EXISTS? 'COMPLETE F
|
||||
FROMDIRECTORY)
|
||||
FROMDIR)
|
||||
do (push NEWFONTS F)) finally
|
||||
|
||||
(* ;;
|
||||
@@ -304,14 +307,14 @@
|
||||
using FACE WEIGHT ←
|
||||
'MEDIUM))
|
||||
eachtime (SETQ SOURCE (create FONTSPEC using FS FSFACE ← FC))
|
||||
when (IMPORTFONTS.EXISTS? 'FAKE SOURCE FROMDIRECTORY)
|
||||
when (IMPORTFONTS.EXISTS? 'FAKE SOURCE FROMDIR)
|
||||
do (push NEWFONTS SOURCE)))
|
||||
(CL:WHEN (EQ 'ITALIC (fetch (FONTFACE SLOPE) of FACE))
|
||||
(* ; "MIR -> MRR, BIR ->BMR")
|
||||
(for F SOURCE in (FONTFACE.STARS (create FONTFACE
|
||||
using FACE SLOPE ← 'REGULAR))
|
||||
eachtime (SETQ SOURCE (create FONTSPEC using FS FSFACE ← F))
|
||||
when (IMPORTFONTS.EXISTS? 'FAKE SOURCE FROMDIRECTORY)
|
||||
when (IMPORTFONTS.EXISTS? 'FAKE SOURCE FROMDIR)
|
||||
do (push NEWFONTS SOURCE)))
|
||||
(CL:WHEN (EQ 'COMPRESSED (fetch (FONTFACE EXPANSION) of FACE))
|
||||
(* ; "MRC -> MRR")
|
||||
@@ -319,15 +322,27 @@
|
||||
using FACE EXPANSION ←
|
||||
'REGULAR))
|
||||
eachtime (SETQ SOURCE (create FONTSPEC using FS FSFACE ← F))
|
||||
when (IMPORTFONTS.EXISTS? 'FAKE SOURCE FROMDIRECTORY)
|
||||
when (IMPORTFONTS.EXISTS? 'FAKE SOURCE FROMDIR)
|
||||
do (push NEWFONTS SOURCE)))
|
||||
finally (for F in EXPANDED unless (MEMBER F NEWFONTS)
|
||||
do (push NEWFONTS F))
|
||||
(RETURN (DREVERSE NEWFONTS))))
|
||||
(DEPLOY (* ;
|
||||
"Make sure we copy consistent versions of the indirects")
|
||||
(SORTFONTSPECS (CL:REMOVE-DUPLICATES (APPEND
|
||||
(for FS in EXPANDED
|
||||
join (MEDLEYFONT.GETFILEPROP
|
||||
(MEDLEYFONT.FILENAME FS
|
||||
FROMDIR)
|
||||
'INDIRECTS))
|
||||
EXPANDED)
|
||||
:TEST
|
||||
(FUNCTION EQUAL))))
|
||||
(SORTFONTSPECS EXPANDED))))])
|
||||
|
||||
(IMPORTFONTS.CONTEXT
|
||||
[LAMBDA (PHASE FROMDIRECTORY TODIRECTORY DEVICE) (* ; "Edited 4-Apr-2026 09:33 by rmk")
|
||||
[LAMBDA (PHASE FROMDIR TODIR DEVICE) (* ; "Edited 4-May-2026 00:16 by rmk")
|
||||
(* ; "Edited 4-Apr-2026 09:33 by rmk")
|
||||
(* ; "Edited 24-Mar-2026 23:11 by rmk")
|
||||
(* ; "Edited 23-Mar-2026 13:17 by rmk")
|
||||
(* ; "Edited 21-Mar-2026 09:53 by rmk")
|
||||
@@ -337,27 +352,32 @@
|
||||
(* ; "Edited 13-Mar-2026 10:52 by rmk")
|
||||
(* ; "Edited 3-Mar-2026 21:58 by rmk")
|
||||
|
||||
(* ;; "This sets up the FONTDEVICE props according to PHASE, using default values for the directories if they aren't specified. Returns the TODIRECTORY, or NIL if the TODIRECTORY was DONT=don't file.")
|
||||
(* ;; "This sets up the FONTDEVICE props according to PHASE, using default values for the directories if they aren't specified. Returns the TODIR, or NIL if the TODIR was DONT=don't file.")
|
||||
|
||||
[SETQ FROMDIRECTORY (IMPORTFONTS.DIRECTORY DEVICE FROMDIRECTORY (IMPORTFONTS.SUBDIR
|
||||
(SELECTQ PHASE
|
||||
(IMPORT 'SOURCE)
|
||||
(MCCS 'IMPORT)
|
||||
(COMPLETE 'MCCS)
|
||||
(FAKE 'COMPLETE)
|
||||
NIL]
|
||||
(SETQ TODIRECTORY (IMPORTFONTS.DIRECTORY DEVICE TODIRECTORY (IMPORTFONTS.SUBDIR PHASE)))
|
||||
(SETQ FROMDIR (IMPORTFONTS.DIRECTORY DEVICE FROMDIR
|
||||
(SELECTQ PHASE
|
||||
(IMPORT 'SOURCE)
|
||||
(MCCS 'IMPORT)
|
||||
(COMPLETE 'MCCS)
|
||||
(FAKE 'COMPLETE)
|
||||
(DEPLOY (for P in '(FAKE COMPLETE MCCS IMPORT)
|
||||
suchthat (DIRECTORYNAMEP (IMPORTFONTS.DIRECTORY DEVICE
|
||||
FROMDIR P))))
|
||||
NIL)))
|
||||
(SETQ TODIR (CL:IF (EQ PHASE 'DEPLOY)
|
||||
(CONCAT [CAR (MKLIST (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES]
|
||||
">")
|
||||
(IMPORTFONTS.DIRECTORY DEVICE TODIR PHASE)))
|
||||
[RESETSAVE (FONTDEVICEPROP DEVICE 'FONTCOERCIONS NIL)
|
||||
`(PROGN (FONTDEVICEPROP ',DEVICE 'FONTCOERCIONS OLDVALUE]
|
||||
(SELECTQ PHASE
|
||||
((IMPORT MCCS)
|
||||
[RESETSAVE (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES FROMDIRECTORY)
|
||||
[RESETSAVE (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES FROMDIR)
|
||||
`(PROGN (FONTDEVICEPROP ',DEVICE 'FONTDIRECTORIES OLDVALUE])
|
||||
(COMPLETE
|
||||
(* ;; "Make FONTCREATE1 in the COMPLETE phase draw from previously import-completed fonts, not from the currently active fonts")
|
||||
|
||||
[RESETSAVE (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES (LIST TODIRECTORY FROMDIRECTORY)
|
||||
)
|
||||
[RESETSAVE (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES (LIST TODIR FROMDIR))
|
||||
`(PROGN (FONTDEVICEPROP ',DEVICE 'FONTDIRECTORIES OLDVALUE]
|
||||
(* ; "Suppress face faking")
|
||||
[RESETSAVE (FONTDEVICEPROP DEVICE 'FACECOERCIONS NIL)
|
||||
@@ -365,14 +385,14 @@
|
||||
(FAKE
|
||||
(* ;; "Make FONTCREATE1 in the FAKE phase draw from previously import-completed fonts, not from the currently active fonts")
|
||||
|
||||
[RESETSAVE (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES (LIST TODIRECTORY FROMDIRECTORY))
|
||||
[RESETSAVE (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES (LIST TODIR FROMDIR))
|
||||
`(PROGN (FONTDEVICEPROP ',DEVICE 'FONTDIRECTORIES OLDVALUE]
|
||||
(* ; "Completion has already been done")
|
||||
[RESETSAVE (FONTDEVICEPROP DEVICE 'FONTCOERCIONS NIL)
|
||||
`(PROGN (FONTDEVICEPROP ',DEVICE 'FONTCOERCIONS OLDVALUE])
|
||||
NIL)
|
||||
(IMPORTFONTS.NOCACHE)
|
||||
(CL:VALUES FROMDIRECTORY TODIRECTORY])
|
||||
(CL:VALUES FROMDIR TODIR])
|
||||
|
||||
(IMPORTFONTS.NOCACHE
|
||||
[LAMBDA NIL (* ; "Edited 3-Mar-2026 11:54 by rmk")
|
||||
@@ -381,38 +401,43 @@
|
||||
(RESETSAVE \FONTSAVAILABLEFILECACHE NIL])
|
||||
|
||||
(IMPORTFONTS.DIRECTORY
|
||||
[LAMBDA (DEVICE DIRECTORY SUBDIR) (* ; "Edited 5-Apr-2026 14:17 by rmk")
|
||||
[LAMBDA (DEVICE DIRECTORY PHASE) (* ; "Edited 4-May-2026 00:52 by rmk")
|
||||
(* ; "Edited 5-Apr-2026 14:17 by rmk")
|
||||
(* ; "Edited 22-Mar-2026 22:59 by rmk")
|
||||
(* ; "Edited 21-Mar-2026 22:40 by rmk")
|
||||
(* ; "Edited 12-Mar-2026 09:35 by rmk")
|
||||
(* ; "Edited 9-Mar-2026 09:14 by rmk")
|
||||
(* ; "Edited 4-Mar-2026 00:46 by rmk")
|
||||
(CL:UNLESS (MEMB DIRECTORY '(DONT DON'T))
|
||||
[PSEUDOFILENAME (OR DIRECTORY (CONCAT MEDLEYDIR "internal>fonts>"
|
||||
(L-CASE (CONCAT (OR (if (type? FONTDESCRIPTOR DEVICE)
|
||||
then (FONTPROP DEVICE
|
||||
'DEVICE)
|
||||
elseif (type? FONTSPEC DEVICE)
|
||||
then (fetch (FONTSPEC FSDEVICE)
|
||||
of (\FONT.CHECKARGS
|
||||
DEVICE))
|
||||
elseif (NOT (LITATOM DEVICE))
|
||||
then (\ILLEGAL.ARG DEVICE)
|
||||
elseif DEVICE
|
||||
else 'DISPLAY))
|
||||
">"
|
||||
(CL:IF SUBDIR
|
||||
(CONCAT SUBDIR ">")
|
||||
"")])])
|
||||
[PSEUDOFILENAME (OR DIRECTORY
|
||||
(SELECTQ PHASE
|
||||
(DEPLOY (CONCAT [CAR (MKLIST (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES]
|
||||
">"))
|
||||
(CONCAT "{MEDLEY}<internal>fonts>"
|
||||
(L-CASE (CONCAT (OR (if (type? FONTDESCRIPTOR DEVICE)
|
||||
then (FONTPROP DEVICE 'DEVICE)
|
||||
elseif (type? FONTSPEC DEVICE)
|
||||
then (fetch (FONTSPEC FSDEVICE)
|
||||
of (\FONT.CHECKARGS DEVICE))
|
||||
elseif (NOT (LITATOM DEVICE))
|
||||
then (\ILLEGAL.ARG DEVICE)
|
||||
elseif DEVICE
|
||||
else 'DISPLAY))
|
||||
">"
|
||||
(CL:IF PHASE
|
||||
(CONCAT (IMPORTFONTS.SUBDIR PHASE)
|
||||
">")
|
||||
"")])])
|
||||
|
||||
(IMPORTFONTS.CLEAR
|
||||
[LAMBDA (PHASE FONTSPECS TODIRECTORY DEVICE) (* ; "Edited 4-Apr-2026 10:03 by rmk")
|
||||
[LAMBDA (PHASE FONTSPECS TODIR DEVICE) (* ; "Edited 3-May-2026 22:40 by rmk")
|
||||
(* ; "Edited 4-Apr-2026 10:03 by rmk")
|
||||
(* ; "Edited 3-Apr-2026 01:06 by rmk")
|
||||
(* ; "Edited 30-Mar-2026 12:37 by rmk")
|
||||
(* ; "Edited 23-Mar-2026 13:18 by rmk")
|
||||
(* ; "Edited 14-Mar-2026 22:51 by rmk")
|
||||
(* ; "Edited 12-Mar-2026 09:31 by rmk")
|
||||
(CL:WHEN [AND TODIRECTORY (MEMB PHASE '(COMPLETE FAKE] (* ;
|
||||
(CL:WHEN [AND TODIR (MEMB PHASE '(COMPLETE FAKE] (* ;
|
||||
"Previous completions could serve as inputs for later ones, start fresh.")
|
||||
(LET (NDELETED)
|
||||
[SETQ NDELETED (if FONTSPECS
|
||||
@@ -421,13 +446,11 @@
|
||||
FONTSPECS)
|
||||
sum (for FILE in (FILDIR (PACKFILENAME 'VERSION '*
|
||||
'BODY
|
||||
(MEDLEYFONT.FILENAME FS
|
||||
TODIRECTORY)))
|
||||
(MEDLEYFONT.FILENAME FS TODIR
|
||||
)))
|
||||
count (DELFILE FILE)))
|
||||
else (for FILE
|
||||
in [FILDIR (PACKFILENAME 'DIRECTORY TODIRECTORY 'NAME
|
||||
'*
|
||||
'VERSION
|
||||
in [FILDIR (PACKFILENAME 'DIRECTORY TODIR 'NAME '* 'VERSION
|
||||
'*
|
||||
'EXTENSION
|
||||
(CAR (MKLIST (FONTDEVICEPROP DEVICE
|
||||
@@ -438,32 +461,27 @@
|
||||
(1 "1 font")
|
||||
(CONCAT NDELETED " fonts"))
|
||||
" deleted from "
|
||||
(PSEUDOFILENAME TODIRECTORY)
|
||||
(PSEUDOFILENAME TODIR)
|
||||
T))))])
|
||||
|
||||
(IMPORTFONTS.SUBDIR
|
||||
[LAMBDA (PHASE FROMFLAG) (* ; "Edited 30-Mar-2026 16:27 by rmk")
|
||||
[LAMBDA (PHASE) (* ; "Edited 4-May-2026 00:27 by rmk")
|
||||
(* ; "Edited 30-Mar-2026 16:27 by rmk")
|
||||
(* ; "Edited 23-Mar-2026 13:18 by rmk")
|
||||
(* ; "Edited 21-Mar-2026 09:53 by rmk")
|
||||
(CL:IF FROMFLAG
|
||||
(SELECTQ PHASE
|
||||
(IMPORT "imported")
|
||||
(MCCS "imported")
|
||||
(COMPLETE "mccs")
|
||||
(FAKE "completed")
|
||||
(\ILLEGAL.ARG))
|
||||
(SELECTQ PHASE
|
||||
(SOURCE "source")
|
||||
(IMPORT "imported")
|
||||
(MCCS "mccs")
|
||||
(COMPLETE "completed")
|
||||
(FAKE "faked")
|
||||
(\ILLEGAL.ARG)))])
|
||||
(SELECTQ PHASE
|
||||
(SOURCE "source")
|
||||
(IMPORT "imported")
|
||||
(MCCS "mccs")
|
||||
(COMPLETE "completed")
|
||||
(FAKE "faked")
|
||||
(DEPLOY)
|
||||
(\ILLEGAL.ARG])
|
||||
|
||||
(IMPORTFONTS.DIRSIZE
|
||||
[LAMBDA (PHASE DEVICE DIRECTORY FROMFLAG) (* ; "Edited 30-Mar-2026 16:30 by rmk")
|
||||
(DIRECTORY (PACKFILENAME 'DIRECTORY (IMPORTFONTS.DIRECTORY DEVICE DIRECTORY (IMPORTFONTS.SUBDIR
|
||||
PHASE FROMFLAG))
|
||||
[LAMBDA (PHASE DEVICE DIRECTORY) (* ; "Edited 4-May-2026 00:26 by rmk")
|
||||
(* ; "Edited 30-Mar-2026 16:30 by rmk")
|
||||
(DIRECTORY (PACKFILENAME 'DIRECTORY (IMPORTFONTS.DIRECTORY DEVICE DIRECTORY PHASE)
|
||||
'NAME
|
||||
'*
|
||||
'EXTENSION
|
||||
@@ -475,57 +493,24 @@
|
||||
(DEFINEQ
|
||||
|
||||
(IMPORTFONTS.AVAILABLE
|
||||
[LAMBDA (PHASE FONTSPEC FROMDIRECTORY) (* ; "Edited 22-Mar-2026 13:36 by rmk")
|
||||
[LAMBDA (PHASE FONTSPEC FROMDIR) (* ; "Edited 4-May-2026 00:00 by rmk")
|
||||
(* ; "Edited 22-Mar-2026 13:36 by rmk")
|
||||
(RESETLST
|
||||
[RESETSAVE (FONTDEVICEPROP FONTSPEC 'FONTDIRECTORIES (IMPORTFONTS.DIRECTORY FONTSPEC
|
||||
FROMDIRECTORY (IMPORTFONTS.SUBDIR
|
||||
PHASE)))
|
||||
[RESETSAVE (FONTDEVICEPROP FONTSPEC 'FONTDIRECTORIES (IMPORTFONTS.DIRECTORY FONTSPEC FROMDIR
|
||||
PHASE))
|
||||
`(PROGN (FONTDEVICEPROP ',FONTSPEC 'FONTDIRECTORIES OLDVALUE]
|
||||
(IMPORTFONTS.NOCACHE)
|
||||
(FONTSAVAILABLE FONTSPEC NIL NIL NIL NIL 'ONLY))])
|
||||
|
||||
(IMPORTFONTS.EXISTS?
|
||||
[LAMBDA (PHASE FONTSPEC FROMDIRECTORY) (* ; "Edited 22-Mar-2026 14:55 by rmk")
|
||||
[LAMBDA (PHASE FONTSPEC FROMDIR) (* ; "Edited 4-May-2026 00:00 by rmk")
|
||||
(* ; "Edited 22-Mar-2026 14:55 by rmk")
|
||||
(RESETLST
|
||||
[RESETSAVE (FONTDEVICEPROP FONTSPEC 'FONTDIRECTORIES (IMPORTFONTS.DIRECTORY FONTSPEC
|
||||
FROMDIRECTORY (IMPORTFONTS.SUBDIR
|
||||
PHASE)))
|
||||
[RESETSAVE (FONTDEVICEPROP FONTSPEC 'FONTDIRECTORIES (IMPORTFONTS.DIRECTORY FONTSPEC FROMDIR
|
||||
PHASE))
|
||||
`(PROGN (FONTDEVICEPROP ',FONTSPEC 'FONTDIRECTORIES OLDVALUE]
|
||||
(IMPORTFONTS.NOCACHE)
|
||||
(FONTEXISTS? FONTSPEC NIL NIL NIL NIL T))])
|
||||
|
||||
(IMPORTFONTS.DEPLOY
|
||||
[LAMBDA (PHASE FONTSPECS DEVICE FROMDIRECTORY TODIRECTORY) (* ; "Edited 30-Mar-2026 12:39 by rmk")
|
||||
(* ; "Edited 23-Mar-2026 13:18 by rmk")
|
||||
|
||||
(* ;; "Copies the FONTSPECS fonts from the FROMDIRECTOY to the TODIRECTORY, defaulting to the PHASE from directory and the (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES)), replacing what's there.")
|
||||
|
||||
(* ;;
|
||||
"Implicitly copies all of the indirect targets fonts of the fonts in FONTSPEC, recursively.")
|
||||
|
||||
(CL:UNLESS PHASE
|
||||
(SETQ PHASE 'FAKE))
|
||||
(CL:UNLESS DEVICE
|
||||
(SETQ DEVICE 'DISPLAY))
|
||||
(SETQ FROMDIRECTORY (IMPORTFONTS.DIRECTORY DEVICE FROMDIRECTORY (IMPORTFONTS.SUBDIR PHASE)))
|
||||
(CL:UNLESS TODIRECTORY
|
||||
[SETQ TODIRECTORY (PSEUDOFILENAME (CAR (MKLIST (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES])
|
||||
(LET ((FONTSPECS (IMPORTFONTS.FONTSPECS PHASE FONTSPECS NIL DEVICE)))
|
||||
(SETQ FONTSPECS (CL:REMOVE-DUPLICATES (APPEND (for FS FONT in FONTSPECS
|
||||
join (MEDLEYFONT.GETFILEPROP (
|
||||
MEDLEYFONT.FILENAME
|
||||
FS
|
||||
FROMDIRECTORY
|
||||
)
|
||||
'INDIRECTS))
|
||||
FONTSPECS)
|
||||
:TEST
|
||||
(FUNCTION EQUAL)))
|
||||
(for FS (N ← 0) in FONTSPECS do (COPYFILE (MEDLEYFONT.FILENAME FS FROMDIRECTORY)
|
||||
(MEDLEYFONT.FILENAME FS TODIRECTORY))
|
||||
(FLUSHFONTCACHE NIL FS)
|
||||
(add N 1)
|
||||
finally (PRINTOUT T N " fonts copied from " FROMDIRECTORY " to " TODIRECTORY T])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -578,39 +563,41 @@
|
||||
CHANGED])
|
||||
|
||||
(FAKEFACE.FROMFILE
|
||||
[LAMBDA (FONTSPEC FROMDIRECTORY) (* ; "Edited 4-Apr-2026 09:42 by rmk")
|
||||
[LAMBDA (FONTSPEC FROMDIR) (* ; "Edited 3-May-2026 22:37 by rmk")
|
||||
(* ; "Edited 4-Apr-2026 09:42 by rmk")
|
||||
(* ; "Edited 30-Mar-2026 23:17 by rmk")
|
||||
(* ; "Edited 21-Mar-2026 09:03 by rmk")
|
||||
(* ; "Edited 19-Mar-2026 11:53 by rmk")
|
||||
(* ;
|
||||
"Start with MRR for a face that doesn't yet exist (HELVETICA MIR).")
|
||||
(OR (INFILEP (MEDLEYFONT.FILENAME FONTSPEC FROMDIRECTORY))
|
||||
(OR (INFILEP (MEDLEYFONT.FILENAME FONTSPEC FROMDIR))
|
||||
(LET ((FACE (fetch (FONTSPEC FSFACE) of FONTSPEC)))
|
||||
(OR (AND (EQ 'BOLD (fetch (FONTFACE WEIGHT) of FACE))
|
||||
(INFILEP (MEDLEYFONT.FILENAME (create FONTSPEC using FONTSPEC FSFACE ←
|
||||
(MAKEFONTFACE 'MEDIUM NIL
|
||||
NIL FACE))
|
||||
FROMDIRECTORY)))
|
||||
FROMDIR)))
|
||||
(AND (EQ 'ITALIC (fetch (FONTFACE SLOPE) of FACE))
|
||||
(FAKEFACE.FROMFILE (create FONTSPEC using FONTSPEC FSFACE ← (MAKEFONTFACE
|
||||
NIL
|
||||
'REGULAR NIL FACE)
|
||||
)
|
||||
FROMDIRECTORY))
|
||||
FROMDIR))
|
||||
(AND (EQ 'COMPRESSED (fetch (FONTFACE EXPANSION) of FACE))
|
||||
(FAKEFACE.FROMFILE (create FONTSPEC using FONTSPEC FSFACE ← (MAKEFONTFACE
|
||||
NIL NIL
|
||||
'REGULAR FACE))
|
||||
FROMDIRECTORY))
|
||||
FROMDIR))
|
||||
(ERROR "No source for face-faking" FONTSPEC])
|
||||
|
||||
(FAKEFACE.FROMFONT
|
||||
[LAMBDA (FONTSPEC FROMDIRECTORY) (* ; "Edited 19-Mar-2026 20:42 by rmk")
|
||||
[LAMBDA (FONTSPEC FROMDIR) (* ; "Edited 3-May-2026 22:37 by rmk")
|
||||
(* ; "Edited 19-Mar-2026 20:42 by rmk")
|
||||
|
||||
(* ;; "If FONTSPEC doesn't identifyan existing font that needs to be coerced, we create an empty starting font full of slug charsets. ")
|
||||
|
||||
(LET (FROMFILE FONT)
|
||||
(SETQ FROMFILE (FAKEFACE.FROMFILE FONTSPEC FROMDIRECTORY))
|
||||
(SETQ FROMFILE (FAKEFACE.FROMFILE FONTSPEC FROMDIR))
|
||||
(SETQ FONT (MEDLEYFONT.READ.FONT FROMFILE 'ALL))
|
||||
(CL:UNLESS (EQUAL FONTSPEC (FONTPROP FONT 'SPEC))
|
||||
|
||||
@@ -619,55 +606,6 @@
|
||||
(SETQ FONT (FONTCREATE.SLUGFD FONTSPEC FONT)))
|
||||
(CL:VALUES FONT FROMFILE])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(IMPORTFONTS.PHASES
|
||||
[LAMBDA (PHASES DEVICE FONTSPECS FROMDIRECTORY TODIRECTORY)(* ; "Edited 24-Mar-2026 11:00 by rmk")
|
||||
(* ; "Edited 23-Mar-2026 00:45 by rmk")
|
||||
(TDRIBBLE)
|
||||
(PROG1 (for P inside PHASES do (if (EQ P 'DEPLOY)
|
||||
then (IMPORTFONTS.DEPLOY 'FAKE FONTSPECS DEVICE FROMDIRECTORY
|
||||
TODIRECTORY)
|
||||
else (IMPORTFONTS P FONTSPECS DEVICE FROMDIRECTORY TODIRECTORY
|
||||
NIL T)
|
||||
(TERPRI T)))
|
||||
(DRIBBLE])
|
||||
|
||||
(MISSINGFACE
|
||||
[LAMBDA (DIRECTORY) (* ; "Edited 30-Mar-2026 23:06 by rmk")
|
||||
(* ; "Edited 26-Mar-2026 12:13 by rmk")
|
||||
(* ; "Edited 25-Mar-2026 00:59 by rmk")
|
||||
(LET [MRRS MIRS BRRS BIRS OTHERS (FAMILIESOFINTEREST
|
||||
(CL:REMOVE-DUPLICATES (APPEND ALTOFONTFAMILIES NSFONTFAMILIES
|
||||
(for C
|
||||
in (FONTDEVICEPROP 'DISPLAY
|
||||
'CHARCOERCIONS)
|
||||
when (LITATOM (CAR C))
|
||||
collect (CAR C]
|
||||
(for FS FACE in (for F FONTSPEC in (FILDIR (PACKFILENAME 'BODY DIRECTORY 'BODY
|
||||
'*-*.MEDLEYDISPLAYFONT))
|
||||
eachtime (SETQ FONTSPEC (FONTSPECFROMFILENAME F))
|
||||
when (MEMB (fetch (FONTSPEC FSFAMILY) of FONTSPEC)
|
||||
FAMILIESOFINTEREST) collect (FONTSPECFROMFILENAME F))
|
||||
do (SETQ FACE (fetch (FONTSPEC FSFACE) of FS))
|
||||
(replace (FONTSPEC FSFACE) of FS with 'FACE)
|
||||
(SELECTQ (FONTFACETOATOM FACE)
|
||||
(MRR (push MRRS FS))
|
||||
(MIR (push MIRS FS))
|
||||
(BRR (push BRRS FS))
|
||||
(BIR (push BIRS FS))
|
||||
(push OTHERS FS)))
|
||||
(for MRR NEEDED in MRRS do (CL:UNLESS (MEMBER MRR MIRS)
|
||||
(push NEEDED (SUBST '(MEDIUM ITALIC REGULAR)
|
||||
'FACE MRR)))
|
||||
(CL:UNLESS (MEMBER MRR BRRS)
|
||||
(push NEEDED (SUBST '(BOLD REGULAR REGULAR)
|
||||
'FACE MRR)))
|
||||
(CL:UNLESS (MEMBER MRR BIRS)
|
||||
(push NEEDED (SUBST '(BOLD ITALIC REGULAR)
|
||||
'FACE MRR)))
|
||||
finally (RETURN (SORTFONTSPECS NEEDED])
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -676,29 +614,32 @@
|
||||
(DEFINEQ
|
||||
|
||||
(IMPORT.DISPLAY
|
||||
[LAMBDA (FONTSPECS NODRIBBLE) (* ; "Edited 28-Mar-2026 23:08 by rmk")
|
||||
[LAMBDA (FONTSPECS) (* ; "Edited 4-May-2026 15:18 by rmk")
|
||||
(* ; "Edited 28-Mar-2026 23:08 by rmk")
|
||||
(* ; "Edited 18-Mar-2026 23:54 by rmk")
|
||||
(IMPORTFONTS 'IMPORT FONTSPECS 'DISPLAY NIL NIL (FUNCTION LEGACYDISPLAYFONT])
|
||||
(IMPORTFONTS 'IMPORT FONTSPECS 'DISPLAY '{MEDLEY}/fonts/displayfonts/ NIL (FUNCTION
|
||||
LEGACYDISPLAYFONT])
|
||||
|
||||
(LEGACYDISPLAYFONT
|
||||
[LAMBDA (FONTSPEC FROMDIRECTORY) (* ; "Edited 16-Apr-2026 22:37 by rmk")
|
||||
[LAMBDA (FONTSPEC FROMDIR) (* ; "Edited 3-May-2026 22:38 by rmk")
|
||||
(* ; "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")
|
||||
(* ;; "Loads legacy display fonts (ac or strike format, gacha, terminal, helevetica...) from FROMDIR. If NIL, the current directory")
|
||||
|
||||
(SETQ FONTSPEC (\FONT.CHECKARGS FONTSPEC NIL NIL NIL 'DISPLAY T))
|
||||
(RESETLST
|
||||
[RESETSAVE (FONTDEVICEPROP 'DISPLAY 'FONTDIRECTORIES FROMDIRECTORY)
|
||||
[RESETSAVE (FONTDEVICEPROP 'DISPLAY 'FONTDIRECTORIES FROMDIR)
|
||||
`(PROGN (FONTDEVICEPROP 'DISPLAY 'FONTDIRECTORIES OLDVALUE]
|
||||
[RESETSAVE (FONTDEVICEPROP 'DISPLAY 'FONTEXTENSIONS '(DISPLAYFONT)
|
||||
FROMDIRECTORY)
|
||||
FROMDIR)
|
||||
`(PROGN (FONTDEVICEPROP 'DISPLAY 'FONTEXTENSIONS OLDVALUE]
|
||||
(for CSNO CSINFO (FONT ← (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC 255)) from 0 to 255
|
||||
do (SETQ CSINFO (\READCHARSET FONT CSNO '((AC ACFONT.FILEP ACFONT.GETCHARSET)
|
||||
(STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET))
|
||||
FROMDIRECTORY))
|
||||
FROMDIR))
|
||||
|
||||
(* ;; "NIL means empty")
|
||||
|
||||
@@ -716,18 +657,19 @@
|
||||
(DEFINEQ
|
||||
|
||||
(IPF
|
||||
[LAMBDA (PHASE FONTSPEC) (* ; "Edited 30-Mar-2026 12:44 by rmk")
|
||||
[LAMBDA (PHASE FONTSPEC) (* ; "Edited 4-May-2026 00:01 by rmk")
|
||||
(* ; "Edited 30-Mar-2026 12:44 by rmk")
|
||||
(* ; "Edited 21-Mar-2026 22:46 by rmk")
|
||||
(* ; "Edited 10-Mar-2026 00:54 by rmk")
|
||||
(MEDLEYFONT.READ.FONT (MEDLEYFONT.FILENAME FONTSPEC (IMPORTFONTS.DIRECTORY
|
||||
(OR (fetch (FONTSPEC FSDEVICE) of FONTSPEC)
|
||||
'DISPLAY)
|
||||
NIL
|
||||
(IMPORTFONTS.SUBDIR PHASE)))
|
||||
NIL PHASE))
|
||||
'ALL])
|
||||
|
||||
(IPFSIZES
|
||||
[LAMBDA (FONTSPEC) (* ; "Edited 30-Mar-2026 12:45 by rmk")
|
||||
[LAMBDA (FONTSPEC) (* ; "Edited 4-May-2026 00:49 by rmk")
|
||||
(* ; "Edited 30-Mar-2026 12:45 by rmk")
|
||||
(* ; "Edited 23-Mar-2026 13:18 by rmk")
|
||||
(* ; "Edited 21-Mar-2026 00:59 by rmk")
|
||||
(* ; "Edited 16-Mar-2026 08:43 by rmk")
|
||||
@@ -738,8 +680,8 @@
|
||||
(if (type? FONTSPEC FONTSPEC)
|
||||
then (SETQ FONTSPEC (\FONT.CHECKARGS FONTSPEC NIL NIL NIL NIL T))
|
||||
else (SETQ FONTSPEC (FONTSPECFROMFILENAME FONTSPEC)))
|
||||
(for PHASE DIR FONTFILE SIZE LASTSIZE in '(IMPORT MCCS COMPLETE FAKE)
|
||||
eachtime (SETQ DIR (IMPORTFONTS.DIRECTORY FONTSPEC NIL (IMPORTFONTS.SUBDIR PHASE)))
|
||||
(for PHASE DIR FONTFILE SIZE LASTSIZE in '(IMPORT MCCS COMPLETE FAKE DEPLOY)
|
||||
eachtime (SETQ DIR (IMPORTFONTS.DIRECTORY FONTSPEC NIL PHASE))
|
||||
when (SETQ FONTFILE (INFILEP (MEDLEYFONT.FILENAME FONTSPEC DIR)))
|
||||
collect (SETQ FONTFILE (INFILEP (MEDLEYFONT.FILENAME FONTSPEC DIR)))
|
||||
[SETQ SIZE (CL:IF FONTFILE
|
||||
@@ -751,7 +693,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(PEF
|
||||
[LAMBDA (PHASE FONTSPEC CHARSET DIRECTORY) (* ; "Edited 12-Apr-2026 19:32 by rmk")
|
||||
[LAMBDA (PHASES FONTSPEC CHARSET) (* ; "Edited 4-May-2026 08:27 by rmk")
|
||||
(* ; "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")
|
||||
@@ -760,81 +703,97 @@
|
||||
(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)
|
||||
(for PHASE TITLETAG CHARSETNAME DIR FONTFILE inside PHASES
|
||||
do (* ;
|
||||
"Some phases may not have some charsets")
|
||||
(SETQ CHARSET (if (EQ CHARSET T)
|
||||
then (for C in (MEDLEYFONT.GETFILEPROP FONTFILE 'CHARSETS)
|
||||
then (for C in (MEDLEYFONT.GETFILEPROP FONTFILE 'CHARSET)
|
||||
unless (OR (KANJICHARSETP C)
|
||||
(CHINESECHARSETP C)) collect C)
|
||||
(UNIHANCHARSETP 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))
|
||||
(CL:UNLESS (OCTALNUM? CHARSETNAME)
|
||||
(SETQ TITLETAG (CONCAT CHARSETNAME " " TITLETAG)))
|
||||
(if [CAR (NLSETQ (RESETLST
|
||||
(IMPORTFONTS.CONTEXT PHASE DIR NIL (fetch (FONTSPEC FSDEVICE)
|
||||
of FONTSPEC))
|
||||
(EDITFONT FONTFILE CHARSET NIL NIL TITLETAG))]
|
||||
else (PRINTOUT T "Charset " (OCTALSTRING CHARSET)
|
||||
" of " FONTSPEC " not found in " DIR T)
|
||||
NIL)
|
||||
else (PRINTOUT T FONTSPEC " not found in " DIR T])
|
||||
then (for C in CHARSET do (PEF PHASE FONTSPEC C))
|
||||
elseif (EQ PHASE 'DEPLOY)
|
||||
then (EDITFONT FONTSPEC CHARSET NIL NIL "Deployed")
|
||||
else (SETQ DIR (IMPORTFONTS.DIRECTORY FONTSPEC NIL PHASE))
|
||||
(SETQ FONTFILE (MEDLEYFONT.FILENAME FONTSPEC DIR))
|
||||
(if (NLSETQ (MEDLEYFONT.FILEP FONTFILE))
|
||||
then (SETQ TITLETAG (CL:IF (EQ PHASE 'MCCS)
|
||||
'MCCS
|
||||
(L-CASE PHASE T)))
|
||||
(SETQ CHARSETNAME (CHARSET.ENCODE CHARSET))
|
||||
(CL:UNLESS (OCTALNUM? CHARSETNAME)
|
||||
(SETQ TITLETAG (CONCAT CHARSETNAME " " TITLETAG)))
|
||||
(if [CAR (NLSETQ (RESETLST
|
||||
(IMPORTFONTS.CONTEXT PHASE DIR NIL (fetch (FONTSPEC
|
||||
FSDEVICE)
|
||||
of FONTSPEC))
|
||||
(EDITFONT FONTFILE CHARSET NIL NIL TITLETAG))]
|
||||
else (PRINTOUT T "Charset " (OCTALSTRING CHARSET)
|
||||
" of " FONTSPEC " not found in " DIR T)
|
||||
NIL)
|
||||
else (PRINTOUT T FONTSPEC " not found in " DIR T])
|
||||
|
||||
(AEF
|
||||
[LAMBDA (FONTSPEC CHARSET CLOSE) (* ; "Edited 5-Apr-2026 11:50 by rmk")
|
||||
[LAMBDA (FONTSPEC CHARSET CLOSE) (* ; "Edited 4-May-2026 08:22 by rmk")
|
||||
(* ; "Edited 5-Apr-2026 11:50 by rmk")
|
||||
(* ; "Edited 21-Mar-2026 15:09 by rmk")
|
||||
(* ; "Edited 14-Mar-2026 12:59 by rmk")
|
||||
(* ; "Edited 12-Mar-2026 22:56 by rmk")
|
||||
|
||||
(* ;; "Shows CHARSET for all phases of FONTSPEC")
|
||||
(* ;; "Show CHARSET for all phases of FONTSPEC")
|
||||
|
||||
(CL:WHEN CLOSE (EFCLOSE))
|
||||
(LIST (IEF FONTSPEC CHARSET)
|
||||
(MEF FONTSPEC CHARSET)
|
||||
(CEF FONTSPEC CHARSET)
|
||||
(FEF FONTSPEC CHARSET)
|
||||
(EDITFONT FONTSPEC CHARSET NIL NIL "Deployed"])
|
||||
(PEF '(IMPORT MCCS COMPLETE FAKE DEPLOY)
|
||||
FONTSPEC CHARSET])
|
||||
|
||||
(IEF
|
||||
[LAMBDA (FONTSPEC CHARSET DIRECTORY) (* ; "Edited 12-Mar-2026 11:38 by rmk")
|
||||
[LAMBDA (FONTSPEC CHARSET) (* ; "Edited 4-May-2026 08:34 by rmk")
|
||||
(* ; "Edited 12-Mar-2026 11:38 by rmk")
|
||||
(* ; "Edited 10-Mar-2026 01:02 by rmk")
|
||||
(* ; "Edited 4-Mar-2026 00:31 by rmk")
|
||||
(* ; "Edited 1-Mar-2026 23:56 by rmk")
|
||||
(* ; "Edited 27-Feb-2026 14:24 by rmk")
|
||||
(PEF 'IMPORT FONTSPEC CHARSET DIRECTORY])
|
||||
(PEF 'IMPORT FONTSPEC CHARSET])
|
||||
|
||||
(MEF
|
||||
[LAMBDA (FONTSPEC CHARSET DIRECTORY) (* ; "Edited 12-Mar-2026 11:38 by rmk")
|
||||
[LAMBDA (FONTSPEC CHARSET) (* ; "Edited 4-May-2026 08:35 by rmk")
|
||||
(* ; "Edited 12-Mar-2026 11:38 by rmk")
|
||||
(* ; "Edited 10-Mar-2026 01:01 by rmk")
|
||||
(* ; "Edited 4-Mar-2026 00:31 by rmk")
|
||||
(* ; "Edited 1-Mar-2026 23:57 by rmk")
|
||||
(* ; "Edited 9-Oct-2025 20:38 by rmk")
|
||||
(PEF 'MCCS FONTSPEC CHARSET DIRECTORY])
|
||||
(PEF 'MCCS FONTSPEC CHARSET])
|
||||
|
||||
(CEF
|
||||
[LAMBDA (FONTSPEC CHARSET DIRECTORY) (* ; "Edited 12-Mar-2026 11:38 by rmk")
|
||||
[LAMBDA (FONTSPEC CHARSET) (* ; "Edited 4-May-2026 08:35 by rmk")
|
||||
(* ; "Edited 12-Mar-2026 11:38 by rmk")
|
||||
(* ; "Edited 10-Mar-2026 01:03 by rmk")
|
||||
(* ; "Edited 4-Mar-2026 00:31 by rmk")
|
||||
(* ; "Edited 2-Mar-2026 00:00 by rmk")
|
||||
(* ; "Edited 9-Oct-2025 22:58 by rmk")
|
||||
(PEF 'COMPLETE FONTSPEC CHARSET DIRECTORY])
|
||||
(PEF 'COMPLETE FONTSPEC CHARSET])
|
||||
|
||||
(FEF
|
||||
[LAMBDA (FONTSPEC CHARSET DIRECTORY) (* ; "Edited 23-Mar-2026 13:18 by rmk")
|
||||
[LAMBDA (FONTSPEC CHARSET) (* ; "Edited 4-May-2026 08:35 by rmk")
|
||||
(* ; "Edited 23-Mar-2026 13:18 by rmk")
|
||||
(* ; "Edited 19-Mar-2026 00:42 by rmk")
|
||||
(* ; "Edited 12-Mar-2026 11:38 by rmk")
|
||||
(* ; "Edited 10-Mar-2026 01:03 by rmk")
|
||||
(* ; "Edited 4-Mar-2026 00:31 by rmk")
|
||||
(* ; "Edited 2-Mar-2026 00:00 by rmk")
|
||||
(* ; "Edited 9-Oct-2025 22:58 by rmk")
|
||||
(PEF 'FAKE FONTSPEC CHARSET DIRECTORY])
|
||||
(PEF 'FAKE FONTSPEC CHARSET])
|
||||
|
||||
(DEF
|
||||
[LAMBDA (FONTSPEC CHARSET) (* ; "Edited 4-May-2026 08:34 by rmk")
|
||||
(* ; "Edited 12-Mar-2026 11:38 by rmk")
|
||||
(* ; "Edited 10-Mar-2026 01:02 by rmk")
|
||||
(* ; "Edited 4-Mar-2026 00:31 by rmk")
|
||||
(* ; "Edited 1-Mar-2026 23:56 by rmk")
|
||||
(* ; "Edited 27-Feb-2026 14:24 by rmk")
|
||||
(PEF 'DEPLOY FONTSPEC CHARSET])
|
||||
|
||||
(EFCLOSE
|
||||
[LAMBDA NIL (* ; "Edited 9-Oct-2025 19:48 by rmk")
|
||||
@@ -903,15 +862,14 @@
|
||||
|
||||
(FILESLOAD EDITFONT)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(FILEMAP (NIL (1127 33864 (IMPORTFONTS 1137 . 13084) (FONT.TO.MCCS 13086 . 15336) (
|
||||
IMPORTFONTS.FONTSPECS 15338 . 23733) (IMPORTFONTS.CONTEXT 23735 . 27444) (IMPORTFONTS.NOCACHE 27446 .
|
||||
27697) (IMPORTFONTS.DIRECTORY 27699 . 30050) (IMPORTFONTS.CLEAR 30052 . 32598) (IMPORTFONTS.SUBDIR
|
||||
32600 . 33249) (IMPORTFONTS.DIRSIZE 33251 . 33862)) (33865 35088 (IMPORTFONTS.AVAILABLE 33875 . 34484)
|
||||
(IMPORTFONTS.EXISTS? 34486 . 35086)) (35089 41872 (FAKEFACE 35099 . 38836) (FAKEFACE.FROMFILE 38838
|
||||
. 41079) (FAKEFACE.FROMFONT 41081 . 41870)) (41916 44162 (IMPORT.DISPLAY 41926 . 42464) (
|
||||
LEGACYDISPLAYFONT 42466 . 44160)) (44211 46543 (IPF 44221 . 45015) (IPFSIZES 45017 . 46541)) (46544
|
||||
54470 (PEF 46554 . 49729) (AEF 49731 . 50454) (IEF 50456 . 51158) (MEF 51160 . 51860) (CEF 51862 .
|
||||
52566) (FEF 52568 . 53486) (DEF 53488 . 54190) (EFCLOSE 54192 . 54468)) (54471 58018 (SHOWCHARS 54481
|
||||
. 56511) (CSSOURCE 56513 . 57226) (FONTDEFFONTS 57228 . 58016)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
BIN
library/IMPORTFONTS.TEDIT
Normal file
BIN
library/IMPORTFONTS.TEDIT
Normal file
Binary file not shown.
85
sources/FONT
85
sources/FONT
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED "26-Apr-2026 10:58:52" {MEDLEY}<sources>FONT.;795 260182
|
||||
(FILECREATED " 4-May-2026 12:39:02" {MEDLEY}<sources>FONT.;796 260358
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS FONTCOMS)
|
||||
:CHANGES-TO (FNS MAKEFONTSPEC)
|
||||
|
||||
:PREVIOUS-DATE "19-Apr-2026 09:55:01" {MEDLEY}<sources>FONT.;792)
|
||||
:PREVIOUS-DATE "26-Apr-2026 10:58:52" {MEDLEY}<sources>FONT.;795)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FONTCOMS)
|
||||
@@ -941,7 +941,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MAKEFONTSPEC
|
||||
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE BASE) (* ; "Edited 15-Apr-2026 00:25 by rmk")
|
||||
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE BASE) (* ; "Edited 4-May-2026 12:38 by rmk")
|
||||
(* ; "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")
|
||||
@@ -950,6 +951,8 @@
|
||||
|
||||
(* ;; "BASE (fontspec or font) provides defaults for NIL arguments, essentialy models a (create using BASE...)")
|
||||
|
||||
(CL:WHEN (LISTP FAMILY)
|
||||
(SPREADFONTSPEC FAMILY))
|
||||
(CL:WHEN FACE
|
||||
(SETQ FACE (\FONTFACE FACE)))
|
||||
(create FONTSPEC
|
||||
@@ -4115,41 +4118,41 @@
|
||||
(ADDTOVAR LAMA FONTCOPY FONTDEVICEPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6602 16269 (CHARWIDTH 6612 . 7401) (CHARWIDTHY 7403 . 8920) (STRINGWIDTH 8922 . 9959) (
|
||||
\CHARWIDTH.DISPLAY 9961 . 10376) (\STRINGWIDTH.DISPLAY 10378 . 10806) (\STRINGWIDTH.GENERIC 10808 .
|
||||
16267)) (16270 22902 (DEFAULTFONT 16280 . 17565) (FONTCLASS 17567 . 19839) (FONTCLASSUNPARSE 19841 .
|
||||
20742) (FONTCLASSCOMPONENT 20744 . 21332) (SETFONTCLASSCOMPONENT 21334 . 21776) (GETFONTCLASSCOMPONENT
|
||||
21778 . 22900)) (24350 44252 (FONTCREATE 24360 . 27605) (FONTCREATE1 27607 . 30266) (
|
||||
FONTCREATE.SLUGFD 30268 . 32832) (\FONT.CHECKARGS1 32834 . 37539) (\FONTCREATE1.NOFN 37541 . 37755) (
|
||||
FONTFILEP 37757 . 38645) (\READCHARSET 38647 . 43832) (FONTCHARSETS 43834 . 44250)) (44253 51329 (
|
||||
\FONT.CHECKARGS 44263 . 51012) (\CHARSET.CHECK 51014 . 51327)) (51330 57690 (COERCEFONTSPEC 51340 .
|
||||
57001) (COERCEFONTSPEC.TARGETFACE 57003 . 57688)) (59885 63007 (MAKEFONTSPEC 59895 . 61375) (
|
||||
FONTSPEC.TO.FONTDESCRIPTOR 61377 . 63005)) (63008 72670 (COMPLETE.FONT 63018 . 65043) (COMPLETEFONTP
|
||||
65045 . 65783) (COMPLETE.CHARSET 65785 . 69851) (PRUNESLUGCSINFOS 69853 . 71164) (MONOSPACEFONTP 71166
|
||||
. 72668)) (72709 82523 (FONTASCENT 72719 . 73103) (FONTDESCENT 73105 . 73590) (FONTHEIGHT 73592 .
|
||||
73994) (FONTPROP 73996 . 81800) (\AVGCHARWIDTH 81802 . 82521)) (83271 85141 (FONTDEVICEPROP 83281 .
|
||||
85139)) (85258 86112 (EDITCHAR 85268 . 86110)) (86158 98348 (GETCHARBITMAP 86168 . 87292) (
|
||||
PUTCHARBITMAP 87294 . 89452) (\GETCHARBITMAP.CSINFO 89454 . 91470) (\PUTCHARBITMAP.CSINFO 91472 .
|
||||
98346)) (98349 120690 (MOVECHARBITMAP 98359 . 100253) (MOVEFONTCHARS 100255 . 105405) (\MOVEFONTCHAR
|
||||
105407 . 110279) (\MOVEFONTCHARS.SOURCEDATA 110281 . 117036) (\MAKESLUGCHAR 117038 . 119573) (
|
||||
SLUGCHARP 119575 . 120688)) (121605 134859 (FONTFILES 121615 . 124654) (\FINDFONTFILE 124656 . 126633)
|
||||
(\FONTFILENAMES 126635 . 127195) (\FONTFILENAME 127197 . 130307) (FONTSPECFROMFILENAME 130309 .
|
||||
134857)) (134860 171193 (FONTCOPY 134870 . 139953) (FONTP 139955 . 140254) (FONTUNPARSE 140256 .
|
||||
141979) (SETFONTDESCRIPTOR 141981 . 143445) (\STREAMCHARWIDTH 143447 . 147458) (\COERCECHARSET 147460
|
||||
. 150849) (\BUILDSLUGCSINFO 150851 . 154544) (\FONTSYMBOL 154546 . 155200) (\DEVICESYMBOL 155202 .
|
||||
155986) (\FONTFACE 155988 . 163192) (\FONTFACE.COLOR 163194 . 169976) (SETFONTCHARENCODING 169978 .
|
||||
171191)) (171194 192052 (FONTSAVAILABLE 171204 . 176568) (FONTEXISTS? 176570 . 180378) (
|
||||
\SEARCHFONTFILES 180380 . 183594) (FLUSHFONTCACHE 183596 . 186127) (FINDFONTFILES 186129 . 189345) (
|
||||
SORTFONTSPECS 189347 . 192050)) (192053 197591 (MATCHFONTFACE 192063 . 193138) (MAKEFONTFACE 193140 .
|
||||
194174) (FONTFACETOATOM 194176 . 196426) (FONTFACE.STARS 196428 . 197589)) (198222 198714 (
|
||||
\UNITWIDTHSVECTOR 198232 . 198712)) (215635 217702 (FONTDESCRIPTOR.DEFPRINT 215645 . 217224) (
|
||||
FONTCLASS.DEFPRINT 217226 . 217700)) (221624 224414 (\CREATEKERNELEMENT 221634 . 221992) (
|
||||
\FSETLEFTKERN 221994 . 222485) (\FGETLEFTKERN 222487 . 224412)) (224415 235569 (\CREATEFONT 224425 .
|
||||
228033) (\CREATECHARSET 228035 . 231320) (\INSTALLCHARSETINFO 231322 . 234656) (
|
||||
\INSTALLCHARSETINFO.CHARENCODING 234658 . 235567)) (235891 237259 (\FONTRESETCHARWIDTHS 235901 .
|
||||
237257)) (237782 245640 (\CREATEDISPLAYFONT 237792 . 239699) (\CREATECHARSET.DISPLAY 239701 . 243225)
|
||||
(\FONTEXISTS?.DISPLAY 243227 . 245638)) (245641 254019 (FAKEFACE.CHARSET 245651 . 249713) (
|
||||
MAKEBOLD.CHAR 249715 . 251568) (MAKEITALIC.CHAR 251570 . 254017)) (254050 258305 (\SFROTATECSINFO
|
||||
254060 . 256202) (\SFROTATEFONTCHARACTERS 256204 . 256588) (\SFROTATECSINFOOFFSETS 256590 . 258303)) (
|
||||
258306 259480 (\SFMAKECOLOR 258316 . 259478)))))
|
||||
(FILEMAP (NIL (6605 16272 (CHARWIDTH 6615 . 7404) (CHARWIDTHY 7406 . 8923) (STRINGWIDTH 8925 . 9962) (
|
||||
\CHARWIDTH.DISPLAY 9964 . 10379) (\STRINGWIDTH.DISPLAY 10381 . 10809) (\STRINGWIDTH.GENERIC 10811 .
|
||||
16270)) (16273 22905 (DEFAULTFONT 16283 . 17568) (FONTCLASS 17570 . 19842) (FONTCLASSUNPARSE 19844 .
|
||||
20745) (FONTCLASSCOMPONENT 20747 . 21335) (SETFONTCLASSCOMPONENT 21337 . 21779) (GETFONTCLASSCOMPONENT
|
||||
21781 . 22903)) (24353 44255 (FONTCREATE 24363 . 27608) (FONTCREATE1 27610 . 30269) (
|
||||
FONTCREATE.SLUGFD 30271 . 32835) (\FONT.CHECKARGS1 32837 . 37542) (\FONTCREATE1.NOFN 37544 . 37758) (
|
||||
FONTFILEP 37760 . 38648) (\READCHARSET 38650 . 43835) (FONTCHARSETS 43837 . 44253)) (44256 51332 (
|
||||
\FONT.CHECKARGS 44266 . 51015) (\CHARSET.CHECK 51017 . 51330)) (51333 57693 (COERCEFONTSPEC 51343 .
|
||||
57004) (COERCEFONTSPEC.TARGETFACE 57006 . 57691)) (59888 63183 (MAKEFONTSPEC 59898 . 61551) (
|
||||
FONTSPEC.TO.FONTDESCRIPTOR 61553 . 63181)) (63184 72846 (COMPLETE.FONT 63194 . 65219) (COMPLETEFONTP
|
||||
65221 . 65959) (COMPLETE.CHARSET 65961 . 70027) (PRUNESLUGCSINFOS 70029 . 71340) (MONOSPACEFONTP 71342
|
||||
. 72844)) (72885 82699 (FONTASCENT 72895 . 73279) (FONTDESCENT 73281 . 73766) (FONTHEIGHT 73768 .
|
||||
74170) (FONTPROP 74172 . 81976) (\AVGCHARWIDTH 81978 . 82697)) (83447 85317 (FONTDEVICEPROP 83457 .
|
||||
85315)) (85434 86288 (EDITCHAR 85444 . 86286)) (86334 98524 (GETCHARBITMAP 86344 . 87468) (
|
||||
PUTCHARBITMAP 87470 . 89628) (\GETCHARBITMAP.CSINFO 89630 . 91646) (\PUTCHARBITMAP.CSINFO 91648 .
|
||||
98522)) (98525 120866 (MOVECHARBITMAP 98535 . 100429) (MOVEFONTCHARS 100431 . 105581) (\MOVEFONTCHAR
|
||||
105583 . 110455) (\MOVEFONTCHARS.SOURCEDATA 110457 . 117212) (\MAKESLUGCHAR 117214 . 119749) (
|
||||
SLUGCHARP 119751 . 120864)) (121781 135035 (FONTFILES 121791 . 124830) (\FINDFONTFILE 124832 . 126809)
|
||||
(\FONTFILENAMES 126811 . 127371) (\FONTFILENAME 127373 . 130483) (FONTSPECFROMFILENAME 130485 .
|
||||
135033)) (135036 171369 (FONTCOPY 135046 . 140129) (FONTP 140131 . 140430) (FONTUNPARSE 140432 .
|
||||
142155) (SETFONTDESCRIPTOR 142157 . 143621) (\STREAMCHARWIDTH 143623 . 147634) (\COERCECHARSET 147636
|
||||
. 151025) (\BUILDSLUGCSINFO 151027 . 154720) (\FONTSYMBOL 154722 . 155376) (\DEVICESYMBOL 155378 .
|
||||
156162) (\FONTFACE 156164 . 163368) (\FONTFACE.COLOR 163370 . 170152) (SETFONTCHARENCODING 170154 .
|
||||
171367)) (171370 192228 (FONTSAVAILABLE 171380 . 176744) (FONTEXISTS? 176746 . 180554) (
|
||||
\SEARCHFONTFILES 180556 . 183770) (FLUSHFONTCACHE 183772 . 186303) (FINDFONTFILES 186305 . 189521) (
|
||||
SORTFONTSPECS 189523 . 192226)) (192229 197767 (MATCHFONTFACE 192239 . 193314) (MAKEFONTFACE 193316 .
|
||||
194350) (FONTFACETOATOM 194352 . 196602) (FONTFACE.STARS 196604 . 197765)) (198398 198890 (
|
||||
\UNITWIDTHSVECTOR 198408 . 198888)) (215811 217878 (FONTDESCRIPTOR.DEFPRINT 215821 . 217400) (
|
||||
FONTCLASS.DEFPRINT 217402 . 217876)) (221800 224590 (\CREATEKERNELEMENT 221810 . 222168) (
|
||||
\FSETLEFTKERN 222170 . 222661) (\FGETLEFTKERN 222663 . 224588)) (224591 235745 (\CREATEFONT 224601 .
|
||||
228209) (\CREATECHARSET 228211 . 231496) (\INSTALLCHARSETINFO 231498 . 234832) (
|
||||
\INSTALLCHARSETINFO.CHARENCODING 234834 . 235743)) (236067 237435 (\FONTRESETCHARWIDTHS 236077 .
|
||||
237433)) (237958 245816 (\CREATEDISPLAYFONT 237968 . 239875) (\CREATECHARSET.DISPLAY 239877 . 243401)
|
||||
(\FONTEXISTS?.DISPLAY 243403 . 245814)) (245817 254195 (FAKEFACE.CHARSET 245827 . 249889) (
|
||||
MAKEBOLD.CHAR 249891 . 251744) (MAKEITALIC.CHAR 251746 . 254193)) (254226 258481 (\SFROTATECSINFO
|
||||
254236 . 256378) (\SFROTATEFONTCHARACTERS 256380 . 256764) (\SFROTATECSINFOOFFSETS 256766 . 258479)) (
|
||||
258482 259656 (\SFMAKECOLOR 258492 . 259654)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "30-Apr-2026 08:56:22" {MEDLEY}<sources>MEDLEYFONTFORMAT.;312 64895
|
||||
(FILECREATED " 4-May-2026 14:58:55" {MEDLEY}<sources>MEDLEYFONTFORMAT.;316 66701
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MEDLEYFONT.FILENAME)
|
||||
:CHANGES-TO (FNS MEDLEYFONT.WRITE.CHARSET MEDLEYFONT.READ.CHARSET)
|
||||
|
||||
:PREVIOUS-DATE "29-Apr-2026 22:52:28" {MEDLEY}<sources>MEDLEYFONTFORMAT.;311)
|
||||
:PREVIOUS-DATE " 4-May-2026 10:28:29" {MEDLEY}<sources>MEDLEYFONTFORMAT.;315)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYFONTFORMATCOMS)
|
||||
@@ -222,7 +222,8 @@
|
||||
CHARSETS)])
|
||||
|
||||
(MEDLEYFONT.GETFILEPROP
|
||||
[LAMBDA (FILE PROP) (* ; "Edited 16-Apr-2026 22:30 by rmk")
|
||||
[LAMBDA (FILE PROP) (* ; "Edited 4-May-2026 09:57 by rmk")
|
||||
(* ; "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")
|
||||
@@ -234,15 +235,12 @@
|
||||
(* ; "Edited 10-Jul-2025 17:50 by rmk")
|
||||
(* ; "Edited 25-May-2025 20:53 by rmk")
|
||||
(* ; "Edited 21-May-2025 11:36 by rmk")
|
||||
(* ; "Edited 17-May-2025 19:07 by rmk")
|
||||
(* ; "Edited 14-May-2025 17:46 by rmk")
|
||||
(* ; "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)
|
||||
(* ; "Edited 17-May-2025 19:07 by rmk")
|
||||
(SETQ FILE (OR (MEDLEYFONT.FILENAME FILE)
|
||||
(ERROR "FILE NOT FOUND" FILE)))
|
||||
(CL:WITH-OPEN-FILE (STREAM (OR (MEDLEYFONT.FILENAME FILE)
|
||||
FILE)
|
||||
:DIRECTION :INPUT)
|
||||
(LET (HEADERPROPS CSLOC SINGLECS MAXCHARSET)
|
||||
(CL:UNLESS (SETQ HEADERPROPS (MEDLEYFONT.FILEP STREAM))
|
||||
(ERROR "Not a MEDLEYFONT file" (FULLNAME STREAM)))
|
||||
@@ -265,7 +263,11 @@
|
||||
else (SETFILEPTR STREAM CSLOC)
|
||||
(for CS from 0 to MAXCHARSET when (IGREATERP (\FIXPIN STREAM)
|
||||
0) collect CS)))
|
||||
(INDIRECTS (CADR (ASSOC 'INDIRECTS (MEDLEYFONT.READ.FONTPROPS STREAM))))
|
||||
(INDIRECTS
|
||||
(* ;;
|
||||
"These are fully spelled out FONTSPECS, no need to fill in defaults")
|
||||
|
||||
(CADR (ASSOC 'ICS (MEDLEYFONT.READ.FONTPROPS STREAM))))
|
||||
(ERROR "Unknown MEDLEYFONT property"])
|
||||
|
||||
(MEDLEYFONT.FILEP
|
||||
@@ -367,7 +369,9 @@
|
||||
(RETURN FONT))))])
|
||||
|
||||
(MEDLEYFONT.READ.CHARSET
|
||||
[LAMBDA (STREAM CHARSET FONT) (* ; "Edited 14-Apr-2026 22:32 by rmk")
|
||||
[LAMBDA (STREAM CHARSET FONT) (* ; "Edited 4-May-2026 12:38 by rmk")
|
||||
(* ; "Edited 30-Apr-2026 08:56 by rmk")
|
||||
(* ; "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")
|
||||
@@ -377,17 +381,20 @@
|
||||
(* ; "Edited 17-Aug-2025 13:01 by rmk")
|
||||
(* ; "Edited 15-Jul-2025 11:27 by rmk")
|
||||
(* ; "Edited 12-May-2025 07:55 by rmk")
|
||||
(MEDLEYFONT.READ.ITEM STREAM 'CHARSETSTRING) (* ;
|
||||
(* ;
|
||||
"Throwaway for looking with text editor")
|
||||
(LET (CSNO)
|
||||
(CL:UNLESS [EQ CHARSET (SETQ CSNO (MEDLEYFONT.READ.ITEM STREAM 'CHARSET]
|
||||
(CL:UNLESS [EQ CHARSET (SETQ CSNO (MKATOM (MEDLEYFONT.READ.ITEM STREAM 'CS]
|
||||
(ERROR "Charset mismatch" (LIST CHARSET CSNO)))
|
||||
(if (EQ 'INDIRECTCHARSET (CAR (MEDLEYFONT.PEEK.ITEM STREAM)))
|
||||
(if (EQ 'ICS (CAR (MEDLEYFONT.PEEK.ITEM STREAM)))
|
||||
then
|
||||
(* ;; "Read what we peeked and use it to create a complete charset from another file (e.g. shared Kanji). The indirect source is in the same directory and has the same extension as the starting file.")
|
||||
(* ;; "Indirect: Read what we peeked and use it to create a complete charset from another file (e.g. shared Kanji). The indirect source is in the same directory and has the same extension as the starting file.")
|
||||
|
||||
(MEDLEYFONT.GETCHARSET (MEDLEYFONT.FILENAME (MEDLEYFONT.READ.ITEM STREAM
|
||||
'INDIRECTCHARSET)
|
||||
(MEDLEYFONT.GETCHARSET (MEDLEYFONT.FILENAME (MAKEFONTSPEC (MEDLEYFONT.READ.ITEM
|
||||
STREAM
|
||||
'ICS)
|
||||
NIL NIL NIL NIL
|
||||
(FONTPROP FONT 'DEVICESPEC))
|
||||
(FULLNAME STREAM))
|
||||
CHARSET FONT)
|
||||
else (bind PAIR LABEL ITEM (CSINFO _ (create CHARSETINFO
|
||||
@@ -617,7 +624,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MEDLEYFONT.WRITE.CHARSET
|
||||
[LAMBDA (FONT CHARSET STREAM NOINDIRECTS) (* ; "Edited 1-Apr-2026 09:20 by rmk")
|
||||
[LAMBDA (FONT CHARSET STREAM NOINDIRECTS) (* ; "Edited 4-May-2026 11:53 by rmk")
|
||||
(* ; "Edited 1-Apr-2026 09:20 by rmk")
|
||||
(* ; "Edited 4-Sep-2025 11:41 by rmk")
|
||||
(* ; "Edited 30-Aug-2025 23:44 by rmk")
|
||||
(* ; "Edited 28-Aug-2025 21:00 by rmk")
|
||||
@@ -628,9 +636,8 @@
|
||||
(* ; "Edited 13-May-2025 23:26 by rmk")
|
||||
(LET ((CSINFO (\INSURECHARSETINFO FONT CHARSET))
|
||||
CSCHARENCODING INDIRECT)
|
||||
(MEDLEYFONT.WRITE.ITEM STREAM 'CHARSETSTRING (MKSTRING CHARSET))
|
||||
(* ; "For human file-scan")
|
||||
(MEDLEYFONT.WRITE.ITEM STREAM 'CHARSET CHARSET)
|
||||
(MEDLEYFONT.WRITE.ITEM STREAM 'CS (MKSTRING CHARSET))
|
||||
(* ; "String for human file-scan")
|
||||
(CL:UNLESS (OR (NULL CSINFO)
|
||||
(fetch (CHARSETINFO CSSLUGP) of CSINFO))
|
||||
(* ;
|
||||
@@ -641,10 +648,20 @@
|
||||
(if (CL:UNLESS NOINDIRECTS
|
||||
(SETQ INDIRECT (INDIRECTCHARSETP CSINFO FONT)))
|
||||
then
|
||||
(* ;;
|
||||
"This charset is is taken entirely from another file, no need to copy it to this file.")
|
||||
(* ;; "This charset is is taken entirely from another file, no need to copy it to this file. Leave off the redundant FONTSPEC stuff")
|
||||
|
||||
(MEDLEYFONT.WRITE.ITEM STREAM 'INDIRECTCHARSET INDIRECT NIL 'PRINT)
|
||||
(MEDLEYFONT.WRITE.ITEM STREAM 'ICS (LIST* (fetch (FONTSPEC FSFAMILY)
|
||||
of INDIRECT)
|
||||
(fetch (FONTSPEC FSSIZE) of INDIRECT)
|
||||
(fetch (FONTSPEC FSFACE) of INDIRECT)
|
||||
(CL:UNLESS
|
||||
(EQ (FONTPROP FONT 'ROTATION)
|
||||
(fetch (FONTSPEC FSROTATION)
|
||||
of INDIRECT))
|
||||
(fetch (FONTSPEC FSROTATION)
|
||||
of INDIRECT)))
|
||||
NIL
|
||||
'PRINT)
|
||||
else (MEDLEYFONT.WRITE.ITEM STREAM 'CSINFOPROPS (fetch (CHARSETINFO CSINFOPROPS)
|
||||
of CSINFO)
|
||||
NIL
|
||||
@@ -807,7 +824,8 @@
|
||||
(TERPRI STREAM))])
|
||||
|
||||
(MEDLEYFONT.WRITE.FONTPROPS
|
||||
[LAMBDA (STREAM FONT) (* ; "Edited 31-Mar-2026 14:53 by rmk")
|
||||
[LAMBDA (STREAM FONT) (* ; "Edited 4-May-2026 09:57 by rmk")
|
||||
(* ; "Edited 31-Mar-2026 14:53 by rmk")
|
||||
(* ; "Edited 23-Mar-2026 11:52 by rmk")
|
||||
(* ; "Edited 19-Mar-2026 11:48 by rmk")
|
||||
(* ; "Edited 18-Mar-2026 08:17 by rmk")
|
||||
@@ -869,7 +887,7 @@
|
||||
of FONT)
|
||||
T)
|
||||
(MEDLEYFONT.WRITE.ITEM STREAM 'INDIRECTS (for CS CSINFO INDIRECT (FSPEC _ (FONTPROP FONT
|
||||
'SPEC))
|
||||
'DEVICESPEC))
|
||||
from 0 to (MAXCHARSET FONT)
|
||||
when (SETQ CSINFO (\GETCHARSETINFO FONT CS))
|
||||
when (SETQ INDIRECT (CHARSETPROP CSINFO 'SOURCE))
|
||||
@@ -896,12 +914,15 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MEDLEYFONT.FILENAME
|
||||
[LAMBDA (FILE DIRECTORY) (* ; "Edited 30-Apr-2026 08:54 by rmk")
|
||||
[LAMBDA (FILE DIRECTORY) (* ; "Edited 4-May-2026 09:01 by rmk")
|
||||
(* ; "Edited 30-Apr-2026 08:54 by rmk")
|
||||
(* ; "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")
|
||||
(CL:WHEN (\GETSTREAM FILE 'INPUT T)
|
||||
(SETQ FILE (FULLNAME FILE)))
|
||||
(CL:WHEN DIRECTORY (* ; "Keep the host/directory.")
|
||||
(SETQ DIRECTORY (PACKFILENAME 'NAME NIL 'EXTENSION NIL 'VERSION NIL 'BODY DIRECTORY)))
|
||||
(if (type? FONTSPEC FILE)
|
||||
@@ -961,12 +982,12 @@
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2178 20657 (MEDLEYFONT.WRITE.FONT 2188 . 8591) (MEDLEYFONT.GETCHARSET 8593 . 10674) (
|
||||
MEDLEYFONT.GETCHARSET.INTERNAL 10676 . 12929) (MEDLEYFONT.CHARSET? 12931 . 13809) (
|
||||
MEDLEYFONT.GETFILEPROP 13811 . 17390) (MEDLEYFONT.FILEP 17392 . 19820) (MEDLEYFONT.FILEVERSION 19822
|
||||
. 20655)) (20683 43300 (MEDLEYFONT.READ.FONT 20693 . 24209) (MEDLEYFONT.READ.CHARSET 24211 . 29487) (
|
||||
MEDLEYFONT.READ.ITEM 29489 . 35638) (MEDLEYFONT.PEEK.ITEM 35640 . 36502) (MEDLEYFONT.READ.FONTPROPS
|
||||
36504 . 36969) (MEDLEYFONT.READ.VERIFIEDFONT 36971 . 43298)) (43326 62676 (MEDLEYFONT.WRITE.CHARSET
|
||||
43336 . 47975) (MEDLEYFONT.WRITE.ITEM 47977 . 57030) (MEDLEYFONT.WRITE.FONTPROPS 57032 . 61801) (
|
||||
MEDLEYFONT.WRITE.HEADER 61803 . 62674)) (62677 64010 (MEDLEYFONT.FILENAME 62687 . 64008)))))
|
||||
(FILEMAP (NIL (2207 20671 (MEDLEYFONT.WRITE.FONT 2217 . 8620) (MEDLEYFONT.GETCHARSET 8622 . 10703) (
|
||||
MEDLEYFONT.GETCHARSET.INTERNAL 10705 . 12958) (MEDLEYFONT.CHARSET? 12960 . 13838) (
|
||||
MEDLEYFONT.GETFILEPROP 13840 . 17404) (MEDLEYFONT.FILEP 17406 . 19834) (MEDLEYFONT.FILEVERSION 19836
|
||||
. 20669)) (20697 43799 (MEDLEYFONT.READ.FONT 20707 . 24223) (MEDLEYFONT.READ.CHARSET 24225 . 29986) (
|
||||
MEDLEYFONT.READ.ITEM 29988 . 36137) (MEDLEYFONT.PEEK.ITEM 36139 . 37001) (MEDLEYFONT.READ.FONTPROPS
|
||||
37003 . 37468) (MEDLEYFONT.READ.VERIFIEDFONT 37470 . 43797)) (43825 64296 (MEDLEYFONT.WRITE.CHARSET
|
||||
43835 . 49480) (MEDLEYFONT.WRITE.ITEM 49482 . 58535) (MEDLEYFONT.WRITE.FONTPROPS 58537 . 63421) (
|
||||
MEDLEYFONT.WRITE.HEADER 63423 . 64294)) (64297 65816 (MEDLEYFONT.FILENAME 64307 . 65814)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user