github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-05 15:44:25 +00:00
Code Issues Projects Releases Wiki Activity

Fix glitches

Browse Source
This commit is contained in:
rmkaplan
2025-10-09 21:21:58 -07:00
parent 63f32bc324
commit 5c011373e2
6 changed files with 130 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files

124
sources/FONT
View File

@@ -1,13 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Oct-2025 17:57:39" {WMEDLEY}<sources>FONT.;613 284861 (FILECREATED " 7-Oct-2025 17:51:13" {WMEDLEY}<sources>FONT.;617 284869
:EDIT-BY rmk :EDIT-BY rmk
:CHANGES-TO (FNS \CREATECHARSET.DISPLAY \COERCECHARSET COERCEFONTSPEC) :CHANGES-TO (FNS \CREATECHARSET.DISPLAY COMPLETE.FONT \COERCECHARSET)
(VARS FONTCOMS NSFONTFAMILIES) (MACROS LEGACYFONTS LEGACYFONT)
(VARS FONTCOMS)
:PREVIOUS-DATE "26-Sep-2025 10:10:37" {WMEDLEY}<sources>FONT.;608) :PREVIOUS-DATE " 7-Oct-2025 12:43:05" {WMEDLEY}<sources>FONT.;614)
(PRETTYCOMPRINT FONTCOMS) (PRETTYCOMPRINT FONTCOMS)
@@ -80,7 +81,7 @@
(PROP ARGNAMES CHARSETPROP) (PROP ARGNAMES CHARSETPROP)
(CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) (CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR))
(SLUGCHARSET (ADD1 \MAXCHARSET))) (SLUGCHARSET (ADD1 \MAXCHARSET)))
(MACROS LEGACYFONT)) (MACROS LEGACYFONTS))
(MACROS INDIRECTCHARSETP)) (MACROS INDIRECTCHARSETP))
(FNS FONTDESCRIPTOR.DEFPRINT FONTCLASS.DEFPRINT) (FNS FONTDESCRIPTOR.DEFPRINT FONTCLASS.DEFPRINT)
(INITRECORDS FONTCLASS FONTDESCRIPTOR CHARSETINFO) (INITRECORDS FONTCLASS FONTDESCRIPTOR CHARSETINFO)
@@ -1107,7 +1108,8 @@
(DEFINEQ (DEFINEQ
(COMPLETE.FONT (COMPLETE.FONT
[LAMBDA (FONTSPEC EVENIFCOMPLETE) (* ; "Edited 2-Sep-2025 22:59 by rmk") [LAMBDA (FONTSPEC EVENIFCOMPLETE) (* ; "Edited 7-Oct-2025 17:01 by rmk")
(* ; "Edited 2-Sep-2025 22:59 by rmk")
(* ; "Edited 29-Aug-2025 23:51 by rmk") (* ; "Edited 29-Aug-2025 23:51 by rmk")
(* ; "Edited 27-Aug-2025 10:51 by rmk") (* ; "Edited 27-Aug-2025 10:51 by rmk")
(* ; "Edited 21-Jun-2025 11:37 by rmk") (* ; "Edited 21-Jun-2025 11:37 by rmk")
@@ -1906,12 +1908,13 @@
(RETURN (CAR $$VAL)))]) (RETURN (CAR $$VAL)))])
(\FONTFILENAMES (\FONTFILENAMES
[LAMBDA (FAMILY SIZE FACE DEVICE EXTENSIONS) (* ; "Edited 17-May-2025 12:15 by rmk") [LAMBDA (FAMILY SIZE FACE DEVICE EXTENSIONS) (* ; "Edited 7-Oct-2025 12:21 by rmk")
(* ; "Edited 17-May-2025 12:15 by rmk")
(APPEND [for EXT inside EXTENSIONS collect (IF (FMEMB EXT *OLD-FONT-EXTENSIONS*) (APPEND [for EXT inside EXTENSIONS collect (IF (FMEMB EXT *OLD-FONT-EXTENSIONS*)
THEN (\FONTFILENAME.OLD FAMILY SIZE FACE EXT THEN (\FONTFILENAME.OLD FAMILY SIZE FACE EXT
'ALL) 'NOCHARSET)
ELSE (\FONTFILENAME FAMILY SIZE FACE EXT ELSE (\FONTFILENAME FAMILY SIZE FACE EXT
'ALL] 'NOCHARSET]
(for EXT inside EXTENSIONS collect (IF (FMEMB EXT *OLD-FONT-EXTENSIONS*) (for EXT inside EXTENSIONS collect (IF (FMEMB EXT *OLD-FONT-EXTENSIONS*)
THEN (\FONTFILENAME.OLD FAMILY SIZE FACE EXT 0) THEN (\FONTFILENAME.OLD FAMILY SIZE FACE EXT 0)
ELSE (\FONTFILENAME FAMILY SIZE FACE EXT 0]) ELSE (\FONTFILENAME FAMILY SIZE FACE EXT 0])
@@ -2384,7 +2387,7 @@
(SHOULDNT]) (SHOULDNT])
(\COERCECHARSET (\COERCECHARSET
[LAMBDA (FONTSPEC CHARSET CODE COERCIONS FONT) (* ; "Edited 6-Oct-2025 17:56 by rmk") [LAMBDA (FONTSPEC CHARSET CODE COERCIONS FONT) (* ; "Edited 7-Oct-2025 17:25 by rmk")
(* ; "Edited 31-Aug-2025 00:00 by rmk") (* ; "Edited 31-Aug-2025 00:00 by rmk")
(* ; "Edited 28-Aug-2025 23:07 by rmk") (* ; "Edited 28-Aug-2025 23:07 by rmk")
(* ; "Edited 27-Aug-2025 17:08 by rmk") (* ; "Edited 27-Aug-2025 17:08 by rmk")
@@ -3398,17 +3401,16 @@
) )
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(PUTPROPS LEGACYFONT MACRO ((FORM) (* ; (PUTPROPS LEGACYFONTS MACRO ((F . FORMS) (* ;
 "Execute FORM in a non-medleyfont displayfont environment")  "Execute FORMS in a legacy font environment")
(RESETVARS (\FONTSINCORE \FONTEXISTS?-CACHE DISPLAYFONTCOERCIONS (RESETLST
DISPLAYCHARCOERCIONS (DISPLAYFONTEXTENSIONS (RESETSAVE \FONTSINCORE NIL)
'(DISPLAYFONT)) (RESETSAVE \FONTEXISTS?-CACHE)
(DISPLAYFONTDIRECTORIES (MEDLEYDIR (RESETSAVE DISPLAYFONTCOERCIONS)
"fonts>displayfonts>")) (RESETSAVE DISPLAYCHARCOERCIONS)
(DISPLAYCHARSETFNS (REMOVE (ASSOC 'MEDLEYFONT (RESETSAVE DISPLAYFONTEXTENSIONS '(DISPLAYFONT))
DISPLAYCHARSETFNS) (RESETSAVE DISPLAYFONTDIRECTORIES (MEDLEYDIR "fonts>displayfonts>"))
DISPLAYCHARSETFNS))) (PROGN F . FORMS))))
(RETURN FORM))))
) )
(* "END EXPORTED DEFINITIONS") (* "END EXPORTED DEFINITIONS")
@@ -3827,7 +3829,7 @@
FONTDEVICESPEC _ (create FONTSPEC using FONTSPEC]) FONTDEVICESPEC _ (create FONTSPEC using FONTSPEC])
(\CREATECHARSET.DISPLAY (\CREATECHARSET.DISPLAY
[LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 6-Oct-2025 17:56 by rmk") [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 7-Oct-2025 17:05 by rmk")
(* ; "Edited 2-Sep-2025 23:42 by rmk") (* ; "Edited 2-Sep-2025 23:42 by rmk")
(* ; "Edited 30-Aug-2025 19:42 by rmk") (* ; "Edited 30-Aug-2025 19:42 by rmk")
(* ; "Edited 28-Aug-2025 23:08 by rmk") (* ; "Edited 28-Aug-2025 23:08 by rmk")
@@ -4625,43 +4627,43 @@
(ADDTOVAR LAMA FONTCOPY) (ADDTOVAR LAMA FONTCOPY)
) )
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (12161 21874 (CHARWIDTH 12171 . 12956) (CHARWIDTHY 12958 . 14475) (STRINGWIDTH 14477 . (FILEMAP (NIL (12196 21909 (CHARWIDTH 12206 . 12991) (CHARWIDTHY 12993 . 14510) (STRINGWIDTH 14512 .
15570) (\CHARWIDTH.DISPLAY 15572 . 15985) (\STRINGWIDTH.DISPLAY 15987 . 16411) (\STRINGWIDTH.GENERIC 15605) (\CHARWIDTH.DISPLAY 15607 . 16020) (\STRINGWIDTH.DISPLAY 16022 . 16446) (\STRINGWIDTH.GENERIC
16413 . 21872)) (21875 28395 (DEFAULTFONT 21885 . 23170) (FONTCLASS 23172 . 25334) (FONTCLASSUNPARSE 16448 . 21907)) (21910 28430 (DEFAULTFONT 21920 . 23205) (FONTCLASS 23207 . 25369) (FONTCLASSUNPARSE
25336 . 26235) (FONTCLASSCOMPONENT 26237 . 26825) (SETFONTCLASSCOMPONENT 26827 . 27269) ( 25371 . 26270) (FONTCLASSCOMPONENT 26272 . 26860) (SETFONTCLASSCOMPONENT 26862 . 27304) (
GETFONTCLASSCOMPONENT 27271 . 28393)) (30074 54455 (FONTCREATE 30084 . 33329) (FONTCREATE1 33331 . GETFONTCLASSCOMPONENT 27306 . 28428)) (30109 54490 (FONTCREATE 30119 . 33364) (FONTCREATE1 33366 .
35946) (FONTCREATE.SLUGFD 35948 . 37430) (\FONT.CHECKARGS 37432 . 44022) (\FONT.CHECKARGS1 44024 . 35981) (FONTCREATE.SLUGFD 35983 . 37465) (\FONT.CHECKARGS 37467 . 44057) (\FONT.CHECKARGS1 44059 .
48547) (\FONTCREATE1.NOFN 48549 . 48763) (FONTFILEP 48765 . 49653) (\READCHARSET 49655 . 54453)) ( 48582) (\FONTCREATE1.NOFN 48584 . 48798) (FONTFILEP 48800 . 49688) (\READCHARSET 49690 . 54488)) (
54456 61373 (\FONT.CHECKARGS 54466 . 61056) (\CHARSET.CHECK 61058 . 61371)) (61374 64457 ( 54491 61408 (\FONT.CHECKARGS 54501 . 61091) (\CHARSET.CHECK 61093 . 61406)) (61409 64492 (
COERCEFONTSPEC 61384 . 64455)) (66527 67317 (MAKEFONTSPEC 66537 . 67315)) (67318 73983 (COMPLETE.FONT COERCEFONTSPEC 61419 . 64490)) (66562 67352 (MAKEFONTSPEC 66572 . 67350)) (67353 74127 (COMPLETE.FONT
67328 . 69742) (COMPLETEFONTP 69744 . 70367) (COMPLETE.CHARSET 70369 . 73054) (PRUNESLUGCSINFOS 73056 67363 . 69886) (COMPLETEFONTP 69888 . 70511) (COMPLETE.CHARSET 70513 . 73198) (PRUNESLUGCSINFOS 73200
. 73981)) (74022 81943 (FONTASCENT 74032 . 74416) (FONTDESCENT 74418 . 74903) (FONTHEIGHT 74905 . . 74125)) (74166 82087 (FONTASCENT 74176 . 74560) (FONTDESCENT 74562 . 75047) (FONTHEIGHT 75049 .
75307) (FONTPROP 75309 . 81220) (\AVGCHARWIDTH 81222 . 81941)) (82600 83508 (FONTDEVICEPROP 82610 . 75451) (FONTPROP 75453 . 81364) (\AVGCHARWIDTH 81366 . 82085)) (82744 83652 (FONTDEVICEPROP 82754 .
83506)) (83554 84408 (EDITCHAR 83564 . 84406)) (84454 96644 (GETCHARBITMAP 84464 . 85588) ( 83650)) (83698 84552 (EDITCHAR 83708 . 84550)) (84598 96788 (GETCHARBITMAP 84608 . 85732) (
PUTCHARBITMAP 85590 . 87748) (\GETCHARBITMAP.CSINFO 87750 . 89766) (\PUTCHARBITMAP.CSINFO 89768 . PUTCHARBITMAP 85734 . 87892) (\GETCHARBITMAP.CSINFO 87894 . 89910) (\PUTCHARBITMAP.CSINFO 89912 .
96642)) (96645 117125 (MOVECHARBITMAP 96655 . 98549) (MOVEFONTCHARS 98551 . 102511) (\MOVEFONTCHAR 96786)) (96789 117269 (MOVECHARBITMAP 96799 . 98693) (MOVEFONTCHARS 98695 . 102655) (\MOVEFONTCHAR
102513 . 107356) (\MOVEFONTCHARS.SOURCEDATA 107358 . 113463) (\MAKESLUGCHAR 113465 . 116000) ( 102657 . 107500) (\MOVEFONTCHARS.SOURCEDATA 107502 . 113607) (\MAKESLUGCHAR 113609 . 116144) (
SLUGCHARP.DISPLAY 116002 . 117123)) (118058 138075 (FONTFILES 118068 . 119901) (\FINDFONTFILE 119903 SLUGCHARP.DISPLAY 116146 . 117267)) (118202 138340 (FONTFILES 118212 . 120045) (\FINDFONTFILE 120047
. 121620) (\FONTFILENAMES 121622 . 122496) (\FONTFILENAME 122498 . 126481) (\FONTFILENAME.OLD 126483 . 121764) (\FONTFILENAMES 121766 . 122761) (\FONTFILENAME 122763 . 126746) (\FONTFILENAME.OLD 126748
. 129432) (\FONTFILENAME.NEW 129434 . 131691) (FONTSPECFROMFILENAME 131693 . 135794) ( . 129697) (\FONTFILENAME.NEW 129699 . 131956) (FONTSPECFROMFILENAME 131958 . 136059) (
\FONTINFOFROMFILENAME.OLD 135796 . 138073)) (138342 174145 (FONTCOPY 138352 . 143415) (FONTP 143417 . \FONTINFOFROMFILENAME.OLD 136061 . 138338)) (138607 174410 (FONTCOPY 138617 . 143680) (FONTP 143682 .
143716) (FONTUNPARSE 143718 . 145437) (SETFONTDESCRIPTOR 145439 . 146903) (\STREAMCHARWIDTH 146905 . 143981) (FONTUNPARSE 143983 . 145702) (SETFONTDESCRIPTOR 145704 . 147168) (\STREAMCHARWIDTH 147170 .
151069) (\COERCECHARSET 151071 . 153666) (\BUILDSLUGCSINFO 153668 . 157291) (\FONTSYMBOL 157293 . 151334) (\COERCECHARSET 151336 . 153931) (\BUILDSLUGCSINFO 153933 . 157556) (\FONTSYMBOL 157558 .
157943) (\DEVICESYMBOL 157945 . 158814) (\FONTFACE 158816 . 166006) (\FONTFACE.COLOR 166008 . 172928) 158208) (\DEVICESYMBOL 158210 . 159079) (\FONTFACE 159081 . 166271) (\FONTFACE.COLOR 166273 . 173193)
(SETFONTCHARENCODING 172930 . 174143)) (174146 194697 (FONTSAVAILABLE 174156 . 179011) (FONTEXISTS? (SETFONTCHARENCODING 173195 . 174408)) (174411 194962 (FONTSAVAILABLE 174421 . 179276) (FONTEXISTS?
179013 . 182991) (\SEARCHFONTFILES 182993 . 186078) (FLUSHFONTSINCORE 186080 . 189253) (FINDFONTFILES 179278 . 183256) (\SEARCHFONTFILES 183258 . 186343) (FLUSHFONTSINCORE 186345 . 189518) (FINDFONTFILES
189255 . 192469) (SORTFONTSPECS 192471 . 194695)) (194698 198121 (MATCHFONTFACE 194708 . 195523) ( 189520 . 192734) (SORTFONTSPECS 192736 . 194960)) (194963 198386 (MATCHFONTFACE 194973 . 195788) (
MAKEFONTFACE 195525 . 196365) (FONTFACETOATOM 196367 . 198119)) (198349 198841 (\UNITWIDTHSVECTOR MAKEFONTFACE 195790 . 196630) (FONTFACETOATOM 196632 . 198384)) (198614 199106 (\UNITWIDTHSVECTOR
198359 . 198839)) (214441 216508 (FONTDESCRIPTOR.DEFPRINT 214451 . 216030) (FONTCLASS.DEFPRINT 216032 198624 . 199104)) (214449 216516 (FONTDESCRIPTOR.DEFPRINT 214459 . 216038) (FONTCLASS.DEFPRINT 216040
. 216506)) (220337 223127 (\CREATEKERNELEMENT 220347 . 220705) (\FSETLEFTKERN 220707 . 221198) ( . 216514)) (220345 223135 (\CREATEKERNELEMENT 220355 . 220713) (\FSETLEFTKERN 220715 . 221206) (
\FGETLEFTKERN 221200 . 223125)) (223128 232764 (\CREATEFONT 223138 . 224577) (\CREATECHARSET 224579 . \FGETLEFTKERN 221208 . 223133)) (223136 232772 (\CREATEFONT 223146 . 224585) (\CREATECHARSET 224587 .
228515) (\INSTALLCHARSETINFO 228517 . 231851) (\INSTALLCHARSETINFO.CHARENCODING 231853 . 232762)) ( 228523) (\INSTALLCHARSETINFO 228525 . 231859) (\INSTALLCHARSETINFO.CHARENCODING 231861 . 232770)) (
233086 234450 (\FONTRESETCHARWIDTHS 233096 . 234448)) (235080 245127 (\CREATEDISPLAYFONT 235090 . 233094 234458 (\FONTRESETCHARWIDTHS 233104 . 234456)) (235088 245135 (\CREATEDISPLAYFONT 235098 .
236939) (\CREATECHARSET.DISPLAY 236941 . 242650) (\FONTEXISTS?.DISPLAY 242652 . 245125)) (245128 236947) (\CREATECHARSET.DISPLAY 236949 . 242658) (\FONTEXISTS?.DISPLAY 242660 . 245133)) (245136
259993 (STRIKEFONT.FILEP 245138 . 246026) (STRIKEFONT.GETCHARSET 246028 . 251620) (WRITESTRIKEFONTFILE 260001 (STRIKEFONT.FILEP 245146 . 246034) (STRIKEFONT.GETCHARSET 246036 . 251628) (WRITESTRIKEFONTFILE
251622 . 256533) (STRIKECSINFO 256535 . 259991)) (260024 276341 (MAKEBOLD.CHARSET 260034 . 263683) ( 251630 . 256541) (STRIKECSINFO 256543 . 259999)) (260032 276349 (MAKEBOLD.CHARSET 260042 . 263691) (
MAKEBOLD.CHAR 263685 . 265437) (MAKEITALIC.CHARSET 265439 . 269112) (MAKEITALIC.CHAR 269114 . 271460) MAKEBOLD.CHAR 263693 . 265445) (MAKEITALIC.CHARSET 265447 . 269120) (MAKEITALIC.CHAR 269122 . 271468)
(\SFMAKEBOLD 271462 . 273686) (\SFMAKEITALIC 273688 . 276339)) (276342 280491 (\SFMAKEROTATEDFONT (\SFMAKEBOLD 271470 . 273694) (\SFMAKEITALIC 273696 . 276347)) (276350 280499 (\SFMAKEROTATEDFONT
276352 . 277753) (\SFROTATECSINFO 277755 . 278392) (\SFROTATEFONTCHARACTERS 278394 . 278774) ( 276360 . 277761) (\SFROTATECSINFO 277763 . 278400) (\SFROTATEFONTCHARACTERS 278402 . 278782) (
\SFROTATECSINFOOFFSETS 278776 . 280489)) (280492 281873 (\SFMAKECOLOR 280502 . 281871))))) \SFROTATECSINFOOFFSETS 278784 . 280497)) (280500 281881 (\SFMAKECOLOR 280510 . 281879)))))
STOP STOP

BIN
sources/FONT.LCOM
View File

Binary file not shown.

53
sources/MCCS
View File

@@ -1,14 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Oct-2025 16:44:20" {WMEDLEY}<sources>MCCS.;149 56371 (FILECREATED " 7-Oct-2025 14:52:10" {WMEDLEY}<sources>MCCS.;152 57023
:EDIT-BY rmk :EDIT-BY rmk
:CHANGES-TO (VARS PALATINOTOMCCS MCCSCOMS) :CHANGES-TO (FNS MCCSMAPPAIRS)
(FNS MCCSMAPPAIRS XCCS.CS0.UNDEFINED XCCSUNDEFINEDPAIRS XCCSUNDEFINEDCONTROLS
PALATINOTOMCODE MCCSMAPFN)
:PREVIOUS-DATE "20-Sep-2025 09:45:41" {WMEDLEY}<sources>MCCS.;138) :PREVIOUS-DATE " 6-Oct-2025 16:44:20" {WMEDLEY}<sources>MCCS.;149)
(PRETTYCOMPRINT MCCSCOMS) (PRETTYCOMPRINT MCCSCOMS)
@@ -1329,7 +1327,8 @@
NIL]) NIL])
(MCCSMAPPAIRS (MCCSMAPPAIRS
[LAMBDA (FROMENCODING NONIDENTITY) (* ; "Edited 6-Oct-2025 09:47 by rmk") [LAMBDA (FROMENCODING NONIDENTITY) (* ; "Edited 7-Oct-2025 14:47 by rmk")
(* ; "Edited 6-Oct-2025 09:47 by rmk")
(* ; "Edited 20-Sep-2025 09:45 by rmk") (* ; "Edited 20-Sep-2025 09:45 by rmk")
(* ; "Edited 6-Sep-2025 16:43 by rmk") (* ; "Edited 6-Sep-2025 16:43 by rmk")
(* ; "Edited 31-Aug-2025 16:16 by rmk") (* ; "Edited 31-Aug-2025 16:16 by rmk")
@@ -1337,7 +1336,7 @@
(* ;; "Returns the pairs for MOVEFONTCHARS to use to move charset-0 glyphs into their MCCS positions. For example, the Leftarrow and Lowline glyphs switch positions in an XCCS$ font. Returns NIL (= nothing to do) if there is no function.") (* ;; "Returns the pairs for MOVEFONTCHARS to use to move charset-0 glyphs into their MCCS positions. For example, the Leftarrow and Lowline glyphs switch positions in an XCCS$ font. Returns NIL (= nothing to do) if there is no function.")
(LET ((FN (MCCSMAPFN FROMENCODING)) (LET ((FN (MCCSMAPFN FROMENCODING))
PAIRS) PAIRS KEEPCS0)
(CL:WHEN FN (CL:WHEN FN
[SETQ PAIRS (SELECTQ FROMENCODING [SETQ PAIRS (SELECTQ FROMENCODING
(GACHA (* ; "ctrl and upper are slugged") (GACHA (* ; "ctrl and upper are slugged")
@@ -1353,8 +1352,10 @@
(Circumflex Uparrow))) (Circumflex Uparrow)))
(PALATINO (APPEND (XCCS.CS0.UNDEFINED) (PALATINO (APPEND (XCCS.CS0.UNDEFINED)
PALATINOTOMCCS)) PALATINOTOMCCS))
(for C M from 0 to \MAXTHINCHAR when (SETQ M (APPLY* FN C NONIDENTITY)) (PROGN (SETQ KEEPCS0 T)
collect (LIST C M] (for C M from 0 to \MAXTHINCHAR
when (SETQ M (APPLY* FN C NONIDENTITY))
collect (LIST C M]
(* ;; "Weed out interspersed comments, convert to charcodes") (* ;; "Weed out interspersed comments, convert to charcodes")
@@ -1375,10 +1376,16 @@
(CADR P) (CADR P)
(CHARCODE.DECODE (CADR P)))] (CHARCODE.DECODE (CADR P)))]
(* ;; (* ;; "Any character that is moved gets replaced by a slug. It may then be coerced from another font. But families like SYMBOL, HIPPO etc. want to preserve CS0 even if they copy their glyphs also to somewhere else.")
 "Any character that is moved gets replaced by a slug. It may then be coerced from another font.")
[APPEND PAIRS (for P in PAIRS when (CAR P) collect (LIST NIL (CAR P])]) [APPEND PAIRS (for P in PAIRS when (CAR P)
unless [OR (AND KEEPCS0 (ILEQ (CAR P)
\MAXTHINCHAR))
(AND (LISTP (CAR P))
(LITATOM (CADAR P)))
(thereis X in PAIRS suchthat (EQ (CADR X)
(CAR P]
collect (LIST NIL (CAR P])])
(XCCS.CS0.UNDEFINED (XCCS.CS0.UNDEFINED
[LAMBDA NIL (* ; "Edited 5-Oct-2025 22:44 by rmk") [LAMBDA NIL (* ; "Edited 5-Oct-2025 22:44 by rmk")
@@ -1490,15 +1497,15 @@
PCODE]) PCODE])
) )
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (3015 14586 (\MCCSINCCODE 3025 . 6113) (\MCCSPEEKCCODE 6115 . 9002) (\MCCSOUTCHAR 9004 (FILEMAP (NIL (2856 14427 (\MCCSINCCODE 2866 . 5954) (\MCCSPEEKCCODE 5956 . 8843) (\MCCSOUTCHAR 8845
. 11103) (\MCCSBACKCCODE 11105 . 12649) (\MCCSFORMATBYTESTREAM 12651 . 13381) (\MCCSCHARSETFN 13383 . 10944) (\MCCSBACKCCODE 10946 . 12490) (\MCCSFORMATBYTESTREAM 12492 . 13222) (\MCCSCHARSETFN 13224
. 14584)) (14587 15469 (\CREATE.MCCS.EXTERNALFORMAT 14597 . 15467)) (15470 16447 ( . 14425)) (14428 15310 (\CREATE.MCCS.EXTERNALFORMAT 14438 . 15308)) (15311 16288 (
\MCCS.24BITENCODING.ERROR 15480 . 16445)) (17823 20461 (MTOXCODE 17833 . 18630) (XTOMCODE 18632 . \MCCS.24BITENCODING.ERROR 15321 . 16286)) (17664 20302 (MTOXCODE 17674 . 18471) (XTOMCODE 18473 .
19289) (XTOMSTRING 19291 . 19876) (MTOXSTRING 19878 . 20459)) (20462 22122 (MTOX$CODE 20472 . 21204) ( 19130) (XTOMSTRING 19132 . 19717) (MTOXSTRING 19719 . 20300)) (20303 21963 (MTOX$CODE 20313 . 21045) (
X$TOMCODE 21206 . 22120)) (22123 22763 (KANJICHARSETP 22133 . 22389) (CHINESECHARSETP 22391 . 22761)) X$TOMCODE 21047 . 21961)) (21964 22604 (KANJICHARSETP 21974 . 22230) (CHINESECHARSETP 22232 . 22602))
(43331 45205 (MCCSCODEMAPARRAY 43341 . 45203)) (45821 51491 (MCCSMAPFN 45831 . 47198) (MCCSMAPPAIRS (43172 45046 (MCCSCODEMAPARRAY 43182 . 45044)) (45662 52143 (MCCSMAPFN 45672 . 47039) (MCCSMAPPAIRS
47200 . 50497) (XCCS.CS0.UNDEFINED 50499 . 51128) (XCCSUNDEFINEDPAIRS 51130 . 51489)) (51596 56348 ( 47041 . 51149) (XCCS.CS0.UNDEFINED 51151 . 51780) (XCCSUNDEFINEDPAIRS 51782 . 52141)) (52248 57000 (
GACHATOMCODE 51606 . 52118) (SYMBOLTOMCODE 52120 . 52768) (SIGMATOMCODE 52770 . 53416) (ATOMCODE 53418 GACHATOMCODE 52258 . 52770) (SYMBOLTOMCODE 52772 . 53420) (SIGMATOMCODE 53422 . 54068) (ATOMCODE 54070
. 53950) (MATHTOMCODE 53952 . 54608) (HIPPOTOMCODE 54610 . 55147) (CYRILLICTOMCODE 55149 . 55583) ( . 54602) (MATHTOMCODE 54604 . 55260) (HIPPOTOMCODE 55262 . 55799) (CYRILLICTOMCODE 55801 . 56235) (
PALATINOTOMCODE 55585 . 56346))))) PALATINOTOMCODE 56237 . 56998)))))
STOP STOP

BIN
sources/MCCS.LCOM
View File

Binary file not shown.

56
sources/MEDLEYFONTFORMAT
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Sep-2025 11:43:26" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;240 58467 (FILECREATED " 9-Oct-2025 15:20:59" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;242 59604
:EDIT-BY rmk :EDIT-BY rmk
:CHANGES-TO (FNS MEDLEYFONT.WRITE.CHARSET MEDLEYFONT.READ.CHARSET MEDLEYFONT.FILENAME) :CHANGES-TO (FNS MEDLEYFONT.GETCHARSET)
:PREVIOUS-DATE " 3-Sep-2025 11:32:20" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;235) :PREVIOUS-DATE " 7-Oct-2025 12:43:33" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;241)
(PRETTYCOMPRINT MEDLEYFONTFORMATCOMS) (PRETTYCOMPRINT MEDLEYFONTFORMATCOMS)
@@ -129,7 +129,8 @@
(FULLNAME STREAM]) (FULLNAME STREAM])
(MEDLEYFONT.GETCHARSET (MEDLEYFONT.GETCHARSET
[LAMBDA (STREAM CHARSET FONT) (* ; "Edited 3-Sep-2025 11:32 by rmk") [LAMBDA (STREAM CHARSET FONT) (* ; "Edited 9-Oct-2025 15:18 by rmk")
(* ; "Edited 3-Sep-2025 11:32 by rmk")
(* ; "Edited 15-Jul-2025 17:09 by rmk") (* ; "Edited 15-Jul-2025 17:09 by rmk")
(* ; "Edited 9-Jul-2025 15:45 by rmk") (* ; "Edited 9-Jul-2025 15:45 by rmk")
(* ; "Edited 14-May-2025 17:46 by rmk") (* ; "Edited 14-May-2025 17:46 by rmk")
@@ -147,8 +148,23 @@
(ERROR "NOT A MEDLEYFONT FILE" (FULLNAME STREAM)))) (ERROR "NOT A MEDLEYFONT FILE" (FULLNAME STREAM))))
(LET ((CSVECTORLOC (\FIXPIN STREAM)) (LET ((CSVECTORLOC (\FIXPIN STREAM))
CSLOC) CSLOC)
(MEDLEYFONT.READ.VERIFIEDFONT STREAM FONT) (* ; (if (thereis CS from 0 to \MAXTHINCHAR suchthat (\GETCHARSETINFO FONT CS))
 "Maybe only for the first character set?") then
(* ;; "Font fields have been initialized, just update for this charset")
(for P VAL in (MEDLEYFONT.READ.FONTPROPS STREAM)
do (SETQ VAL (CADR P))
(SELECTQ (CAR VAL)
(\SFAscent (change (fetch (FONTDESCRIPTOR \SFAscent) of FONT)
(IMAX VAL DATUM)))
(\SFDescent (change (fetch (FONTDESCRIPTOR \SFDescent) of FONT)
(IMAX VAL DATUM)))
(\SFHeight (fetch (FONTDESCRIPTOR \SFHeight) of FONT))
NIL))
else
(* ;; "First charset, probably 0: establish the overall font properties. ")
(MEDLEYFONT.READ.VERIFIEDFONT STREAM FONT))
(replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with NIL) (replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with NIL)
(* ;; (* ;;
@@ -826,7 +842,8 @@
(DEFINEQ (DEFINEQ
(MEDLEYFONT.FILENAME (MEDLEYFONT.FILENAME
[LAMBDA (FONT CHARSET EXTENSION FILE) (* ; "Edited 4-Sep-2025 08:48 by rmk") [LAMBDA (FONT CHARSET EXTENSION DIRECTORY) (* ; "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 10-Jun-2025 11:02 by rmk")
(* ; "Edited 25-May-2025 21:25 by rmk") (* ; "Edited 25-May-2025 21:25 by rmk")
(* ; "Edited 19-May-2025 17:42 by rmk") (* ; "Edited 19-May-2025 17:42 by rmk")
@@ -840,10 +857,11 @@
(\FONT.CHECKARGS FONT))) (\FONT.CHECKARGS FONT)))
(CL:UNLESS EXTENSION (CL:UNLESS EXTENSION
(SETQ EXTENSION (CONCAT "MEDLEY" (U-CASE DEVICE) (SETQ EXTENSION (CONCAT "MEDLEY" (U-CASE DEVICE)
"FONT")) "FONT")))
(CL:UNLESS FILE (CL:UNLESS DIRECTORY
[SETQ FILE (PSEUDOFILENAME (MEDLEYDIR (CONCAT "fonts/" (L-CASE EXTENSION) [SETQ DIRECTORY (PSEUDOFILENAME (CONCAT (MEDLEYDIR)
"s"])) (CONCAT "fonts/" (L-CASE EXTENSION)
"s"])
(SETQ FILENAME (PACK* FAMILY (CL:IF (ILEQ SIZE 9) (SETQ FILENAME (PACK* FAMILY (CL:IF (ILEQ SIZE 9)
"0" "0"
"") "")
@@ -852,7 +870,7 @@
(CONCAT "-C" (OCTALSTRING CHARSET)) (CONCAT "-C" (OCTALSTRING CHARSET))
"") "")
"." EXTENSION)) "." EXTENSION))
(PACKFILENAME 'BODY FILE 'BODY FILENAME]) (CONCAT DIRECTORY ">" FILENAME])
) )
(ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT) (ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT)
@@ -903,11 +921,11 @@
) )
) )
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (2175 15697 (MEDLEYFONT.WRITE.FONT 2185 . 7151) (MEDLEYFONT.GETCHARSET 7153 . 10156) ( (FILEMAP (NIL (2128 16674 (MEDLEYFONT.WRITE.FONT 2138 . 7104) (MEDLEYFONT.GETCHARSET 7106 . 11133) (
MEDLEYFONT.CHARSET? 10158 . 11627) (MEDLEYFONT.GETFILEPROP 11629 . 13729) (MEDLEYFONT.FILEP 13731 . MEDLEYFONT.CHARSET? 11135 . 12604) (MEDLEYFONT.GETFILEPROP 12606 . 14706) (MEDLEYFONT.FILEP 14708 .
15695)) (15723 37913 (MEDLEYFONT.READ.FONT 15733 . 20165) (MEDLEYFONT.READ.CHARSET 20167 . 25525) ( 16672)) (16700 38890 (MEDLEYFONT.READ.FONT 16710 . 21142) (MEDLEYFONT.READ.CHARSET 21144 . 26502) (
MEDLEYFONT.READ.ITEM 25527 . 31676) (MEDLEYFONT.PEEK.ITEM 31678 . 32540) (MEDLEYFONT.READ.FONTPROPS MEDLEYFONT.READ.ITEM 26504 . 32653) (MEDLEYFONT.PEEK.ITEM 32655 . 33517) (MEDLEYFONT.READ.FONTPROPS
32542 . 33007) (MEDLEYFONT.READ.VERIFIEDFONT 33009 . 37911)) (37939 55776 (MEDLEYFONT.WRITE.CHARSET 33519 . 33984) (MEDLEYFONT.READ.VERIFIEDFONT 33986 . 38888)) (38916 56753 (MEDLEYFONT.WRITE.CHARSET
37949 . 42511) (MEDLEYFONT.WRITE.ITEM 42513 . 51566) (MEDLEYFONT.WRITE.FONTPROPS 51568 . 55121) ( 38926 . 43488) (MEDLEYFONT.WRITE.ITEM 43490 . 52543) (MEDLEYFONT.WRITE.FONTPROPS 52545 . 56098) (
MEDLEYFONT.WRITE.HEADER 55123 . 55774)) (55777 57582 (MEDLEYFONT.FILENAME 55787 . 57580))))) MEDLEYFONT.WRITE.HEADER 56100 . 56751)) (56754 58719 (MEDLEYFONT.FILENAME 56764 . 58717)))))
STOP STOP

BIN
sources/MEDLEYFONTFORMAT.LCOM
View File

Binary file not shown.