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

* 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

lispusers/EDITFONT

@@ -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

sources/HLDISPLAY

@@ -1,14 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 2-Aug-2025 10:16:35" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>HLDISPLAY.;2
 205096 
+
(FILECREATED "29-Aug-2025 11:38:16" {WMEDLEY}<sources>HLDISPLAY.;3
 205136 
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS EDITBM)
 
-      :PREVIOUS-DATE "15-Mar-94 10:48:02" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>HLDISPLAY.;1)
+      :PREVIOUS-DATE " 2-Aug-2025 10:16:35" {WMEDLEY}<sources>HLDISPLAY.;2)
 
 
 (PRETTYCOMPRINT HLDISPLAYCOMS)
@@ -1511,7 +1509,8 @@
 (DEFINEQ
 
 (EDITBM

-  [LAMBDA (BMSPEC)
                                           (* ; "Edited  2-Aug-2025 10:14 by rmk")


+  [LAMBDA (BMSPEC TITLE LEAVETTY)
                            (* ; "Edited 29-Aug-2025 11:37 by rmk")


+                                                             (* ; "Edited  2-Aug-2025 10:14 by rmk")


                                                              (* ; "Edited 31-Aug-87 12:28 by FS")

 
 (* ;;; "A simple bitmap editor.")

@@ -1613,7 +1612,7 @@
           (SETQ BMW (CREATEW (GETBOXREGION
 (WIDTHIFWINDOW BMWWIDTH)
                                     (HEIGHTIFWINDOW BMWHEIGHT T)
                                     NIL NIL NIL "Indicate the position for the Bitmap Edit window.")
-                           "Bitmap Editor"))
+                           (OR TITLE "Bitmap Editor")))
           (WINDOWPROP BMW 'BM BM)
           (WINDOWPROP BMW 'SCROLLFN (FUNCTION EDITBMSCROLLFN))
           (WINDOWPROP BMW 'RESHAPEFN (FUNCTION EDITBMRESHAPEFN))
@@ -3515,32 +3514,32 @@
        "({Y16 SMALLPOSP 0 0 15 240 255 3840 3855 4080 4095 61440 61455 61680 61695 65280 65295 65520 65535 })
 ")
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4729 11892 (GRID 4739 . 9010) (GRIDXCOORD 9012 . 9517) (GRIDYCOORD 9519 . 10028) (
-LEFTOFGRIDCOORD 10030 . 10467) (BOTTOMOFGRIDCOORD 10469 . 10730) (SHADEGRIDBOX 10732 . 11890)) (11948 
-12356 (INSIDE? 11958 . 12354)) (12394 16790 (MOUSESTATE-EXPR 12404 . 16059) (MOUSESTATE-NAME 16061 . 
-16788)) (20280 21265 (DECODEBUTTONS 20290 . 21263)) (21266 22278 (PTDIFFERENCE 21276 . 21785) (PTPLUS 
-21787 . 22276)) (22329 50232 (GETPOSITION 22339 . 22647) (GETBOXPOSITION 22649 . 23332) (
-DSPYSCREENTOWINDOW 23334 . 23818) (DSPXSCREENTOWINDOW 23820 . 24304) (GETREGION 24306 . 24855) (
-\GETREGION.PACKPTS 24857 . 25425) (\GETREGION.CHECKBASEPT 25427 . 27370) (\GETREGION.CHECKOPPT 27372
- . 30182) (\GETREGIONTRACKWITHBOX 30184 . 36715) (\UPDATEXYANDBOX 36717 . 39096) (GETBOXREGION 39098
- . 39572) (\TRACKWITHBOX 39574 . 44712) (MOVEBOX 44714 . 45344) (DRAWGRAYBOX 45346 . 45868) (BLTHLINE 
-45870 . 46120) (BLTVLINE 46122 . 46361) (SETCORNER 46363 . 47629) (GETSCREENPOSITION 47631 . 48244) (
-GETBOXSCREENPOSITION 48246 . 48857) (GETSCREENREGION 48859 . 49515) (GETBOXSCREENREGION 49517 . 50230)
-) (50318 67134 (\MEDW.GETSCREENPOSITION 50328 . 52121) (\MEDW.GETBOXSCREENPOSITION 52123 . 55677) (
-\MEDW.GETSCREENREGION 55679 . 67132)) (67135 74873 (GETGRIDBOXREGION 67145 . 74799) (\RANGELIMIT 74801
- . 74871)) (74874 77924 (MOUSECONFIRM 74884 . 77922)) (78065 79434 (NEAREST/PT/ON/GRID 78075 . 78670) 
-(PTON10GRID 78672 . 78997) (NEAREST/MULTIPLE 78999 . 79432)) (81478 85380 (\SW2BM 81488 . 84186) (
-COMPOSEREGS 84188 . 84742) (TRANSLATEREG 84744 . 85378)) (85422 176157 (EDITBM 85432 . 95641) (
-EDITBMSCROLLFN 95643 . 110796) (EDITBMCLOSEFN 110798 . 111415) (TILEAREA 111417 . 111808) (
-EDITBMBUTTONFN 111810 . 136637) (\EDITBM/PUTUP/DISPLAY 136639 . 137541) (\EDITBMHOWMUCH 137543 . 
-138529) (EDITBMRESHAPEFN 138531 . 147217) (EDITBMREPAINTFN 147219 . 148538) (UPDATE/SHADE/DISPLAY 
-148540 . 148987) (UPDATE/BM/DISPLAY/SELECTED/REGION 148989 . 150103) (SHOWBUTTON 150105 . 150663) (
-RESETGRID.NEW 150665 . 154014) (RESETGRID 154016 . 154840) (\READBMDIMENSIONS 154842 . 155879) (
-EDITSHADE 155881 . 164607) (\BITMAPFROMTEXTURE 164609 . 165307) (EDITSHADEREPAINTFN 165309 . 167083) (
-GRAYBOXAREA 167085 . 167768) (\SHADEBITS 167770 . 170735) (READHOTSPOT 170737 . 174602) (WBOX 174604
- . 175328) (\CLEARBM 175330 . 175529) (EDITBMTEXTURE 175531 . 176155)) (177502 185209 (SCALEBM 177512
- . 179578) (BLTPATTERN 179580 . 182098) (BLTPATTERN.REPLACEDISPLAY 182100 . 184189) (
-BLTPATTERN.GENERIC 184191 . 185207)) (185210 197029 (EXPANDBITMAP 185220 . 187744) (EXPANDBM 187746 . 
-194301) (SHRINKBITMAP 194303 . 195647) (\FAST4BIT 195649 . 197027)) (197031 201020 (ROTATE-BITMAP 
-197031 . 201020)) (201022 204858 (ROTATE-BITMAP-LEFT 201022 . 204858)))))
+  (FILEMAP (NIL (4649 11812 (GRID 4659 . 8930) (GRIDXCOORD 8932 . 9437) (GRIDYCOORD 9439 . 9948) (
+LEFTOFGRIDCOORD 9950 . 10387) (BOTTOMOFGRIDCOORD 10389 . 10650) (SHADEGRIDBOX 10652 . 11810)) (11868 
+12276 (INSIDE? 11878 . 12274)) (12314 16710 (MOUSESTATE-EXPR 12324 . 15979) (MOUSESTATE-NAME 15981 . 
+16708)) (20200 21185 (DECODEBUTTONS 20210 . 21183)) (21186 22198 (PTDIFFERENCE 21196 . 21705) (PTPLUS 
+21707 . 22196)) (22249 50152 (GETPOSITION 22259 . 22567) (GETBOXPOSITION 22569 . 23252) (
+DSPYSCREENTOWINDOW 23254 . 23738) (DSPXSCREENTOWINDOW 23740 . 24224) (GETREGION 24226 . 24775) (
+\GETREGION.PACKPTS 24777 . 25345) (\GETREGION.CHECKBASEPT 25347 . 27290) (\GETREGION.CHECKOPPT 27292
+ . 30102) (\GETREGIONTRACKWITHBOX 30104 . 36635) (\UPDATEXYANDBOX 36637 . 39016) (GETBOXREGION 39018
+ . 39492) (\TRACKWITHBOX 39494 . 44632) (MOVEBOX 44634 . 45264) (DRAWGRAYBOX 45266 . 45788) (BLTHLINE 
+45790 . 46040) (BLTVLINE 46042 . 46281) (SETCORNER 46283 . 47549) (GETSCREENPOSITION 47551 . 48164) (
+GETBOXSCREENPOSITION 48166 . 48777) (GETSCREENREGION 48779 . 49435) (GETBOXSCREENREGION 49437 . 50150)
+) (50238 67054 (\MEDW.GETSCREENPOSITION 50248 . 52041) (\MEDW.GETBOXSCREENPOSITION 52043 . 55597) (
+\MEDW.GETSCREENREGION 55599 . 67052)) (67055 74793 (GETGRIDBOXREGION 67065 . 74719) (\RANGELIMIT 74721
+ . 74791)) (74794 77844 (MOUSECONFIRM 74804 . 77842)) (77985 79354 (NEAREST/PT/ON/GRID 77995 . 78590) 
+(PTON10GRID 78592 . 78917) (NEAREST/MULTIPLE 78919 . 79352)) (81398 85300 (\SW2BM 81408 . 84106) (
+COMPOSEREGS 84108 . 84662) (TRANSLATEREG 84664 . 85298)) (85342 176197 (EDITBM 85352 . 95681) (
+EDITBMSCROLLFN 95683 . 110836) (EDITBMCLOSEFN 110838 . 111455) (TILEAREA 111457 . 111848) (
+EDITBMBUTTONFN 111850 . 136677) (\EDITBM/PUTUP/DISPLAY 136679 . 137581) (\EDITBMHOWMUCH 137583 . 
+138569) (EDITBMRESHAPEFN 138571 . 147257) (EDITBMREPAINTFN 147259 . 148578) (UPDATE/SHADE/DISPLAY 
+148580 . 149027) (UPDATE/BM/DISPLAY/SELECTED/REGION 149029 . 150143) (SHOWBUTTON 150145 . 150703) (
+RESETGRID.NEW 150705 . 154054) (RESETGRID 154056 . 154880) (\READBMDIMENSIONS 154882 . 155919) (
+EDITSHADE 155921 . 164647) (\BITMAPFROMTEXTURE 164649 . 165347) (EDITSHADEREPAINTFN 165349 . 167123) (
+GRAYBOXAREA 167125 . 167808) (\SHADEBITS 167810 . 170775) (READHOTSPOT 170777 . 174642) (WBOX 174644
+ . 175368) (\CLEARBM 175370 . 175569) (EDITBMTEXTURE 175571 . 176195)) (177542 185249 (SCALEBM 177552
+ . 179618) (BLTPATTERN 179620 . 182138) (BLTPATTERN.REPLACEDISPLAY 182140 . 184229) (
+BLTPATTERN.GENERIC 184231 . 185247)) (185250 197069 (EXPANDBITMAP 185260 . 187784) (EXPANDBM 187786 . 
+194341) (SHRINKBITMAP 194343 . 195687) (\FAST4BIT 195689 . 197067)) (197071 201060 (ROTATE-BITMAP 
+197071 . 201060)) (201062 204898 (ROTATE-BITMAP-LEFT 201062 . 204898)))))
 STOP