From 00a8f0eba3da7edc043cff5e04b06f5dadf2c4c0 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Thu, 11 Sep 2025 23:52:37 -0700 Subject: [PATCH] EDITFONT uses FONTFACE subfunction --- lispusers/EDITFONT | 42 ++++++++++++++++++++++------------------ lispusers/EDITFONT.LCOM | Bin 9668 -> 9707 bytes 2 files changed, 23 insertions(+), 19 deletions(-) diff --git a/lispusers/EDITFONT b/lispusers/EDITFONT index 8c4eb47e..e3872aad 100644 --- a/lispusers/EDITFONT +++ b/lispusers/EDITFONT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "29-Aug-2025 22:34:31" {WMEDLEY}EDITFONT.;33 24939 +(FILECREATED " 4-Sep-2025 10:30:31" {WMEDLEY}EDITFONT.;35 25299 :EDIT-BY rmk - :CHANGES-TO (FNS EDITFONT EF.EDITBM EF.CHARITEMS EF.SAVE) + :CHANGES-TO (FNS EDITFONT) - :PREVIOUS-DATE "27-Aug-2025 22:50:51" {WMEDLEY}EDITFONT.;30) + :PREVIOUS-DATE " 2-Sep-2025 23:03:37" {WMEDLEY}EDITFONT.;34) (PRETTYCOMPRINT EDITFONTCOMS) @@ -179,15 +179,16 @@ (REDISPLAYW (WFROMMENU MENU]) (EF.DELETE - [LAMBDA (CHARITEM MENU) (* ; "Edited 4-Aug-2025 13:14 by rmk") + [LAMBDA (CHARITEM MENU) (* ; "Edited 2-Sep-2025 23:03 by rmk") + (* ; "Edited 4-Aug-2025 13:14 by rmk") (* kbr%: "15-Dec-84 15:20") (* ;  "Turn CHARITEM into a slug charitem.") (LET ((WINDOW (WFROMMENU MENU)) SLUGBITMAP) - [SETQ SLUGBITMAP (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\XGETCHARSETINFO (WINDOWPROP - WINDOW - 'FONT) + [SETQ SLUGBITMAP (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\GETCHARSETINFO (WINDOWPROP + WINDOW + 'FONT) (WINDOWPROP WINDOW 'CHARSET] (UNINTERRUPTABLY (replace (CHARITEM BITMAP) of CHARITEM with SLUGBITMAP) @@ -233,7 +234,8 @@ (T (LISPERROR "ILLEGAL ARG" BITMAP]) (EF.SAVE - [LAMBDA (WINDOW) (* ; "Edited 29-Aug-2025 11:35 by rmk") + [LAMBDA (WINDOW) (* ; "Edited 2-Sep-2025 23:03 by rmk") + (* ; "Edited 29-Aug-2025 11:35 by rmk") (* ; "Edited 4-Aug-2025 09:22 by rmk") (* ; "Edited 2-Aug-2025 08:47 by rmk") (* kbr%: "21-Oct-85 15:39") @@ -255,12 +257,12 @@ (* ;; "We'll install the slugbm at the end, include its dimensions") - (SETQ SLUGBM (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\XGETCHARSETINFO FONT CHARSET))) + (SETQ SLUGBM (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\GETCHARSETINFO FONT CHARSET))) (SETQ SLUGWIDTH (fetch (BITMAP BITMAPWIDTH) of SLUGBM)) (add CBWIDTH SLUGWIDTH) (SETQ CBHEIGHT (IMAX CBHEIGHT (fetch (BITMAP BITMAPHEIGHT) of SLUGBM))) (SETQ CB (BITMAPCREATE CBWIDTH CBHEIGHT)) - (SETQ CSINFO (create CHARSETINFO copying (\XGETCHARSETINFO FONT CHARSET) + (SETQ CSINFO (create CHARSETINFO copying (\GETCHARSETINFO FONT CHARSET) CHARSETBITMAP _ CB)) (SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) (SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO))(* ; "Store new info in allocations") @@ -325,6 +327,7 @@ (BLANKCHARSETCREATE [LAMBDA (FAMILY SIZE FACE CHARSET FIRSTCHAR LASTCHAR ASCENT DESCENT WIDTH) + (* ; "Edited 2-Sep-2025 23:03 by rmk") (* ; "Edited 4-Aug-2025 13:29 by rmk") (* mjs "27-Mar-85 14:48") (* ; "Edited 3-Aug-2025 17:53 by rmk") @@ -343,7 +346,7 @@ (PROG (ROTATION DEVICE FONT CSINFO SLUGWIDTH OFFSETS WIDTHS SLUGOFFSET CB CBWIDTH CBHEIGHT) (SETQ FONT (\FONT.CHECKARGS FAMILY SIZE FACE 0 'DISPLAY CHARSET)) [if (type? FONTDESCRIPTOR FONT) - then (CL:WHEN (SETQ CSINFO (\XGETCHARSETINFO FONT CHARSET)) + then (CL:WHEN (SETQ CSINFO (\GETCHARSETINFO FONT CHARSET)) (RETURN FONT)) else (SPREADFONTSPEC FONT) (SETQ FONT @@ -418,7 +421,8 @@ (RETURN FONT]) (EDITFONT - [LAMBDA (FONT CHARSET) (* ; "Edited 29-Aug-2025 22:34 by rmk") + [LAMBDA (FONT CHARSET) (* ; "Edited 4-Sep-2025 09:27 by rmk") + (* ; "Edited 29-Aug-2025 22:34 by rmk") (* ; "Edited 17-Aug-2025 12:03 by rmk") (* ; "Edited 3-Aug-2025 23:25 by rmk") (* ; "Edited 2-Aug-2025 10:11 by rmk") @@ -440,7 +444,7 @@ " " (FONTPROP FONT 'SIZE) " " - (PACKC (for ATOM in (FONTPROP FONT 'FACE) collect (CHCON1 ATOM))) + (FONTFACETOATOM (FONTPROP FONT 'FACE)) " " (OCTALSTRING CHARSET))) (PUTMENUPROP MENU 'EDITFONTTITLE TITLE) @@ -477,10 +481,10 @@ (EF.INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1141 16132 (EF.INIT 1151 . 1785) (EF.PROMPT 1787 . 2369) (EF.MESSAGE 2371 . 2583) ( -EF.CLOSEFN 2585 . 3112) (EF.CHARITEMS 3114 . 4436) (EF.BUTTONEVENTFN 4438 . 4850) (EF.WHENSELECTEDFN -4852 . 5256) (EF.EDITBM 5258 . 6752) (EF.MIDDLEBUTTONFN 6754 . 6999) (EF.CHANGESIZE 7001 . 8330) ( -EF.DELETE 8332 . 9407) (EF.ENTER 9409 . 10350) (EF.REPLACE 10352 . 11325) (EF.SAVE 11327 . 15424) ( -COPYFONT 15426 . 15701) (READSTRIKEFONTFILE 15703 . 16130)) (16133 24751 (BLANKCHARSETCREATE 16143 . -22120) (EDITFONT 22122 . 24749))))) + (FILEMAP (NIL (1110 16314 (EF.INIT 1120 . 1754) (EF.PROMPT 1756 . 2338) (EF.MESSAGE 2340 . 2552) ( +EF.CLOSEFN 2554 . 3081) (EF.CHARITEMS 3083 . 4405) (EF.BUTTONEVENTFN 4407 . 4819) (EF.WHENSELECTEDFN +4821 . 5225) (EF.EDITBM 5227 . 6721) (EF.MIDDLEBUTTONFN 6723 . 6968) (EF.CHANGESIZE 6970 . 8299) ( +EF.DELETE 8301 . 9482) (EF.ENTER 9484 . 10425) (EF.REPLACE 10427 . 11400) (EF.SAVE 11402 . 15606) ( +COPYFONT 15608 . 15883) (READSTRIKEFONTFILE 15885 . 16312)) (16315 25111 (BLANKCHARSETCREATE 16325 . +22410) (EDITFONT 22412 . 25109))))) STOP diff --git a/lispusers/EDITFONT.LCOM b/lispusers/EDITFONT.LCOM index 7c0e333a366b887f74989d4c1f747c7494a4f7bc..71354b58fc234eeb09560ba1dd0f1e66499a9b84 100644 GIT binary patch delta 2673 zcmZuzO>7%g5cb+>+9cFCwNsK1l4%;5I7-vqx9h)%L)P}%UVFXIwKqxArZtTm8j`4h z#Icg07q~&YH;|C%0U-fWf)xoxm3#n+1SwJu9D+E2P^C)HBB5RjVcxDCJ4r2h-@N(# z=DpdO{UQ5T_T$-ZkS-J#-@ZV25(I&t6#2VLQeQ9tox`mX9wox07`nSLN?Z986BENw zzVYs2`MCyCa5&I8np8C8E!l%Kg0P(b3C@KcXWW#&R8A@%&WSg6bjRMLyl<*iX(V{dnQADx zYWItwHtv*}_J+9AX2pA(+cKYdGu%Tntf(3%!>rQ)i~+*z!#W{^Fa`)JzGA@Y!AkN-`#dxy}$1GGULf~b6)DVMbvK@bTYk?|9$G`sNY%g*A^VLChcsY z+nV%us4?e#otX}mZ<>)le(G$kOwam!wN>Zp{@$Cm*IwlH`UY#8DbL0k`7NgYX9s&O zc-F?3N&~f0e~tEUxbCbwJ~6-Pi&X~EV9@8Rt?sY7_Ez@(u#`)HT<|$+SIbsz+m7og zPuYbTeQL?M2Z@zmmb;xjbc~KZt%^Dw+tqe3i?NlTOJi$KTwlCb%ea)NlD2Z-wAFYhLHhR3P`^w5*!`-*9de;oDL~4|$6HluTb;|Ej!o2h7 zov+bxXK8%xrz0`99<1&+5qX(3!skG-hdl4jM?s2oQ5{ZV%c=&)$oy&r#R63Temra>l$d&|48;p7qs&g580=iuL9YAvoP#YU*bWlu^L;Hgd45L-dA|+opvv>7!d^6 zXy}nB-{{g25<09V1doOaN2Nn5;m9#GA!1J)Jaj9VBt+#yHX@FQ+ik8EK*n5NIe#06 zKoAmmpqe}fgpah)g89|pNbuMp3jDF-i5!^W5XYMk%(fwa-}9zz0JzsqnV%26 zxjB?M;l`SGn;kG>z5-q5BIGL9%3RK=WtaN#SI$_~e!Xm!cG@ar-J+*jXxXAweYxD< z!nM@wy;Y&Q$1y4j1lvSHDd_c)E%G72xoYq711s7uB4cQb34C z!Jf+phC&qID(gF>KClJ6isOb6!Z0&eR*FI>3VAu69RndG0*xE8Rx}E#o&q6AyjJzG z!D&$0pg9nvu&E8tT;~N)k`u9M!=Sn{gEKj)<5h>?2q%0{t3X0_rQr8Q^LwZWLO29U cLN(Y6WvB*zQV9~dcYe_&1jE&(^YhOC0f%S9A^-pY delta 2608 zcmZuzO>7%g5cb+7B}r?XWNXsUpCPq^6VkBzc5SZ%in6iS_Qvad#@?h2q+N&%2}x9h zfLkR?y}+%7Mce?XLOoT&!HR^qEC?i;L!=y95e}t@3*uKo5#mOex9j{gttIc9H}mGr z%zHE6yx)u87O$P_BI&d0+w*6MKoUU6s3gC)ARm_op`)KDdlFF|O$eh2`MuRR-OnEx z8R>`G%Wu6>dx(NKDv*Q^H$%>B=L_v*N9Oz(jyBgie+@eEuBV&- zhNVLs=RDn$MRWNOO9nMN2!80D&BHK!mFPg2p0NOS&;LI0&Kto^(2oKVSdp#JD=K zI3K`Y=4cxm&ev++u<;YOuy!i*)5cn0=K4zDW+7rne8I;qjd%(jY?&S5Xe4My+_?bq zcj(|g`p_PIAGNylQoy-$JgIfNHQLSd?s9N>d-FAaR~~shf6DzLA6b1|eVtkQt(|@6 zA`Nk_&243lBd=Uj%d)T#y zTslmLwwiAh>G0C#27Whg1q|=I$qWyp;o-(T&K`H^7=3Q5dDEa{8+4q>#!xoq($Szj z+IZifG2hkL((Sq(YdBvnZ!g+$*B)?boDOU?-!W)>BOhUkaa4>q{xB|a0j5*bm`(QC zyijDk67q0Fe@c_+g?B81Ymc~8pd(wK6{*0M;0*T>8h_zZ7N_jm#HBJNTXkF_`%7e8 zA~*gjcyZrqUkxq#M{ujtPU3YW|Gw_hm$rY3p@bNTS59rm0kG! zB)NELd)q86PMW@v(0rXG$kD^>>svGVHa)9#?lD^T5a18_mUHWm`b0jw-tJQ^mpag8 zG{pP}uXp%NuO4(h&|2ta&-xRENFXi>SnjiRbvnv$WnF;(CK}wVR=LwV>dbO-oDzpNUl;pwC%sfJc zBuEGc=PN)`Dd)z?EA>>u13LyF6}@cX@^mu&04wnjmXDJA6=h)uUUV}@AuS=u`k?C1 z#nk{cMnd~| z)=XJDa~TL~X7Th4bp{9?^)4->ocYr+UO8w=6eQ=9)4-*iuTBrtv8NDFEn33vl0t+w zv)EwD2+d_$#W8{4pVz60q};-9gnTGydcI&GlYpgL25V6wlr(b+3Ey$Q{XMKx4FdPZ z(Lf+L&hpMV437n`J?iwrZ0Mr zTHk)Yx3b0X?9(vTiIkL~gsr(^woXh+qyQTu&gyu8sDb+bfb&G(=p@q%Pqc@eU7E328}5D?68nz2-)YMrd;W*$UL zaVE-uh)0zvWT+{Em=K&d`=>7^2zwVzOj#B+wP}0_4Uc_oA|!{*g9v%&uX2e!XB