github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-03-10 12:58:10 +00:00
Code Issues Projects Releases Wiki Activity

PAIRS arguments of MOVEFONTCHARS can be a hashtable

Browse Source
This commit is contained in:
rmkaplan
2026-03-02 13:19:07 -08:00
parent 0f470b9753
commit 8e94715e22
2 changed files with 101 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files

176
sources/FONT
View File

@@ -1,12 +1,15 @@
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
(FILECREATED "26-Feb-2026 17:01:47" {WMEDLEY}<sources>FONT.;677 278005
(FILECREATED " 2-Mar-2026 13:14:53" {WMEDLEY}<sources>FONT.;685 279368
:EDIT-BY rmk
:CHANGES-TO (FNS MOVEFONTCHARS)
:CHANGES-TO (FNS FONTDEVICEPROP MOVEFONTCHARS)
(VARS FONTCOMS)
(PROPS (FONTDEVICEPROP ARGNAMES))
(RECORDS FONTSPEC)
:PREVIOUS-DATE "20-Feb-2026 12:54:44" {WMEDLEY}<sources>FONT.;675)
:PREVIOUS-DATE "26-Feb-2026 17:01:47" {WMEDLEY}<sources>FONT.;677)
(PRETTYCOMPRINT FONTCOMS)
@@ -38,7 +41,8 @@
(FNS FONTASCENT FONTDESCENT FONTHEIGHT FONTPROP \AVGCHARWIDTH)
(EXPORT (OPTIMIZERS FONTPROP))
(FNS FONTDEVICEPROP))
(FNS FONTDEVICEPROP)
(PROP ARGNAMES FONTDEVICEPROP))
(COMS (* ; "Moving character information")
(FNS EDITCHAR)
(* ; "Should this be on EDITFONT ?")
@@ -194,7 +198,8 @@
(SYMBOL . SY]
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA FONTCOPY])
(LAMA FONTCOPY
FONTDEVICEPROP])
@@ -1289,23 +1294,34 @@
(DEFINEQ
(FONTDEVICEPROP
[LAMBDA (FONTDEVICE PROP) (* ; "Edited 25-Aug-2025 21:23 by rmk")
[LAMBDA NARGS (* ; "Edited 2-Mar-2026 13:14 by rmk")
(* ; "Edited 1-Mar-2026 12:22 by rmk")
(* ; "Edited 25-Aug-2025 21:23 by rmk")
(* ;; "Returns the value of the PROP property of the FONTDEVICE. E.g. if FONTDEVICE is DISPLAY and PROP is %"FONTCOERCIONS%", returns the value of DISPLAYFONTCOERCIONS ((HELVETICA 1)(HELVETICA 4)...)")
[if (LITATOM FONTDEVICE)
then (SETQ FONTDEVICE (\FONTSYMBOL FONTDEVICE))
else (SETQ FONTDEVICE (\FONT.CHECKARGS FONTDEVICE))
(SETQ FONTDEVICE (CL:IF (type? FONTDESCRIPTOR FONTDEVICE)
(FONTPROP FONTDEVICE 'DEVICE)
(fetch (FONTSPEC FSDEVICE) of FONTDEVICE))]
(CL:UNLESS FONTDEVICE
(SETQ FONTDEVICE 'DISPLAY))
(LET ((VAR (PACK* FONTDEVICE PROP)))
(CL:WHEN (BOUNDP VAR)
(GETATOMVAL VAR])
(CL:WHEN (ILESSP NARGS 2)
(ERROR "DEVICE/PROP not specified"))
(LET ((FONTDEVICE (ARG NARGS 1))
(PROP (ARG NARGS 2))
VAR)
[if (LITATOM FONTDEVICE)
then (SETQ FONTDEVICE (\FONTSYMBOL FONTDEVICE))
else (SETQ FONTDEVICE (\FONT.CHECKARGS FONTDEVICE))
(SETQ FONTDEVICE (CL:IF (type? FONTDESCRIPTOR FONTDEVICE)
(FONTPROP FONTDEVICE 'DEVICE)
(fetch (FONTSPEC FSDEVICE) of FONTDEVICE))]
(CL:UNLESS FONTDEVICE
(SETQ FONTDEVICE 'DISPLAY))
(SETQ VAR (PACK* FONTDEVICE PROP))
(PROG1 (CL:WHEN (BOUNDP VAR)
(GETATOMVAL VAR))
(CL:WHEN (IGEQ NARGS 3)
(SETATOMVAL VAR (ARG NARGS 3))))])
)
(PUTPROPS FONTDEVICEPROP ARGNAMES (FONTDEVICE PROP NEWVALUE))
(* ; "Moving character information")
@@ -1550,7 +1566,8 @@
NEWDESCENT])
(MOVEFONTCHARS
[LAMBDA (PAIRS DESTFONT DEFAULTSOURCEFONT) (* ; "Edited 26-Feb-2026 16:59 by rmk")
[LAMBDA (PAIRS DESTFONT DEFAULTSOURCEFONT) (* ; "Edited 1-Mar-2026 09:40 by rmk")
(* ; "Edited 26-Feb-2026 16:59 by rmk")
(* ; "Edited 4-Sep-2025 11:07 by rmk")
(* ; "Edited 30-Aug-2025 23:20 by rmk")
(* ; "Edited 26-Aug-2025 23:10 by rmk")
@@ -1582,27 +1599,34 @@
then
(* ;; "E.g. *UNICODETOMCCS*")
[MAPHASH PAIRS (FUNCTION (LAMBDA (VAL KEY)
(CL:UNLESS (EQ VAL KEY)
(\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA KEY
[MAPHASH PAIRS (FUNCTION (LAMBDA (DCODE SCODE)
(CL:UNLESS (AND (EQ DCODE SCODE)
(EQ DESTFONT DEFAULTSOURCEFONT))
(\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA SCODE
DEFAULTSOURCEFONT)
VAL DESTFONT))]
DCODE DESTFONT))]
else (LET (PAIRINFO)
(* ;; "Fix/check arguments, and expand out the information for all the source characters, so there is no toe-stepping if there are overlaps.")
(SETQ PAIRINFO (for P S DCODE in PAIRS collect (CL:WHEN (SMALLP P)
(SETQ P (LIST P P)))
(SETQ DCODE (CADR P))
(CL:UNLESS (CHARCODEP DCODE)
(SETQ DCODE (CHARCODE.DECODE
DCODE)))
(\INSURECHARSETINFO DESTFONT
(\CHARSET DCODE))
(LIST (\MOVEFONTCHARS.SOURCEDATA
(CAR P)
DEFAULTSOURCEFONT)
DCODE)))
(SETQ PAIRINFO (for P S DCODE in PAIRS
collect (CL:WHEN (SMALLP P)
(SETQ P (LIST P P)))
(SETQ DCODE (CADR P))
(CL:UNLESS (CHARCODEP DCODE)
(SETQ DCODE (CHARCODE.DECODE DCODE)))
(CL:WHEN (AND (EQ DCODE (CHARCODE.DECODE (CAR P)
T))
(EQ DESTFONT DEFAULTSOURCEFONT))
(* ;;
 "Skip the vacuous movement within the same font")
(GO $$ITERATE))
(\INSURECHARSETINFO DESTFONT (\CHARSET DCODE))
(LIST (\MOVEFONTCHARS.SOURCEDATA (CAR P)
DEFAULTSOURCEFONT)
DCODE)))
(* ;; "Install source character information into the destination font. ")
@@ -3095,7 +3119,9 @@
CHARSETNO ← MAX.SMALLP)
(RECORD FONTSPEC (FSFAMILY FSSIZE FSFACE FSROTATION FSDEVICE)
(TYPE? LISTP))
[TYPE? (AND (LISTP DATUM)
(LITATOM (CAR DATUM))
(FIXP (CADR DATUM])
)
(/DECLAREDATATYPE 'FONTCLASS '(BYTE POINTER POINTER POINTER POINTER POINTER)
@@ -4490,46 +4516,46 @@
(ADDTOVAR NLAML )
(ADDTOVAR LAMA FONTCOPY)
(ADDTOVAR LAMA FONTCOPY FONTDEVICEPROP)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (11429 21096 (CHARWIDTH 11439 . 12228) (CHARWIDTHY 12230 . 13747) (STRINGWIDTH 13749 .
14786) (\CHARWIDTH.DISPLAY 14788 . 15203) (\STRINGWIDTH.DISPLAY 15205 . 15633) (\STRINGWIDTH.GENERIC
15635 . 21094)) (21097 27729 (DEFAULTFONT 21107 . 22392) (FONTCLASS 22394 . 24666) (FONTCLASSUNPARSE
24668 . 25569) (FONTCLASSCOMPONENT 25571 . 26159) (SETFONTCLASSCOMPONENT 26161 . 26603) (
GETFONTCLASSCOMPONENT 26605 . 27727)) (29442 47482 (FONTCREATE 29452 . 32697) (FONTCREATE1 32699 .
35314) (FONTCREATE.SLUGFD 35316 . 36820) (\FONT.CHECKARGS1 36822 . 41527) (\FONTCREATE1.NOFN 41529 .
41743) (FONTFILEP 41745 . 42633) (\READCHARSET 42635 . 47480)) (47483 54559 (\FONT.CHECKARGS 47493 .
54242) (\CHARSET.CHECK 54244 . 54557)) (54560 61171 (COERCEFONTSPEC 54570 . 60482) (
COERCEFONTSPEC.TARGETFACE 60484 . 61169)) (63366 64715 (MAKEFONTSPEC 63376 . 64713)) (64716 72893 (
COMPLETE.FONT 64726 . 67249) (COMPLETEFONTP 67251 . 67874) (COMPLETE.CHARSET 67876 . 70561) (
PRUNESLUGCSINFOS 70563 . 71488) (MONOSPACEFONTP 71490 . 72891)) (72932 81390 (FONTASCENT 72942 . 73326
) (FONTDESCENT 73328 . 73813) (FONTHEIGHT 73815 . 74217) (FONTPROP 74219 . 80667) (\AVGCHARWIDTH 80669
. 81388)) (82047 82955 (FONTDEVICEPROP 82057 . 82953)) (83001 83855 (EDITCHAR 83011 . 83853)) (83901
96091 (GETCHARBITMAP 83911 . 85035) (PUTCHARBITMAP 85037 . 87195) (\GETCHARBITMAP.CSINFO 87197 . 89213
) (\PUTCHARBITMAP.CSINFO 89215 . 96089)) (96092 117372 (MOVECHARBITMAP 96102 . 97996) (MOVEFONTCHARS
97998 . 102744) (\MOVEFONTCHAR 102746 . 107593) (\MOVEFONTCHARS.SOURCEDATA 107595 . 113710) (
\MAKESLUGCHAR 113712 . 116247) (SLUGCHARP.DISPLAY 116249 . 117370)) (118030 129879 (FONTFILES 118040
. 119873) (\FINDFONTFILE 119875 . 121852) (\FONTFILENAMES 121854 . 122414) (\FONTFILENAME 122416 .
125327) (FONTSPECFROMFILENAME 125329 . 129877)) (129880 166129 (FONTCOPY 129890 . 134973) (FONTP
134975 . 135274) (FONTUNPARSE 135276 . 136999) (SETFONTDESCRIPTOR 137001 . 138465) (\STREAMCHARWIDTH
138467 . 142478) (\COERCECHARSET 142480 . 145847) (\BUILDSLUGCSINFO 145849 . 149480) (\FONTSYMBOL
149482 . 150136) (\DEVICESYMBOL 150138 . 150922) (\FONTFACE 150924 . 158128) (\FONTFACE.COLOR 158130
. 164912) (SETFONTCHARENCODING 164914 . 166127)) (166130 185807 (FONTSAVAILABLE 166140 . 171504) (
FONTEXISTS? 171506 . 175047) (\SEARCHFONTFILES 175049 . 178136) (FLUSHFONTCACHE 178138 . 180361) (
FINDFONTFILES 180363 . 183579) (SORTFONTSPECS 183581 . 185805)) (185808 189923 (MATCHFONTFACE 185818
. 186633) (MAKEFONTFACE 186635 . 187669) (FONTFACETOATOM 187671 . 189921)) (190554 191046 (
\UNITWIDTHSVECTOR 190564 . 191044)) (205689 207756 (FONTDESCRIPTOR.DEFPRINT 205699 . 207278) (
FONTCLASS.DEFPRINT 207280 . 207754)) (211585 214375 (\CREATEKERNELEMENT 211595 . 211953) (
\FSETLEFTKERN 211955 . 212446) (\FGETLEFTKERN 212448 . 214373)) (214376 226042 (\CREATEFONT 214386 .
217282) (\CREATECHARSET 217284 . 221793) (\INSTALLCHARSETINFO 221795 . 225129) (
\INSTALLCHARSETINFO.CHARENCODING 225131 . 226040)) (226364 227732 (\FONTRESETCHARWIDTHS 226374 .
227730)) (228362 238439 (\CREATEDISPLAYFONT 228372 . 230239) (\CREATECHARSET.DISPLAY 230241 . 235956)
(\FONTEXISTS?.DISPLAY 235958 . 238437)) (238440 253445 (STRIKEFONT.FILEP 238450 . 239338) (
STRIKEFONT.GETCHARSET 239340 . 244934) (WRITESTRIKEFONTFILE 244936 . 249849) (STRIKECSINFO 249851 .
253443)) (253476 269809 (MAKEBOLD.CHARSET 253486 . 257141) (MAKEBOLD.CHAR 257143 . 258895) (
MAKEITALIC.CHARSET 258897 . 262576) (MAKEITALIC.CHAR 262578 . 264924) (\SFMAKEBOLD 264926 . 267152) (
\SFMAKEITALIC 267154 . 269807)) (269810 273834 (\SFMAKEROTATEDFONT 269820 . 271054) (\SFROTATECSINFO
271056 . 271731) (\SFROTATEFONTCHARACTERS 271733 . 272117) (\SFROTATECSINFOOFFSETS 272119 . 273832)) (
273835 275009 (\SFMAKECOLOR 273845 . 275007)))))
(FILEMAP (NIL (11711 21378 (CHARWIDTH 11721 . 12510) (CHARWIDTHY 12512 . 14029) (STRINGWIDTH 14031 .
15068) (\CHARWIDTH.DISPLAY 15070 . 15485) (\STRINGWIDTH.DISPLAY 15487 . 15915) (\STRINGWIDTH.GENERIC
15917 . 21376)) (21379 28011 (DEFAULTFONT 21389 . 22674) (FONTCLASS 22676 . 24948) (FONTCLASSUNPARSE
24950 . 25851) (FONTCLASSCOMPONENT 25853 . 26441) (SETFONTCLASSCOMPONENT 26443 . 26885) (
GETFONTCLASSCOMPONENT 26887 . 28009)) (29724 47764 (FONTCREATE 29734 . 32979) (FONTCREATE1 32981 .
35596) (FONTCREATE.SLUGFD 35598 . 37102) (\FONT.CHECKARGS1 37104 . 41809) (\FONTCREATE1.NOFN 41811 .
42025) (FONTFILEP 42027 . 42915) (\READCHARSET 42917 . 47762)) (47765 54841 (\FONT.CHECKARGS 47775 .
54524) (\CHARSET.CHECK 54526 . 54839)) (54842 61453 (COERCEFONTSPEC 54852 . 60764) (
COERCEFONTSPEC.TARGETFACE 60766 . 61451)) (63648 64997 (MAKEFONTSPEC 63658 . 64995)) (64998 73175 (
COMPLETE.FONT 65008 . 67531) (COMPLETEFONTP 67533 . 68156) (COMPLETE.CHARSET 68158 . 70843) (
PRUNESLUGCSINFOS 70845 . 71770) (MONOSPACEFONTP 71772 . 73173)) (73214 81672 (FONTASCENT 73224 . 73608
) (FONTDESCENT 73610 . 74095) (FONTHEIGHT 74097 . 74499) (FONTPROP 74501 . 80949) (\AVGCHARWIDTH 80951
. 81670)) (82329 83762 (FONTDEVICEPROP 82339 . 83760)) (83879 84733 (EDITCHAR 83889 . 84731)) (84779
96969 (GETCHARBITMAP 84789 . 85913) (PUTCHARBITMAP 85915 . 88073) (\GETCHARBITMAP.CSINFO 88075 . 90091
) (\PUTCHARBITMAP.CSINFO 90093 . 96967)) (96970 118609 (MOVECHARBITMAP 96980 . 98874) (MOVEFONTCHARS
98876 . 103981) (\MOVEFONTCHAR 103983 . 108830) (\MOVEFONTCHARS.SOURCEDATA 108832 . 114947) (
\MAKESLUGCHAR 114949 . 117484) (SLUGCHARP.DISPLAY 117486 . 118607)) (119267 131116 (FONTFILES 119277
. 121110) (\FINDFONTFILE 121112 . 123089) (\FONTFILENAMES 123091 . 123651) (\FONTFILENAME 123653 .
126564) (FONTSPECFROMFILENAME 126566 . 131114)) (131117 167366 (FONTCOPY 131127 . 136210) (FONTP
136212 . 136511) (FONTUNPARSE 136513 . 138236) (SETFONTDESCRIPTOR 138238 . 139702) (\STREAMCHARWIDTH
139704 . 143715) (\COERCECHARSET 143717 . 147084) (\BUILDSLUGCSINFO 147086 . 150717) (\FONTSYMBOL
150719 . 151373) (\DEVICESYMBOL 151375 . 152159) (\FONTFACE 152161 . 159365) (\FONTFACE.COLOR 159367
. 166149) (SETFONTCHARENCODING 166151 . 167364)) (167367 187044 (FONTSAVAILABLE 167377 . 172741) (
FONTEXISTS? 172743 . 176284) (\SEARCHFONTFILES 176286 . 179373) (FLUSHFONTCACHE 179375 . 181598) (
FINDFONTFILES 181600 . 184816) (SORTFONTSPECS 184818 . 187042)) (187045 191160 (MATCHFONTFACE 187055
. 187870) (MAKEFONTFACE 187872 . 188906) (FONTFACETOATOM 188908 . 191158)) (191791 192283 (
\UNITWIDTHSVECTOR 191801 . 192281)) (207037 209104 (FONTDESCRIPTOR.DEFPRINT 207047 . 208626) (
FONTCLASS.DEFPRINT 208628 . 209102)) (212933 215723 (\CREATEKERNELEMENT 212943 . 213301) (
\FSETLEFTKERN 213303 . 213794) (\FGETLEFTKERN 213796 . 215721)) (215724 227390 (\CREATEFONT 215734 .
218630) (\CREATECHARSET 218632 . 223141) (\INSTALLCHARSETINFO 223143 . 226477) (
\INSTALLCHARSETINFO.CHARENCODING 226479 . 227388)) (227712 229080 (\FONTRESETCHARWIDTHS 227722 .
229078)) (229710 239787 (\CREATEDISPLAYFONT 229720 . 231587) (\CREATECHARSET.DISPLAY 231589 . 237304)
(\FONTEXISTS?.DISPLAY 237306 . 239785)) (239788 254793 (STRIKEFONT.FILEP 239798 . 240686) (
STRIKEFONT.GETCHARSET 240688 . 246282) (WRITESTRIKEFONTFILE 246284 . 251197) (STRIKECSINFO 251199 .
254791)) (254824 271157 (MAKEBOLD.CHARSET 254834 . 258489) (MAKEBOLD.CHAR 258491 . 260243) (
MAKEITALIC.CHARSET 260245 . 263924) (MAKEITALIC.CHAR 263926 . 266272) (\SFMAKEBOLD 266274 . 268500) (
\SFMAKEITALIC 268502 . 271155)) (271158 275182 (\SFMAKEROTATEDFONT 271168 . 272402) (\SFROTATECSINFO
272404 . 273079) (\SFROTATEFONTCHARACTERS 273081 . 273465) (\SFROTATECSINFOOFFSETS 273467 . 275180)) (
275183 276357 (\SFMAKECOLOR 275193 . 276355)))))
STOP

BIN
sources/FONT.LCOM
View File

Binary file not shown.