Skip to content

Commit 00a8f0e

Browse files
rmkaplanrmkaplan
committed
EDITFONT uses FONTFACE subfunction
1 parent 3b0b847 commit 00a8f0e

File tree

2 files changed

+23
-19
lines changed

2 files changed

+23
-19
lines changed

‎lispusers/EDITFONT‎

Lines changed: 23 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,12 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

3-
(FILECREATED "29-Aug-2025 22:34:31" {WMEDLEY}<lispusers>EDITFONT.;33 24939
3+
(FILECREATED " 4-Sep-2025 10:30:31" {WMEDLEY}<lispusers>EDITFONT.;35 25299
44

55
:EDIT-BY rmk
66

7-
:CHANGES-TO (FNS EDITFONT EF.EDITBM EF.CHARITEMS EF.SAVE)
7+
:CHANGES-TO (FNS EDITFONT)
88

9-
:PREVIOUS-DATE "27-Aug-2025 22:50:51" {WMEDLEY}<lispusers>EDITFONT.;30)
9+
:PREVIOUS-DATE " 2-Sep-2025 23:03:37" {WMEDLEY}<lispusers>EDITFONT.;34)
1010

1111

1212
(PRETTYCOMPRINT EDITFONTCOMS)
@@ -179,15 +179,16 @@
179179
(REDISPLAYW (WFROMMENU MENU])
180180

