From 8e94715e22298926dec55662846d5e54980e7322 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 2 Mar 2026 13:19:07 -0800 Subject: [PATCH] PAIRS arguments of MOVEFONTCHARS can be a hashtable --- sources/FONT | 176 ++++++++++++++++++++++++++-------------------- sources/FONT.LCOM | Bin 68484 -> 68826 bytes 2 files changed, 101 insertions(+), 75 deletions(-) diff --git a/sources/FONT b/sources/FONT index 1a92ec84..a241754a 100644 --- a/sources/FONT +++ b/sources/FONT @@ -1,12 +1,15 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) -(FILECREATED "26-Feb-2026 17:01:47" {WMEDLEY}FONT.;677 278005 +(FILECREATED " 2-Mar-2026 13:14:53" {WMEDLEY}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}FONT.;675) + :PREVIOUS-DATE "26-Feb-2026 17:01:47" {WMEDLEY}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 diff --git a/sources/FONT.LCOM b/sources/FONT.LCOM index a5dd658464ec2ffc17342d9b58401e599f283012..a8eed59ab689d45017b91ba5175886a0b66285ec 100644 GIT binary patch delta 1396 zcmZ`(O>7%g5cb+}>=;4gq%FlDG2Mz{Cw1}u_%Ddy&H5$Y+PiPFyADa3N~E>(BP=FOX*Z)U!? zZ(JVu>BE8dR`!FOHkUWjaz@U9q)bTaL{`~;WjtKSrXaSxGrE0a@jrdoxbWamAq#T8 zsN@Qa3a~XzEw4=G44v2xwZWuwgq!q==C~XiFIu1$1AG+{eff!5u0S@Q^paxOjHJnh40qHwg+6}}A}fn>}_u$#-T`ZqG3nq3G_ z3NiLw_z`wHETeXKaGaTgIn>S#rkMVEoZTD*Jlz^p*=R&UtsIfqixHKzukL3zA_v(I zkqNZk7ZsTlRZ(k3k996azuvcRPr1&CL$8|E3|I(=o-Gceb^TZjc>Tqm9D{rmHW3&#Q5oC!@v77TJ>csRN1*& zZH1Qo%kFR>DM>kSiRV#!POE{GkzwY}si?vfty^Uq3VE($5z8rKDN^X@u$P3&{qew z#wzc>*E!j3#kAi$hSr`HI2o`1RtgFVT>quSetuIGK4Zggeg8xrN$pj3D}$Ux7}U}= zk0WqFR@HyrD-yV#V^h46itOR@2NvZ_;ja*oio4NBE5)bbw5Ah}Y92MQYxRz!k_D5P zQy|GIP~FpNnAEUla16?>Pp-(`J%4D6kCDuK#BvR4;r_Dt2u%W*i+@f4@%9Pl>W*Q1 z)InS@hI|BB&Vo2LCIWsJK@<^O2E??EN7fK6yDt=wpl<;AVd(LeXK;~4NbJO-XGf%ktgeMY}wvfyz7Xdw3WamIdCXV zs49WPAwa~9Xj%a(;($bZs8kslq^437@pEVol`4*0xp9H27kYxX8`8fy%=gVVGjF~( z?>)QOf9ZPvwbSCcJhFO0A8=hA)YU(Budbg!iKM}F^M+vyE<>)#XIO>%kyoXyP={jB zVly?~4#&$hVxXDEc;&N`Fd`atBN-RlVUP;SXRZU zlqr<2_J|)+Be;5)a>VPDj_gpHh%jv-TS2y#Cdgi-E%8An-mPYeVmYHByPL7Zv&=`b z+DmQw>Al`>d(Ss75(rv600Uy5WwhrpT?Z+UB}plDI=RxT8ylr<5{|Bxz)7j|I9}e` zD9y*H#?vJQhx{O&C^V6VWT~25xS!d?K`HCHFwLTf2Q#z*P64KPyX}_)a102jS04k5 zBt8;LrU7%YsR^&jygF@7hd^?hQaIb3;tgHR+7^^+VbGwnkaJ+uKA3rN_LJe>!})L2 zPwQ+JbHnF!s30k`3T-!{khfc2QW;bUs$mqrgn5rhilmh2s~>5QWKlY{JAPkE>*D)GcW_62Vf4gWRXN_hUH|as?rZUKao;d0nE!v?76+CN zW-Zjc7Q>E8+Kff$%YvADyv!!bECwjJ;@nb0HhYhjoLzEO{B`BP_Qu8;mHyc)((aTP zS{@N><$ZZgbXJ}owQcaD>Q)Reu`V9>JsQQaLNLw3fA@(4VblsZZW)#cF7LTW3b}Vz zfaJGs199?6fh*Kw5vLJv0<@-54%au0G~D)VE8a#9=4X)e|29-4A92LG&JRchTz(ujeAHO6A2=w q9_y9`+9YBw585e2Vnf!iHNfZZepv@Bh-PTIDn3sS_ikOCTz(6$P6!?V