github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-07 06:36:24 +00:00
Code Issues Projects Releases Wiki Activity

EDITFONT: Use MEDLEYFONT.READ.FONT, Inspect item in title menu

Browse Source
This commit is contained in:
rmkaplan
2026-04-05 22:52:20 -07:00
parent 33b99d7852
commit 39fb97f023
2 changed files with 43 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

70
lispusers/EDITFONT
View File

@@ -1,13 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
(FILECREATED "12-Oct-2025 17:39:29" {WMEDLEY}<lispusers>EDITFONT.;41 26261
(FILECREATED " 5-Apr-2026 11:56:20" {WMEDLEY}<lispusers>EDITFONT.;51 27416
:EDIT-BY rmk
:CHANGES-TO (RECORDS CHARITEM)
(FNS EF.SAVE)
:CHANGES-TO (FNS EF.INIT EF.INSPECT)
(VARS EDITFONTCOMS)
(RECORDS CHARITEM)
:PREVIOUS-DATE " 7-Oct-2025 14:56:00" {WMEDLEY}<lispusers>EDITFONT.;40)
:PREVIOUS-DATE " 4-Apr-2026 18:14:31" {WMEDLEY}<lispusers>EDITFONT.;48)
(PRETTYCOMPRINT EDITFONTCOMS)
@@ -19,8 +20,8 @@
(INITVARS (EF.MENU NIL)
(EF.TITLEMENU NIL))
(FNS EF.INIT EF.PROMPT EF.MESSAGE EF.CLOSEFN EF.CHARITEMS EF.BUTTONEVENTFN EF.WHENSELECTEDFN
EF.EDITBM EF.MIDDLEBUTTONFN EF.CHANGESIZE EF.DELETE EF.ENTER EF.REPLACE EF.SAVE COPYFONT
READSTRIKEFONTFILE)
EF.EDITBM EF.MIDDLEBUTTONFN EF.CHANGESIZE EF.DELETE EF.ENTER EF.REPLACE EF.SAVE
EF.INSPECT COPYFONT READSTRIKEFONTFILE)
(FNS BLANKCHARSETCREATE EDITFONT)
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS CHARITEM)
(FILES (LOADCOMP)
@@ -38,14 +39,16 @@
(DEFINEQ
(EF.INIT
[LAMBDA NIL (* ; "Edited 4-Aug-2025 13:16 by rmk")
[LAMBDA NIL (* ; "Edited 5-Apr-2026 11:56 by rmk")
(* ; "Edited 4-Aug-2025 13:16 by rmk")
[SETQ EF.MENU (create MENU
ITEMS _ '((CHANGESIZE 'EF.CHANGESIZE "Change size of character.")
(DELETE 'EF.DELETE "Delete character.")
(EDITBM 'EF.EDITBM "Edit character.")
(REPLACE 'EF.REPLACE "Prompt for bitmap to replace character."]
ITEMS _ '((Changesize 'EF.CHANGESIZE "Change size of character.")
(Delete 'EF.DELETE "Delete character.")
(EditBM 'EF.EDITBM "Edit character.")
(Replace 'EF.REPLACE "Prompt for bitmap to replace character."]
(SETQ EF.TITLEMENU (create MENU
ITEMS _ '((SAVE 'EF.SAVE "Save EDITFONT's work back into font."])
ITEMS _ '((Save 'EF.SAVE "Save EDITFONT's work back into font.")
(Inspect 'EF.INSPECT "Inspect this charset info"])
(EF.PROMPT
[LAMBDA (STRING WINDOW) (* kbr%: "16-Oct-85 22:48")
@@ -81,7 +84,8 @@
(WINDOWPROP WINDOW 'MENU NIL])
(EF.CHARITEMS
[LAMBDA (FONT CHARSET ROWMAJOR) (* ; "Edited 5-Oct-2025 14:42 by rmk")
[LAMBDA (FONT CHARSET ROWMAJOR) (* ; "Edited 18-Mar-2026 16:13 by rmk")
(* ; "Edited 5-Oct-2025 14:42 by rmk")
(* ; "Edited 29-Aug-2025 11:34 by rmk")
(* ; "Edited 27-Aug-2025 22:50 by rmk")
(* ; "Edited 4-Aug-2025 00:14 by rmk")
@@ -95,7 +99,7 @@
collect (create CHARITEM
BITMAP _ (GETCHARBITMAP C FONT)
CHARCODE _ C8
SLUGCHARP _ (SLUGCHARP.DISPLAY C FONT)))
SLUGCHARP _ (SLUGCHARP C FONT)))
else (for ROW from 0 to 15 join (for COL CODE from 0 to 15
collect (SETQ CODE (LOGOR (LLSH CHARSET 8)
(IPLUS (TIMES COL 16)
@@ -103,7 +107,7 @@
(create CHARITEM
BITMAP _ (GETCHARBITMAP CODE FONT)
CHARCODE _ CODE
SLUGCHARP _ (SLUGCHARP.DISPLAY CODE FONT])
SLUGCHARP _ (SLUGCHARP CODE FONT])
(EF.BUTTONEVENTFN
[LAMBDA (WINDOW) (* kbr%: "16-Oct-85 22:19")
@@ -313,6 +317,12 @@
(\SETCHARSETINFO FONT CHARSET CSINFO])
(EF.INSPECT
[LAMBDA (WINDOW) (* ; "Edited 5-Apr-2026 11:41 by rmk")
(* ; "Save EDITFONT changes to FONT. *")
(INSPECT (\GETCHARSETINFO (WINDOWPROP WINDOW 'FONT)
(WINDOWPROP WINDOW 'CHARSET])
(COPYFONT
[LAMBDA (FONT) (* ; "Edited 3-Aug-2025 17:37 by rmk")
(* jds "26-Aug-86 16:01")
@@ -429,17 +439,23 @@
(RETURN FONT])
(EDITFONT
[LAMBDA (FONT CHARSET ROWMAJOR NCOLUMNS TITLETAG) (* ; "Edited 7-Oct-2025 14:55 by rmk")
(* ; "Edited 5-Oct-2025 15:06 by rmk")
[LAMBDA (FONT CHARSET ROWMAJOR NCOLUMNS TITLETAG) (* ; "Edited 4-Apr-2026 18:14 by rmk")
(* ; "Edited 30-Mar-2026 12:10 by rmk")
(* ; "Edited 25-Mar-2026 00:04 by rmk")
(* ; "Edited 21-Mar-2026 10:43 by rmk")
(* ; "Edited 16-Mar-2026 23:17 by rmk")
(* ; "Edited 7-Oct-2025 14:55 by rmk")
(* ; "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")
(* mjs "27-Mar-85 14:48")
(* kbr%: "21-Oct-85 15:35")
(* kbr%: "21-Oct-85 15:35")
(SETQ FONT (FONTCREATE FONT))
(CL:UNLESS (type? FONTDESCRIPTOR FONT)
(SETQ FONT (OR (MEDLEYFONT.READ.FONT FONT CHARSET T)
(FONTCREATE FONT NIL NIL NIL NIL NIL CHARSET))))
(CL:UNLESS (EQ 'DISPLAY (FONTPROP FONT 'DEVICE))
(ERROR FONT " is not a display font"))
(SETQ CHARSET (OR (CHARSET.DECODE CHARSET)
0))
(LET (CHARITEMS MENU TITLE HEIGHT WIDTH REGION POS WINDOW)
@@ -494,10 +510,10 @@
(EF.INIT)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1146 16903 (EF.INIT 1156 . 1790) (EF.PROMPT 1792 . 2374) (EF.MESSAGE 2376 . 2588) (
EF.CLOSEFN 2590 . 3117) (EF.CHARITEMS 3119 . 4955) (EF.BUTTONEVENTFN 4957 . 5369) (EF.WHENSELECTEDFN
5371 . 5775) (EF.EDITBM 5777 . 7271) (EF.MIDDLEBUTTONFN 7273 . 7518) (EF.CHANGESIZE 7520 . 8849) (
EF.DELETE 8851 . 10032) (EF.ENTER 10034 . 10975) (EF.REPLACE 10977 . 11950) (EF.SAVE 11952 . 16195) (
COPYFONT 16197 . 16472) (READSTRIKEFONTFILE 16474 . 16901)) (16904 26073 (BLANKCHARSETCREATE 16914 .
22999) (EDITFONT 23001 . 26071)))))
(FILEMAP (NIL (1207 17591 (EF.INIT 1217 . 2046) (EF.PROMPT 2048 . 2630) (EF.MESSAGE 2632 . 2844) (
EF.CLOSEFN 2846 . 3373) (EF.CHARITEMS 3375 . 5304) (EF.BUTTONEVENTFN 5306 . 5718) (EF.WHENSELECTEDFN
5720 . 6124) (EF.EDITBM 6126 . 7620) (EF.MIDDLEBUTTONFN 7622 . 7867) (EF.CHANGESIZE 7869 . 9198) (
EF.DELETE 9200 . 10381) (EF.ENTER 10383 . 11324) (EF.REPLACE 11326 . 12299) (EF.SAVE 12301 . 16544) (
EF.INSPECT 16546 . 16883) (COPYFONT 16885 . 17160) (READSTRIKEFONTFILE 17162 . 17589)) (17592 27228 (
BLANKCHARSETCREATE 17602 . 23687) (EDITFONT 23689 . 27226)))))
STOP

BIN
lispusers/EDITFONT.LCOM
View File

Binary file not shown.