181181
(EF.DELETE
182-
[LAMBDA (CHARITEM MENU) (* ; "Edited 4-Aug-2025 13:14 by rmk")
182+
[LAMBDA (CHARITEM MENU) (* ; "Edited 2-Sep-2025 23:03 by rmk")
183+
(* ; "Edited 4-Aug-2025 13:14 by rmk")
183184
(* kbr%: "15-Dec-84 15:20")
184185
(* ;
185186
 "Turn CHARITEM into a slug charitem.")
186187
(LET ((WINDOW (WFROMMENU MENU))
187188
SLUGBITMAP)
188-
[SETQ SLUGBITMAP (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\XGETCHARSETINFO (WINDOWPROP
189-
WINDOW
190-
'FONT)
189+
[SETQ SLUGBITMAP (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\GETCHARSETINFO (WINDOWPROP
190+
WINDOW
191+
'FONT)
191192
(WINDOWPROP WINDOW 'CHARSET]
192193
(UNINTERRUPTABLY
193194
(replace (CHARITEM BITMAP) of CHARITEM with SLUGBITMAP)
@@ -233,7 +234,8 @@
233234
(T (LISPERROR "ILLEGAL ARG" BITMAP])
234235

235236
(EF.SAVE
236-
[LAMBDA (WINDOW) (* ; "Edited 29-Aug-2025 11:35 by rmk")
237+
[LAMBDA (WINDOW) (* ; "Edited 2-Sep-2025 23:03 by rmk")
238+
(* ; "Edited 29-Aug-2025 11:35 by rmk")
237239
(* ; "Edited 4-Aug-2025 09:22 by rmk")
238240
(* ; "Edited 2-Aug-2025 08:47 by rmk")
239241
(* kbr%: "21-Oct-85 15:39")
@@ -255,12 +257,12 @@
255257

256258
(* ;; "We'll install the slugbm at the end, include its dimensions")
257259

258-
(SETQ SLUGBM (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\XGETCHARSETINFO FONT CHARSET)))
260+
(SETQ SLUGBM (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\GETCHARSETINFO FONT CHARSET)))
259261
(SETQ SLUGWIDTH (fetch (BITMAP BITMAPWIDTH) of SLUGBM))
260262
(add CBWIDTH SLUGWIDTH)
261263
(SETQ CBHEIGHT (IMAX CBHEIGHT (fetch (BITMAP BITMAPHEIGHT) of SLUGBM)))
262264
(SETQ CB (BITMAPCREATE CBWIDTH CBHEIGHT))
263-
(SETQ CSINFO (create CHARSETINFO copying (\XGETCHARSETINFO FONT CHARSET)
265+
(SETQ CSINFO (create CHARSETINFO copying (\GETCHARSETINFO FONT CHARSET)
264266
CHARSETBITMAP _ CB))
265267
(SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO))
266268
(SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO))(* ; "Store new info in allocations")
@@ -325,6 +327,7 @@
325327

326328
(BLANKCHARSETCREATE
327329
[LAMBDA (FAMILY SIZE FACE CHARSET FIRSTCHAR LASTCHAR ASCENT DESCENT WIDTH)
330+
(* ; "Edited 2-Sep-2025 23:03 by rmk")
328331
(* ; "Edited 4-Aug-2025 13:29 by rmk")
329332
(* mjs "27-Mar-85 14:48")
330333
(* ; "Edited 3-Aug-2025 17:53 by rmk")
@@ -343,7 +346,7 @@
343346
(PROG (ROTATION DEVICE FONT CSINFO SLUGWIDTH OFFSETS WIDTHS SLUGOFFSET CB CBWIDTH CBHEIGHT)
344347
(SETQ FONT (\FONT.CHECKARGS FAMILY SIZE FACE 0 'DISPLAY CHARSET))
345348
[if (type? FONTDESCRIPTOR FONT)
346-
then (CL:WHEN (SETQ CSINFO (\XGETCHARSETINFO FONT CHARSET))
349+
then (CL:WHEN (SETQ CSINFO (\GETCHARSETINFO FONT CHARSET))
347350
(RETURN FONT))
348351
else (SPREADFONTSPEC FONT)
349352
(SETQ FONT
@@ -418,7 +421,8 @@
418421
(RETURN FONT])
419422

420423
(EDITFONT
421-
[LAMBDA (FONT CHARSET) (* ; "Edited 29-Aug-2025 22:34 by rmk")
424+
[LAMBDA (FONT CHARSET) (* ; "Edited 4-Sep-2025 09:27 by rmk")
425+
(* ; "Edited 29-Aug-2025 22:34 by rmk")
422426
(* ; "Edited 17-Aug-2025 12:03 by rmk")
423427
(* ; "Edited 3-Aug-2025 23:25 by rmk")
424428
(* ; "Edited 2-Aug-2025 10:11 by rmk")
@@ -440,7 +444,7 @@
440444
" "
441445
(FONTPROP FONT 'SIZE)
442446
" "
443-
(PACKC (for ATOM in (FONTPROP FONT 'FACE) collect (CHCON1 ATOM)))
447+
(FONTFACETOATOM (FONTPROP FONT 'FACE))
444448
" "
445449
(OCTALSTRING CHARSET)))
446450
(PUTMENUPROP MENU 'EDITFONTTITLE TITLE)
@@ -477,10 +481,10 @@
477481

478482
(EF.INIT)
479483
(DECLARE%: DONTCOPY
480-
(FILEMAP (NIL (1141 16132 (EF.INIT 1151 . 1785) (EF.PROMPT 1787 . 2369) (EF.MESSAGE 2371 . 2583) (
481-
EF.CLOSEFN 2585 . 3112) (EF.CHARITEMS 3114 . 4436) (EF.BUTTONEVENTFN 4438 . 4850) (EF.WHENSELECTEDFN
482-
4852 . 5256) (EF.EDITBM 5258 . 6752) (EF.MIDDLEBUTTONFN 6754 . 6999) (EF.CHANGESIZE 7001 . 8330) (
483-
EF.DELETE 8332 . 9407) (EF.ENTER 9409 . 10350) (EF.REPLACE 10352 . 11325) (EF.SAVE 11327 . 15424) (
484-
COPYFONT 15426 . 15701) (READSTRIKEFONTFILE 15703 . 16130)) (16133 24751 (BLANKCHARSETCREATE 16143 .
485-
22120) (EDITFONT 22122 . 24749)))))
484+
(FILEMAP (NIL (1110 16314 (EF.INIT 1120 . 1754) (EF.PROMPT 1756 . 2338) (EF.MESSAGE 2340 . 2552) (
485+
EF.CLOSEFN 2554 . 3081) (EF.CHARITEMS 3083 . 4405) (EF.BUTTONEVENTFN 4407 . 4819) (EF.WHENSELECTEDFN
486+
4821 . 5225) (EF.EDITBM 5227 . 6721) (EF.MIDDLEBUTTONFN 6723 . 6968) (EF.CHANGESIZE 6970 . 8299) (
487+
EF.DELETE 8301 . 9482) (EF.ENTER 9484 . 10425) (EF.REPLACE 10427 . 11400) (EF.SAVE 11402 . 15606) (
488+
COPYFONT 15608 . 15883) (READSTRIKEFONTFILE 15885 . 16312)) (16315 25111 (BLANKCHARSETCREATE 16325 .
489+
22410) (EDITFONT 22412 . 25109)))))
486490
STOP

‎lispusers/EDITFONT.LCOM‎

39 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)