github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-03-23 01:26:10 +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)
(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
:CHANGES-TO (FNS \CREATECHARSET.DISPLAY \COERCECHARSET COERCEFONTSPEC)
(VARS FONTCOMS NSFONTFAMILIES)
:CHANGES-TO (FNS \CREATECHARSET.DISPLAY COMPLETE.FONT \COERCECHARSET)
(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)
@@ -80,7 +81,7 @@
(PROP ARGNAMES CHARSETPROP)
(CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR))
(SLUGCHARSET (ADD1 \MAXCHARSET)))
(MACROS LEGACYFONT))
(MACROS LEGACYFONTS))
(MACROS INDIRECTCHARSETP))
(FNS FONTDESCRIPTOR.DEFPRINT FONTCLASS.DEFPRINT)
(INITRECORDS FONTCLASS FONTDESCRIPTOR CHARSETINFO)
@@ -1107,7 +1108,8 @@
(DEFINEQ
(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 27-Aug-2025 10:51 by rmk")
(* ; "Edited 21-Jun-2025 11:37 by rmk")
@@ -1906,12 +1908,13 @@
(RETURN (CAR $$VAL)))])
(\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*)
THEN (\FONTFILENAME.OLD FAMILY SIZE FACE EXT
'ALL)
'NOCHARSET)
ELSE (\FONTFILENAME FAMILY SIZE FACE EXT
'ALL]
'NOCHARSET]
(for EXT inside EXTENSIONS collect (IF (FMEMB EXT *OLD-FONT-EXTENSIONS*)
THEN (\FONTFILENAME.OLD FAMILY SIZE FACE EXT 0)
ELSE (\FONTFILENAME FAMILY SIZE FACE EXT 0])
@@ -2384,7 +2387,7 @@
(SHOULDNT])
(\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 28-Aug-2025 23:07 by rmk")
(* ; "Edited 27-Aug-2025 17:08 by rmk")
@@ -3398,17 +3401,16 @@
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS LEGACYFONT MACRO ((FORM) (* ;
 "Execute FORM in a non-medleyfont displayfont environment")
(RESETVARS (\FONTSINCORE \FONTEXISTS?-CACHE DISPLAYFONTCOERCIONS
DISPLAYCHARCOERCIONS (DISPLAYFONTEXTENSIONS
'(DISPLAYFONT))
(DISPLAYFONTDIRECTORIES (MEDLEYDIR
"fonts>displayfonts>"))
(DISPLAYCHARSETFNS (REMOVE (ASSOC 'MEDLEYFONT
DISPLAYCHARSETFNS)
DISPLAYCHARSETFNS)))
(RETURN FORM))))
(PUTPROPS LEGACYFONTS MACRO ((F . FORMS) (* ;
 "Execute FORMS in a legacy font environment")
(RESETLST
(RESETSAVE \FONTSINCORE NIL)
(RESETSAVE \FONTEXISTS?-CACHE)
(RESETSAVE DISPLAYFONTCOERCIONS)
(RESETSAVE DISPLAYCHARCOERCIONS)
(RESETSAVE DISPLAYFONTEXTENSIONS '(DISPLAYFONT))
(RESETSAVE DISPLAYFONTDIRECTORIES (MEDLEYDIR "fonts>displayfonts>"))
(PROGN F . FORMS))))
)
(* "END EXPORTED DEFINITIONS")
@@ -3827,7 +3829,7 @@
FONTDEVICESPEC _ (create FONTSPEC using FONTSPEC])
(\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 30-Aug-2025 19:42 by rmk")
(* ; "Edited 28-Aug-2025 23:08 by rmk")
@@ -4625,43 +4627,43 @@
(ADDTOVAR LAMA FONTCOPY)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (12161 21874 (CHARWIDTH 12171 . 12956) (CHARWIDTHY 12958 . 14475) (STRINGWIDTH 14477 .
15570) (\CHARWIDTH.DISPLAY 15572 . 15985) (\STRINGWIDTH.DISPLAY 15987 . 16411) (\STRINGWIDTH.GENERIC
16413 . 21872)) (21875 28395 (DEFAULTFONT 21885 . 23170) (FONTCLASS 23172 . 25334) (FONTCLASSUNPARSE
25336 . 26235) (FONTCLASSCOMPONENT 26237 . 26825) (SETFONTCLASSCOMPONENT 26827 . 27269) (
GETFONTCLASSCOMPONENT 27271 . 28393)) (30074 54455 (FONTCREATE 30084 . 33329) (FONTCREATE1 33331 .
35946) (FONTCREATE.SLUGFD 35948 . 37430) (\FONT.CHECKARGS 37432 . 44022) (\FONT.CHECKARGS1 44024 .
48547) (\FONTCREATE1.NOFN 48549 . 48763) (FONTFILEP 48765 . 49653) (\READCHARSET 49655 . 54453)) (
54456 61373 (\FONT.CHECKARGS 54466 . 61056) (\CHARSET.CHECK 61058 . 61371)) (61374 64457 (
COERCEFONTSPEC 61384 . 64455)) (66527 67317 (MAKEFONTSPEC 66537 . 67315)) (67318 73983 (COMPLETE.FONT
67328 . 69742) (COMPLETEFONTP 69744 . 70367) (COMPLETE.CHARSET 70369 . 73054) (PRUNESLUGCSINFOS 73056
. 73981)) (74022 81943 (FONTASCENT 74032 . 74416) (FONTDESCENT 74418 . 74903) (FONTHEIGHT 74905 .
75307) (FONTPROP 75309 . 81220) (\AVGCHARWIDTH 81222 . 81941)) (82600 83508 (FONTDEVICEPROP 82610 .
83506)) (83554 84408 (EDITCHAR 83564 . 84406)) (84454 96644 (GETCHARBITMAP 84464 . 85588) (
PUTCHARBITMAP 85590 . 87748) (\GETCHARBITMAP.CSINFO 87750 . 89766) (\PUTCHARBITMAP.CSINFO 89768 .
96642)) (96645 117125 (MOVECHARBITMAP 96655 . 98549) (MOVEFONTCHARS 98551 . 102511) (\MOVEFONTCHAR
102513 . 107356) (\MOVEFONTCHARS.SOURCEDATA 107358 . 113463) (\MAKESLUGCHAR 113465 . 116000) (
SLUGCHARP.DISPLAY 116002 . 117123)) (118058 138075 (FONTFILES 118068 . 119901) (\FINDFONTFILE 119903
. 121620) (\FONTFILENAMES 121622 . 122496) (\FONTFILENAME 122498 . 126481) (\FONTFILENAME.OLD 126483
. 129432) (\FONTFILENAME.NEW 129434 . 131691) (FONTSPECFROMFILENAME 131693 . 135794) (
\FONTINFOFROMFILENAME.OLD 135796 . 138073)) (138342 174145 (FONTCOPY 138352 . 143415) (FONTP 143417 .
143716) (FONTUNPARSE 143718 . 145437) (SETFONTDESCRIPTOR 145439 . 146903) (\STREAMCHARWIDTH 146905 .
151069) (\COERCECHARSET 151071 . 153666) (\BUILDSLUGCSINFO 153668 . 157291) (\FONTSYMBOL 157293 .
157943) (\DEVICESYMBOL 157945 . 158814) (\FONTFACE 158816 . 166006) (\FONTFACE.COLOR 166008 . 172928)
(SETFONTCHARENCODING 172930 . 174143)) (174146 194697 (FONTSAVAILABLE 174156 . 179011) (FONTEXISTS?
179013 . 182991) (\SEARCHFONTFILES 182993 . 186078) (FLUSHFONTSINCORE 186080 . 189253) (FINDFONTFILES
189255 . 192469) (SORTFONTSPECS 192471 . 194695)) (194698 198121 (MATCHFONTFACE 194708 . 195523) (
MAKEFONTFACE 195525 . 196365) (FONTFACETOATOM 196367 . 198119)) (198349 198841 (\UNITWIDTHSVECTOR
198359 . 198839)) (214441 216508 (FONTDESCRIPTOR.DEFPRINT 214451 . 216030) (FONTCLASS.DEFPRINT 216032
. 216506)) (220337 223127 (\CREATEKERNELEMENT 220347 . 220705) (\FSETLEFTKERN 220707 . 221198) (
\FGETLEFTKERN 221200 . 223125)) (223128 232764 (\CREATEFONT 223138 . 224577) (\CREATECHARSET 224579 .
228515) (\INSTALLCHARSETINFO 228517 . 231851) (\INSTALLCHARSETINFO.CHARENCODING 231853 . 232762)) (
233086 234450 (\FONTRESETCHARWIDTHS 233096 . 234448)) (235080 245127 (\CREATEDISPLAYFONT 235090 .
236939) (\CREATECHARSET.DISPLAY 236941 . 242650) (\FONTEXISTS?.DISPLAY 242652 . 245125)) (245128
259993 (STRIKEFONT.FILEP 245138 . 246026) (STRIKEFONT.GETCHARSET 246028 . 251620) (WRITESTRIKEFONTFILE
251622 . 256533) (STRIKECSINFO 256535 . 259991)) (260024 276341 (MAKEBOLD.CHARSET 260034 . 263683) (
MAKEBOLD.CHAR 263685 . 265437) (MAKEITALIC.CHARSET 265439 . 269112) (MAKEITALIC.CHAR 269114 . 271460)
(\SFMAKEBOLD 271462 . 273686) (\SFMAKEITALIC 273688 . 276339)) (276342 280491 (\SFMAKEROTATEDFONT
276352 . 277753) (\SFROTATECSINFO 277755 . 278392) (\SFROTATEFONTCHARACTERS 278394 . 278774) (
\SFROTATECSINFOOFFSETS 278776 . 280489)) (280492 281873 (\SFMAKECOLOR 280502 . 281871)))))
(FILEMAP (NIL (12196 21909 (CHARWIDTH 12206 . 12991) (CHARWIDTHY 12993 . 14510) (STRINGWIDTH 14512 .
15605) (\CHARWIDTH.DISPLAY 15607 . 16020) (\STRINGWIDTH.DISPLAY 16022 . 16446) (\STRINGWIDTH.GENERIC
16448 . 21907)) (21910 28430 (DEFAULTFONT 21920 . 23205) (FONTCLASS 23207 . 25369) (FONTCLASSUNPARSE
25371 . 26270) (FONTCLASSCOMPONENT 26272 . 26860) (SETFONTCLASSCOMPONENT 26862 . 27304) (
GETFONTCLASSCOMPONENT 27306 . 28428)) (30109 54490 (FONTCREATE 30119 . 33364) (FONTCREATE1 33366 .
35981) (FONTCREATE.SLUGFD 35983 . 37465) (\FONT.CHECKARGS 37467 . 44057) (\FONT.CHECKARGS1 44059 .
48582) (\FONTCREATE1.NOFN 48584 . 48798) (FONTFILEP 48800 . 49688) (\READCHARSET 49690 . 54488)) (
54491 61408 (\FONT.CHECKARGS 54501 . 61091) (\CHARSET.CHECK 61093 . 61406)) (61409 64492 (
COERCEFONTSPEC 61419 . 64490)) (66562 67352 (MAKEFONTSPEC 66572 . 67350)) (67353 74127 (COMPLETE.FONT
67363 . 69886) (COMPLETEFONTP 69888 . 70511) (COMPLETE.CHARSET 70513 . 73198) (PRUNESLUGCSINFOS 73200
. 74125)) (74166 82087 (FONTASCENT 74176 . 74560) (FONTDESCENT 74562 . 75047) (FONTHEIGHT 75049 .
75451) (FONTPROP 75453 . 81364) (\AVGCHARWIDTH 81366 . 82085)) (82744 83652 (FONTDEVICEPROP 82754 .
83650)) (83698 84552 (EDITCHAR 83708 . 84550)) (84598 96788 (GETCHARBITMAP 84608 . 85732) (
PUTCHARBITMAP 85734 . 87892) (\GETCHARBITMAP.CSINFO 87894 . 89910) (\PUTCHARBITMAP.CSINFO 89912 .
96786)) (96789 117269 (MOVECHARBITMAP 96799 . 98693) (MOVEFONTCHARS 98695 . 102655) (\MOVEFONTCHAR
102657 . 107500) (\MOVEFONTCHARS.SOURCEDATA 107502 . 113607) (\MAKESLUGCHAR 113609 . 116144) (
SLUGCHARP.DISPLAY 116146 . 117267)) (118202 138340 (FONTFILES 118212 . 120045) (\FINDFONTFILE 120047
. 121764) (\FONTFILENAMES 121766 . 122761) (\FONTFILENAME 122763 . 126746) (\FONTFILENAME.OLD 126748
. 129697) (\FONTFILENAME.NEW 129699 . 131956) (FONTSPECFROMFILENAME 131958 . 136059) (
\FONTINFOFROMFILENAME.OLD 136061 . 138338)) (138607 174410 (FONTCOPY 138617 . 143680) (FONTP 143682 .
143981) (FONTUNPARSE 143983 . 145702) (SETFONTDESCRIPTOR 145704 . 147168) (\STREAMCHARWIDTH 147170 .
151334) (\COERCECHARSET 151336 . 153931) (\BUILDSLUGCSINFO 153933 . 157556) (\FONTSYMBOL 157558 .
158208) (\DEVICESYMBOL 158210 . 159079) (\FONTFACE 159081 . 166271) (\FONTFACE.COLOR 166273 . 173193)
(SETFONTCHARENCODING 173195 . 174408)) (174411 194962 (FONTSAVAILABLE 174421 . 179276) (FONTEXISTS?
179278 . 183256) (\SEARCHFONTFILES 183258 . 186343) (FLUSHFONTSINCORE 186345 . 189518) (FINDFONTFILES
189520 . 192734) (SORTFONTSPECS 192736 . 194960)) (194963 198386 (MATCHFONTFACE 194973 . 195788) (
MAKEFONTFACE 195790 . 196630) (FONTFACETOATOM 196632 . 198384)) (198614 199106 (\UNITWIDTHSVECTOR
198624 . 199104)) (214449 216516 (FONTDESCRIPTOR.DEFPRINT 214459 . 216038) (FONTCLASS.DEFPRINT 216040
. 216514)) (220345 223135 (\CREATEKERNELEMENT 220355 . 220713) (\FSETLEFTKERN 220715 . 221206) (
\FGETLEFTKERN 221208 . 223133)) (223136 232772 (\CREATEFONT 223146 . 224585) (\CREATECHARSET 224587 .
228523) (\INSTALLCHARSETINFO 228525 . 231859) (\INSTALLCHARSETINFO.CHARENCODING 231861 . 232770)) (
233094 234458 (\FONTRESETCHARWIDTHS 233104 . 234456)) (235088 245135 (\CREATEDISPLAYFONT 235098 .
236947) (\CREATECHARSET.DISPLAY 236949 . 242658) (\FONTEXISTS?.DISPLAY 242660 . 245133)) (245136
260001 (STRIKEFONT.FILEP 245146 . 246034) (STRIKEFONT.GETCHARSET 246036 . 251628) (WRITESTRIKEFONTFILE
251630 . 256541) (STRIKECSINFO 256543 . 259999)) (260032 276349 (MAKEBOLD.CHARSET 260042 . 263691) (
MAKEBOLD.CHAR 263693 . 265445) (MAKEITALIC.CHARSET 265447 . 269120) (MAKEITALIC.CHAR 269122 . 271468)
(\SFMAKEBOLD 271470 . 273694) (\SFMAKEITALIC 273696 . 276347)) (276350 280499 (\SFMAKEROTATEDFONT
276360 . 277761) (\SFROTATECSINFO 277763 . 278400) (\SFROTATEFONTCHARACTERS 278402 . 278782) (
\SFROTATECSINFOOFFSETS 278784 . 280497)) (280500 281881 (\SFMAKECOLOR 280510 . 281879)))))
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)
(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
:CHANGES-TO (VARS PALATINOTOMCCS MCCSCOMS)
(FNS MCCSMAPPAIRS XCCS.CS0.UNDEFINED XCCSUNDEFINEDPAIRS XCCSUNDEFINEDCONTROLS
PALATINOTOMCODE MCCSMAPFN)
:CHANGES-TO (FNS MCCSMAPPAIRS)
: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)
@@ -1329,7 +1327,8 @@
NIL])
(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 6-Sep-2025 16:43 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.")
(LET ((FN (MCCSMAPFN FROMENCODING))
PAIRS)
PAIRS KEEPCS0)
(CL:WHEN FN
[SETQ PAIRS (SELECTQ FROMENCODING
(GACHA (* ; "ctrl and upper are slugged")
@@ -1353,8 +1352,10 @@
(Circumflex Uparrow)))
(PALATINO (APPEND (XCCS.CS0.UNDEFINED)
PALATINOTOMCCS))
(for C M from 0 to \MAXTHINCHAR when (SETQ M (APPLY* FN C NONIDENTITY))
collect (LIST C M]
(PROGN (SETQ KEEPCS0 T)
(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")
@@ -1375,10 +1376,16 @@
(CADR P)
(CHARCODE.DECODE (CADR P)))]
(* ;;
 "Any character that is moved gets replaced by a slug. It may then be coerced from another font.")
(* ;; "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.")
[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
[LAMBDA NIL (* ; "Edited 5-Oct-2025 22:44 by rmk")
@@ -1490,15 +1497,15 @@
PCODE])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3015 14586 (\MCCSINCCODE 3025 . 6113) (\MCCSPEEKCCODE 6115 . 9002) (\MCCSOUTCHAR 9004
. 11103) (\MCCSBACKCCODE 11105 . 12649) (\MCCSFORMATBYTESTREAM 12651 . 13381) (\MCCSCHARSETFN 13383
. 14584)) (14587 15469 (\CREATE.MCCS.EXTERNALFORMAT 14597 . 15467)) (15470 16447 (
\MCCS.24BITENCODING.ERROR 15480 . 16445)) (17823 20461 (MTOXCODE 17833 . 18630) (XTOMCODE 18632 .
19289) (XTOMSTRING 19291 . 19876) (MTOXSTRING 19878 . 20459)) (20462 22122 (MTOX$CODE 20472 . 21204) (
X$TOMCODE 21206 . 22120)) (22123 22763 (KANJICHARSETP 22133 . 22389) (CHINESECHARSETP 22391 . 22761))
(43331 45205 (MCCSCODEMAPARRAY 43341 . 45203)) (45821 51491 (MCCSMAPFN 45831 . 47198) (MCCSMAPPAIRS
47200 . 50497) (XCCS.CS0.UNDEFINED 50499 . 51128) (XCCSUNDEFINEDPAIRS 51130 . 51489)) (51596 56348 (
GACHATOMCODE 51606 . 52118) (SYMBOLTOMCODE 52120 . 52768) (SIGMATOMCODE 52770 . 53416) (ATOMCODE 53418
. 53950) (MATHTOMCODE 53952 . 54608) (HIPPOTOMCODE 54610 . 55147) (CYRILLICTOMCODE 55149 . 55583) (
PALATINOTOMCODE 55585 . 56346)))))
(FILEMAP (NIL (2856 14427 (\MCCSINCCODE 2866 . 5954) (\MCCSPEEKCCODE 5956 . 8843) (\MCCSOUTCHAR 8845
. 10944) (\MCCSBACKCCODE 10946 . 12490) (\MCCSFORMATBYTESTREAM 12492 . 13222) (\MCCSCHARSETFN 13224
. 14425)) (14428 15310 (\CREATE.MCCS.EXTERNALFORMAT 14438 . 15308)) (15311 16288 (
\MCCS.24BITENCODING.ERROR 15321 . 16286)) (17664 20302 (MTOXCODE 17674 . 18471) (XTOMCODE 18473 .
19130) (XTOMSTRING 19132 . 19717) (MTOXSTRING 19719 . 20300)) (20303 21963 (MTOX$CODE 20313 . 21045) (
X$TOMCODE 21047 . 21961)) (21964 22604 (KANJICHARSETP 21974 . 22230) (CHINESECHARSETP 22232 . 22602))
(43172 45046 (MCCSCODEMAPARRAY 43182 . 45044)) (45662 52143 (MCCSMAPFN 45672 . 47039) (MCCSMAPPAIRS
47041 . 51149) (XCCS.CS0.UNDEFINED 51151 . 51780) (XCCSUNDEFINEDPAIRS 51782 . 52141)) (52248 57000 (
GACHATOMCODE 52258 . 52770) (SYMBOLTOMCODE 52772 . 53420) (SIGMATOMCODE 53422 . 54068) (ATOMCODE 54070
. 54602) (MATHTOMCODE 54604 . 55260) (HIPPOTOMCODE 55262 . 55799) (CYRILLICTOMCODE 55801 . 56235) (
PALATINOTOMCODE 56237 . 56998)))))
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)
(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
: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)
@@ -129,7 +129,8 @@
(FULLNAME STREAM])
(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 9-Jul-2025 15:45 by rmk")
(* ; "Edited 14-May-2025 17:46 by rmk")
@@ -147,8 +148,23 @@
(ERROR "NOT A MEDLEYFONT FILE" (FULLNAME STREAM))))
(LET ((CSVECTORLOC (\FIXPIN STREAM))
CSLOC)
(MEDLEYFONT.READ.VERIFIEDFONT STREAM FONT) (* ;
 "Maybe only for the first character set?")
(if (thereis CS from 0 to \MAXTHINCHAR suchthat (\GETCHARSETINFO FONT CS))
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)
(* ;;
@@ -826,7 +842,8 @@
(DEFINEQ
(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 25-May-2025 21:25 by rmk")
(* ; "Edited 19-May-2025 17:42 by rmk")
@@ -840,10 +857,11 @@
(\FONT.CHECKARGS FONT)))
(CL:UNLESS EXTENSION
(SETQ EXTENSION (CONCAT "MEDLEY" (U-CASE DEVICE)
"FONT"))
(CL:UNLESS FILE
[SETQ FILE (PSEUDOFILENAME (MEDLEYDIR (CONCAT "fonts/" (L-CASE EXTENSION)
"s"]))
"FONT")))
(CL:UNLESS DIRECTORY
[SETQ DIRECTORY (PSEUDOFILENAME (CONCAT (MEDLEYDIR)
(CONCAT "fonts/" (L-CASE EXTENSION)
"s"])
(SETQ FILENAME (PACK* FAMILY (CL:IF (ILEQ SIZE 9)
"0"
"")
@@ -852,7 +870,7 @@
(CONCAT "-C" (OCTALSTRING CHARSET))
"")
"." EXTENSION))
(PACKFILENAME 'BODY FILE 'BODY FILENAME])
(CONCAT DIRECTORY ">" FILENAME])
)
(ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT)
@@ -903,11 +921,11 @@
)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2175 15697 (MEDLEYFONT.WRITE.FONT 2185 . 7151) (MEDLEYFONT.GETCHARSET 7153 . 10156) (
MEDLEYFONT.CHARSET? 10158 . 11627) (MEDLEYFONT.GETFILEPROP 11629 . 13729) (MEDLEYFONT.FILEP 13731 .
15695)) (15723 37913 (MEDLEYFONT.READ.FONT 15733 . 20165) (MEDLEYFONT.READ.CHARSET 20167 . 25525) (
MEDLEYFONT.READ.ITEM 25527 . 31676) (MEDLEYFONT.PEEK.ITEM 31678 . 32540) (MEDLEYFONT.READ.FONTPROPS
32542 . 33007) (MEDLEYFONT.READ.VERIFIEDFONT 33009 . 37911)) (37939 55776 (MEDLEYFONT.WRITE.CHARSET
37949 . 42511) (MEDLEYFONT.WRITE.ITEM 42513 . 51566) (MEDLEYFONT.WRITE.FONTPROPS 51568 . 55121) (
MEDLEYFONT.WRITE.HEADER 55123 . 55774)) (55777 57582 (MEDLEYFONT.FILENAME 55787 . 57580)))))
(FILEMAP (NIL (2128 16674 (MEDLEYFONT.WRITE.FONT 2138 . 7104) (MEDLEYFONT.GETCHARSET 7106 . 11133) (
MEDLEYFONT.CHARSET? 11135 . 12604) (MEDLEYFONT.GETFILEPROP 12606 . 14706) (MEDLEYFONT.FILEP 14708 .
16672)) (16700 38890 (MEDLEYFONT.READ.FONT 16710 . 21142) (MEDLEYFONT.READ.CHARSET 21144 . 26502) (
MEDLEYFONT.READ.ITEM 26504 . 32653) (MEDLEYFONT.PEEK.ITEM 32655 . 33517) (MEDLEYFONT.READ.FONTPROPS
33519 . 33984) (MEDLEYFONT.READ.VERIFIEDFONT 33986 . 38888)) (38916 56753 (MEDLEYFONT.WRITE.CHARSET
38926 . 43488) (MEDLEYFONT.WRITE.ITEM 43490 . 52543) (MEDLEYFONT.WRITE.FONTPROPS 52545 . 56098) (
MEDLEYFONT.WRITE.HEADER 56100 . 56751)) (56754 58719 (MEDLEYFONT.FILENAME 56764 . 58717)))))
STOP

BIN
sources/MEDLEYFONTFORMAT.LCOM
View File

Binary file not shown.