github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-26 20:31:53 +00:00
Code Issues Projects Releases Wiki Activity

EDITFONT: Column-major order to match XCCS and Unicode tables (#2271)

Browse Source 
* Column major order to match XCCS and Unicode tables

* Compile with exports

* HLDISPLAY added a title argument to EDITBM

* EDITFONT puts the character and font in the title of the EDITBM window

* Put character set in edit window title
This commit is contained in:
rmkaplan
2025-08-31 18:17:23 -07:00
committed by GitHub
parent 1df0e1b17e
commit 60e0044870
4 changed files with 74 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files

66
lispusers/EDITFONT
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Aug-2025 12:11:44" {WMEDLEY}<lispusers>EDITFONT.;27 23463
(FILECREATED "29-Aug-2025 22:34:31" {WMEDLEY}<lispusers>EDITFONT.;33 24939
:EDIT-BY rmk
:CHANGES-TO (FNS EDITFONT)
:CHANGES-TO (FNS EDITFONT EF.EDITBM EF.CHARITEMS EF.SAVE)
:PREVIOUS-DATE " 4-Aug-2025 13:34:06" {WMEDLEY}<lispusers>EDITFONT.;26)
:PREVIOUS-DATE "27-Aug-2025 22:50:51" {WMEDLEY}<lispusers>EDITFONT.;30)
(PRETTYCOMPRINT EDITFONTCOMS)
@@ -80,17 +80,22 @@
(WINDOWPROP WINDOW 'MENU NIL])
(EF.CHARITEMS
[LAMBDA (FONT CHARSET) (* ; "Edited 4-Aug-2025 00:14 by rmk")
[LAMBDA (FONT CHARSET) (* ; "Edited 29-Aug-2025 11:34 by rmk")
(* ; "Edited 27-Aug-2025 22:50 by rmk")
(* ; "Edited 4-Aug-2025 00:14 by rmk")
(* ; "Edited 25-Jul-2025 10:06 by rmk")
(* kbr%: "16-Oct-85 23:11")
(* ;; "Get CHARITEMS for CHARSET in FONT. ")
(* ;; "Get CHARITEMS for CHARSET in FONT. Sort them in column-major order to build an array that corresponds to the tables in Unicode and XCCS.")
(for C8 from 0 to \MAXTHINCHAR as C from (LLSH CHARSET 8)
collect (create CHARITEM
BITMAP _ (GETCHARBITMAP C FONT)
CHARCODE _ C8
SLUGCHARP _ (SLUGCHARP.DISPLAY C FONT])
(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)
ROW)))
(create CHARITEM
BITMAP _ (GETCHARBITMAP CODE FONT)
CHARCODE _ CODE
SLUGCHARP _ (SLUGCHARP.DISPLAY CODE FONT])
(EF.BUTTONEVENTFN
[LAMBDA (WINDOW) (* kbr%: "16-Oct-85 22:19")
@@ -113,9 +118,11 @@
(* Do nothing. *)])
(EF.EDITBM
[LAMBDA (CHARITEM MENU) (* ; "Edited 4-Aug-2025 09:11 by rmk")
[LAMBDA (CHARITEM MENU CHARSET) (* ; "Edited 29-Aug-2025 11:37 by rmk")
(* ; "Edited 4-Aug-2025 09:11 by rmk")
(* kbr%: "15-Dec-84 15:20")
(LET ((SLUGCHARP (fetch (CHARITEM BITMAP) of CHARITEM))
(CHARCODE (fetch (CHARITEM CHARCODE) of CHARITEM))
BITMAP)
(RESETLST
[RESETSAVE (SHADEITEM CHARITEM MENU BLACKSHADE)
@@ -126,7 +133,9 @@
(UNINTERRUPTABLY
(replace (CHARITEM BITMAP) of CHARITEM with BITMAP)
(replace (CHARITEM SLUGCHARP) of CHARITEM with NIL)))
(EDITBM BITMAP))
[EDITBM BITMAP (CONCAT (CHARCODE.ENCODE CHARCODE T)
" in "
(GETMENUPROP MENU 'EDITFONTTITLE])
(* ;; "Update MENU image. SHADEITEM's side effects above suffice if we only changed one menu item. (I.e. we edited an ordinary CHARITEM.) ")
@@ -224,7 +233,8 @@
(T (LISPERROR "ILLEGAL ARG" BITMAP])
(EF.SAVE
[LAMBDA (WINDOW) (* ; "Edited 4-Aug-2025 09:22 by rmk")
[LAMBDA (WINDOW) (* ; "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")
(* ; "Save EDITFONT changes to FONT. *")
@@ -264,7 +274,7 @@
(BITBLT BM 0 0 CB OFFSET 0 WIDTH (fetch (BITMAP BITMAPHEIGHT) of BM)
'INPUT
'REPLACE)
(SETQ C8 (fetch (CHARITEM CHARCODE) of CI))
(SETQ C8 (\CHAR8CODE (fetch (CHARITEM CHARCODE) of CI)))
(\FSETOFFSET OFFSETS C8 OFFSET)
(\FSETWIDTH WIDTHS C8 WIDTH)
(add OFFSET WIDTH))
@@ -279,9 +289,9 @@
'INPUT
'REPLACE)
(for CI in CHARITEMS when (fetch (CHARITEM SLUGCHARP) of CI)
do (\FSETOFFSET OFFSETS (fetch (CHARITEM CHARCODE) of CI)
do (\FSETOFFSET OFFSETS (\CHAR8CODE (fetch (CHARITEM CHARCODE) of CI))
SLUGOFFSET)
(\FSETOFFSET WIDTHS (fetch (CHARITEM CHARCODE) of CI)
(\FSETOFFSET WIDTHS (\CHAR8CODE (fetch (CHARITEM CHARCODE) of CI))
SLUGWIDTH)) (* ; "Store new info")
(replace (CHARSETINFO CHARSETBITMAP) of CSINFO with CB)
(replace (CHARSETINFO WIDTHS) of CSINFO with WIDTHS)
@@ -408,7 +418,8 @@
(RETURN FONT])
(EDITFONT
[LAMBDA (FONT CHARSET) (* ; "Edited 17-Aug-2025 12:03 by rmk")
[LAMBDA (FONT CHARSET) (* ; "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")
@@ -425,9 +436,14 @@
MENUCOLUMNS _ 16
ITEMS _ CHARITEMS
WHENSELECTEDFN _ (FUNCTION EF.WHENSELECTEDFN)))
[SETQ TITLE (PACK* (FONTPROP FONT 'FAMILY)
(SETQ TITLE (PACK* (FONTPROP FONT 'FAMILY)
" "
(FONTPROP FONT 'SIZE)
(PACKC (for ATOM in (FONTPROP FONT 'FACE) collect (CHCON1 ATOM]
" "
(PACKC (for ATOM in (FONTPROP FONT 'FACE) collect (CHCON1 ATOM)))
" "
(OCTALSTRING CHARSET)))
(PUTMENUPROP MENU 'EDITFONTTITLE TITLE)
(SETQ HEIGHT (HEIGHTIFWINDOW (fetch (MENU IMAGEHEIGHT) of MENU)
T))
(SETQ WIDTH (WIDTHIFWINDOW (fetch (MENU IMAGEWIDTH) of MENU)))
@@ -461,10 +477,10 @@
(EF.INIT)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1110 14964 (EF.INIT 1120 . 1754) (EF.PROMPT 1756 . 2338) (EF.MESSAGE 2340 . 2552) (
EF.CLOSEFN 2554 . 3081) (EF.CHARITEMS 3083 . 3741) (EF.BUTTONEVENTFN 3743 . 4155) (EF.WHENSELECTEDFN
4157 . 4561) (EF.EDITBM 4563 . 5732) (EF.MIDDLEBUTTONFN 5734 . 5979) (EF.CHANGESIZE 5981 . 7310) (
EF.DELETE 7312 . 8387) (EF.ENTER 8389 . 9330) (EF.REPLACE 9332 . 10305) (EF.SAVE 10307 . 14256) (
COPYFONT 14258 . 14533) (READSTRIKEFONTFILE 14535 . 14962)) (14965 23275 (BLANKCHARSETCREATE 14975 .
20952) (EDITFONT 20954 . 23273)))))
(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)))))
STOP

BIN
lispusers/EDITFONT.LCOM
View File

Binary file not shown.