github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-28 09:37:31 +00:00
Code Issues Projects Releases Wiki Activity

\FONT.CHECKARGS extracts the right component if the font of a stream family is a fontclass (#2509)

Browse Source
This commit is contained in:
rmkaplan
2026-02-24 10:06:24 -08:00
committed by GitHub
parent 1ff475a42c
commit 1569a27209
2 changed files with 59 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

107
sources/FONT
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Feb-2026 23:44:25" {WMEDLEY}<sources>FONT.;671 276511
(FILECREATED "19-Feb-2026 00:10:22" {WMEDLEY}<sources>FONT.;674 277477
:EDIT-BY rmk
:CHANGES-TO (FNS \FINDFONTFILE)
:CHANGES-TO (FNS \FONT.CHECKARGS1)
:PREVIOUS-DATE " 6-Feb-2026 00:24:55" {WMEDLEY}<sources>FONT.;670)
:PREVIOUS-DATE "14-Feb-2026 13:14:08" {WMEDLEY}<sources>FONT.;673)
(PRETTYCOMPRINT FONTCOMS)
@@ -608,7 +608,8 @@
FONTDESC])
(\FONT.CHECKARGS1
[LAMBDA (SPEC STREAM NOERRORFLG) (* ; "Edited 22-Jul-2025 18:47 by rmk")
[LAMBDA (SPEC STREAM NOERRORFLG) (* ; "Edited 19-Feb-2026 00:03 by rmk")
(* ; "Edited 22-Jul-2025 18:47 by rmk")
(* ; "Edited 14-Jul-2025 19:40 by rmk")
(* ; "Edited 5-Jul-2025 14:16 by rmk")
(* ; "Edited 29-Aug-91 12:19 by jds")
@@ -620,6 +621,8 @@
(* ;; "STREAM denotes a device: NIL means DISPLAY, another atom is a device name itself, an IMAGESTREAM means its IMAGESTREAMTYPE. Anything else here maps to DISPLAY, but maybe that should be an illegal arg error, even of NOERRORFLG.")
(DECLARE (GLOBALVARS DEFAULTFONT \GUARANTEEDDISPLAYFONT))
(CL:WHEN (IMAGESTREAMP SPEC)
(SETQ SPEC (DSPFONT NIL SPEC)))
(LET (FONT DEVICE TEMP)
(CL:UNLESS SPEC
(if DEFAULTFONT
@@ -703,7 +706,8 @@
(CLOSEF? STRM))))])
(\READCHARSET
[LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 6-Feb-2026 00:03 by rmk")
[LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 14-Feb-2026 09:47 by rmk")
(* ; "Edited 6-Feb-2026 00:03 by rmk")
(* ; "Edited 11-Nov-2025 14:30 by rmk")
(* ; "Edited 2-Sep-2025 23:57 by rmk")
(* ; "Edited 28-Aug-2025 23:17 by rmk")
@@ -723,7 +727,8 @@
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 FAMILY in (FONTDEVICEPROP FONTSPEC 'CHARSETFNS)
(for FNS FAMILY in [OR (FONTDEVICEPROP FONTSPEC 'CHARSETFNS)
'((MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET]
do [RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT))
`(PROGN (CLOSEF? OLDVALUE]
(CL:WHEN (CAR (NLSETQ (APPLY* (CADR FNS)
@@ -3496,7 +3501,8 @@
FONT])
(\CREATECHARSET
[LAMBDA (CHARSET FONT) (* ; "Edited 25-Sep-2025 21:24 by rmk")
[LAMBDA (CHARSET FONT) (* ; "Edited 14-Feb-2026 13:12 by rmk")
(* ; "Edited 25-Sep-2025 21:24 by rmk")
(* ; "Edited 2-Sep-2025 22:59 by rmk")
(* ; "Edited 31-Aug-2025 14:36 by rmk")
(* ; "Edited 28-Aug-2025 14:31 by rmk")
@@ -3525,11 +3531,16 @@
(\ILLEGAL.ARG CHARSET))
(LET [(CSINFO (if (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT)
then (\GETCHARSETINFO FONT CHARSET)
else (APPLY* (OR (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTDESCRIPTOR
else (APPLY* [OR (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTDESCRIPTOR
FONTDEVICE)
of FONT)
'CREATECHARSET))
(FUNCTION \READCHARSET))
(FUNCTION (LAMBDA (FONTSPEC FONT CHARSET)
(* ;
 "No function: read or read-coerced-font")
(OR (\READCHARSET FONTSPEC CHARSET FONT)
(\READCHARSET (COERCEFONTSPEC FONTSPEC)
CHARSET FONT]
(create FONTSPEC using (FONTPROP FONT 'DEVICESPEC))
FONT CHARSET]
@@ -4485,43 +4496,43 @@
(ADDTOVAR LAMA FONTCOPY)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (11414 21127 (CHARWIDTH 11424 . 12209) (CHARWIDTHY 12211 . 13728) (STRINGWIDTH 13730 .
14823) (\CHARWIDTH.DISPLAY 14825 . 15238) (\STRINGWIDTH.DISPLAY 15240 . 15664) (\STRINGWIDTH.GENERIC
15666 . 21125)) (21128 27648 (DEFAULTFONT 21138 . 22423) (FONTCLASS 22425 . 24587) (FONTCLASSUNPARSE
24589 . 25488) (FONTCLASSCOMPONENT 25490 . 26078) (SETFONTCLASSCOMPONENT 26080 . 26522) (
GETFONTCLASSCOMPONENT 26524 . 27646)) (29361 46989 (FONTCREATE 29371 . 32616) (FONTCREATE1 32618 .
35233) (FONTCREATE.SLUGFD 35235 . 36717) (\FONT.CHECKARGS1 36719 . 41242) (\FONTCREATE1.NOFN 41244 .
41458) (FONTFILEP 41460 . 42348) (\READCHARSET 42350 . 46987)) (46990 54066 (\FONT.CHECKARGS 47000 .
53749) (\CHARSET.CHECK 53751 . 54064)) (54067 60678 (COERCEFONTSPEC 54077 . 59989) (
COERCEFONTSPEC.TARGETFACE 59991 . 60676)) (62873 64212 (MAKEFONTSPEC 62883 . 64210)) (64213 72390 (
COMPLETE.FONT 64223 . 66746) (COMPLETEFONTP 66748 . 67371) (COMPLETE.CHARSET 67373 . 70058) (
PRUNESLUGCSINFOS 70060 . 70985) (MONOSPACEFONTP 70987 . 72388)) (72429 80875 (FONTASCENT 72439 . 72823
) (FONTDESCENT 72825 . 73310) (FONTHEIGHT 73312 . 73714) (FONTPROP 73716 . 80152) (\AVGCHARWIDTH 80154
. 80873)) (81532 82440 (FONTDEVICEPROP 81542 . 82438)) (82486 83340 (EDITCHAR 82496 . 83338)) (83386
95576 (GETCHARBITMAP 83396 . 84520) (PUTCHARBITMAP 84522 . 86680) (\GETCHARBITMAP.CSINFO 86682 . 88698
) (\PUTCHARBITMAP.CSINFO 88700 . 95574)) (95577 116057 (MOVECHARBITMAP 95587 . 97481) (MOVEFONTCHARS
97483 . 101443) (\MOVEFONTCHAR 101445 . 106288) (\MOVEFONTCHARS.SOURCEDATA 106290 . 112395) (
\MAKESLUGCHAR 112397 . 114932) (SLUGCHARP.DISPLAY 114934 . 116055)) (116715 128552 (FONTFILES 116725
. 118558) (\FINDFONTFILE 118560 . 120537) (\FONTFILENAMES 120539 . 121099) (\FONTFILENAME 121101 .
124012) (FONTSPECFROMFILENAME 124014 . 128550)) (128553 165128 (FONTCOPY 128563 . 133626) (FONTP
133628 . 133927) (FONTUNPARSE 133929 . 135648) (SETFONTDESCRIPTOR 135650 . 137114) (\STREAMCHARWIDTH
137116 . 141280) (\COERCECHARSET 141282 . 144649) (\BUILDSLUGCSINFO 144651 . 148274) (\FONTSYMBOL
148276 . 148926) (\DEVICESYMBOL 148928 . 149797) (\FONTFACE 149799 . 156989) (\FONTFACE.COLOR 156991
. 163911) (SETFONTCHARENCODING 163913 . 165126)) (165129 184790 (FONTSAVAILABLE 165139 . 170493) (
FONTEXISTS? 170495 . 174034) (\SEARCHFONTFILES 174036 . 177121) (FLUSHFONTCACHE 177123 . 179346) (
FINDFONTFILES 179348 . 182562) (SORTFONTSPECS 182564 . 184788)) (184791 188898 (MATCHFONTFACE 184801
. 185616) (MAKEFONTFACE 185618 . 186644) (FONTFACETOATOM 186646 . 188896)) (189529 190021 (
\UNITWIDTHSVECTOR 189539 . 190019)) (204650 206717 (FONTDESCRIPTOR.DEFPRINT 204660 . 206239) (
FONTCLASS.DEFPRINT 206241 . 206715)) (210546 213336 (\CREATEKERNELEMENT 210556 . 210914) (
\FSETLEFTKERN 210916 . 211407) (\FGETLEFTKERN 211409 . 213334)) (213337 224412 (\CREATEFONT 213347 .
216225) (\CREATECHARSET 216227 . 220163) (\INSTALLCHARSETINFO 220165 . 223499) (
\INSTALLCHARSETINFO.CHARENCODING 223501 . 224410)) (224734 226098 (\FONTRESETCHARWIDTHS 224744 .
226096)) (226728 236769 (\CREATEDISPLAYFONT 226738 . 228587) (\CREATECHARSET.DISPLAY 228589 . 234298)
(\FONTEXISTS?.DISPLAY 234300 . 236767)) (236770 251635 (STRIKEFONT.FILEP 236780 . 237668) (
STRIKEFONT.GETCHARSET 237670 . 243262) (WRITESTRIKEFONTFILE 243264 . 248175) (STRIKECSINFO 248177 .
251633)) (251666 267983 (MAKEBOLD.CHARSET 251676 . 255325) (MAKEBOLD.CHAR 255327 . 257079) (
MAKEITALIC.CHARSET 257081 . 260754) (MAKEITALIC.CHAR 260756 . 263102) (\SFMAKEBOLD 263104 . 265328) (
\SFMAKEITALIC 265330 . 267981)) (267984 272133 (\SFMAKEROTATEDFONT 267994 . 269395) (\SFROTATECSINFO
269397 . 270034) (\SFROTATEFONTCHARACTERS 270036 . 270416) (\SFROTATECSINFOOFFSETS 270418 . 272131)) (
272134 273515 (\SFMAKECOLOR 272144 . 273513)))))
(FILEMAP (NIL (11417 21130 (CHARWIDTH 11427 . 12212) (CHARWIDTHY 12214 . 13731) (STRINGWIDTH 13733 .
14826) (\CHARWIDTH.DISPLAY 14828 . 15241) (\STRINGWIDTH.DISPLAY 15243 . 15667) (\STRINGWIDTH.GENERIC
15669 . 21128)) (21131 27651 (DEFAULTFONT 21141 . 22426) (FONTCLASS 22428 . 24590) (FONTCLASSUNPARSE
24592 . 25491) (FONTCLASSCOMPONENT 25493 . 26081) (SETFONTCLASSCOMPONENT 26083 . 26525) (
GETFONTCLASSCOMPONENT 26527 . 27649)) (29364 47382 (FONTCREATE 29374 . 32619) (FONTCREATE1 32621 .
35236) (FONTCREATE.SLUGFD 35238 . 36720) (\FONT.CHECKARGS1 36722 . 41427) (\FONTCREATE1.NOFN 41429 .
41643) (FONTFILEP 41645 . 42533) (\READCHARSET 42535 . 47380)) (47383 54459 (\FONT.CHECKARGS 47393 .
54142) (\CHARSET.CHECK 54144 . 54457)) (54460 61071 (COERCEFONTSPEC 54470 . 60382) (
COERCEFONTSPEC.TARGETFACE 60384 . 61069)) (63266 64605 (MAKEFONTSPEC 63276 . 64603)) (64606 72783 (
COMPLETE.FONT 64616 . 67139) (COMPLETEFONTP 67141 . 67764) (COMPLETE.CHARSET 67766 . 70451) (
PRUNESLUGCSINFOS 70453 . 71378) (MONOSPACEFONTP 71380 . 72781)) (72822 81268 (FONTASCENT 72832 . 73216
) (FONTDESCENT 73218 . 73703) (FONTHEIGHT 73705 . 74107) (FONTPROP 74109 . 80545) (\AVGCHARWIDTH 80547
. 81266)) (81925 82833 (FONTDEVICEPROP 81935 . 82831)) (82879 83733 (EDITCHAR 82889 . 83731)) (83779
95969 (GETCHARBITMAP 83789 . 84913) (PUTCHARBITMAP 84915 . 87073) (\GETCHARBITMAP.CSINFO 87075 . 89091
) (\PUTCHARBITMAP.CSINFO 89093 . 95967)) (95970 116450 (MOVECHARBITMAP 95980 . 97874) (MOVEFONTCHARS
97876 . 101836) (\MOVEFONTCHAR 101838 . 106681) (\MOVEFONTCHARS.SOURCEDATA 106683 . 112788) (
\MAKESLUGCHAR 112790 . 115325) (SLUGCHARP.DISPLAY 115327 . 116448)) (117108 128945 (FONTFILES 117118
. 118951) (\FINDFONTFILE 118953 . 120930) (\FONTFILENAMES 120932 . 121492) (\FONTFILENAME 121494 .
124405) (FONTSPECFROMFILENAME 124407 . 128943)) (128946 165521 (FONTCOPY 128956 . 134019) (FONTP
134021 . 134320) (FONTUNPARSE 134322 . 136041) (SETFONTDESCRIPTOR 136043 . 137507) (\STREAMCHARWIDTH
137509 . 141673) (\COERCECHARSET 141675 . 145042) (\BUILDSLUGCSINFO 145044 . 148667) (\FONTSYMBOL
148669 . 149319) (\DEVICESYMBOL 149321 . 150190) (\FONTFACE 150192 . 157382) (\FONTFACE.COLOR 157384
. 164304) (SETFONTCHARENCODING 164306 . 165519)) (165522 185183 (FONTSAVAILABLE 165532 . 170886) (
FONTEXISTS? 170888 . 174427) (\SEARCHFONTFILES 174429 . 177514) (FLUSHFONTCACHE 177516 . 179739) (
FINDFONTFILES 179741 . 182955) (SORTFONTSPECS 182957 . 185181)) (185184 189291 (MATCHFONTFACE 185194
. 186009) (MAKEFONTFACE 186011 . 187037) (FONTFACETOATOM 187039 . 189289)) (189922 190414 (
\UNITWIDTHSVECTOR 189932 . 190412)) (205043 207110 (FONTDESCRIPTOR.DEFPRINT 205053 . 206632) (
FONTCLASS.DEFPRINT 206634 . 207108)) (210939 213729 (\CREATEKERNELEMENT 210949 . 211307) (
\FSETLEFTKERN 211309 . 211800) (\FGETLEFTKERN 211802 . 213727)) (213730 225378 (\CREATEFONT 213740 .
216618) (\CREATECHARSET 216620 . 221129) (\INSTALLCHARSETINFO 221131 . 224465) (
\INSTALLCHARSETINFO.CHARENCODING 224467 . 225376)) (225700 227064 (\FONTRESETCHARWIDTHS 225710 .
227062)) (227694 237735 (\CREATEDISPLAYFONT 227704 . 229553) (\CREATECHARSET.DISPLAY 229555 . 235264)
(\FONTEXISTS?.DISPLAY 235266 . 237733)) (237736 252601 (STRIKEFONT.FILEP 237746 . 238634) (
STRIKEFONT.GETCHARSET 238636 . 244228) (WRITESTRIKEFONTFILE 244230 . 249141) (STRIKECSINFO 249143 .
252599)) (252632 268949 (MAKEBOLD.CHARSET 252642 . 256291) (MAKEBOLD.CHAR 256293 . 258045) (
MAKEITALIC.CHARSET 258047 . 261720) (MAKEITALIC.CHAR 261722 . 264068) (\SFMAKEBOLD 264070 . 266294) (
\SFMAKEITALIC 266296 . 268947)) (268950 273099 (\SFMAKEROTATEDFONT 268960 . 270361) (\SFROTATECSINFO
270363 . 271000) (\SFROTATEFONTCHARACTERS 271002 . 271382) (\SFROTATECSINFOOFFSETS 271384 . 273097)) (
273100 274481 (\SFMAKECOLOR 273110 . 274479)))))
STOP

BIN
sources/FONT.LCOM
View File

Binary file not shown.