github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-14 12:14:26 +00:00
Code Issues Projects Releases Wiki Activity

rmk122--Next round on fonts and MCCS (#2280)

Browse Source 
* A revision to the font, Unicode, Tedit, and other modules to implement the MCCS character coding as the standard for internal text strings.  MCCS is a variant of XCCS with arrows switched with circumflex/underscore and $ switched with currency, and allows for additional code assignments over time. :MCCS replaces :XCCS as the default external format, especially for source files.  The file XCCS is removed in favor of the file MCCS, which includes the XCCS external format for backward compatibility.

* This includes a single Medley-font formatted font file for each of the family/size/face display fonts.  The glyph assignments correspond to the MCCS character encoding (except for fonts with idiosyncratic encodings--Hippo, Symbol).  All charsets from legacy font files are included in each file, and the character sets and glyphs in each file have also been extended by offline coercion from related families (e.g. Glyphs not in legacy Terminal are taken from legacy Modern). There should be fewer black boxes, and character-display shouldn't change when you switch fonts.

* The Unicode mapping tables have been redefined to set up correspondences between Unicode and MCCS, not XCCS.  Separate XCCS to/from MCCS mapping functions are provided in the file MCCS; they are no longer included in INTERPRESS.

* TEDIT converts characters in legacy fonts to their new MCCS codes as it reads formatted files, marks the file as MCCS compatible and preserves the new codes on writing.

* Default keyboard assignments produce the MCCS uparrow and leftarrow for shift-6 and shift-hyphen, use Function-6 for circumflex and Function-10 for underscore.

See documentation in FONTCODECHANGES.TEDIT MCCS.TEDIT MEDLEYFONTFORMAT.TEDIT in docs/internal, and library/UNICODE.TEDIT.
This commit is contained in:
rmkaplan
2025-10-20 17:17:34 -07:00
committed by GitHub
parent 54353a4bef
commit 82fc95ce18
401 changed files with 8871 additions and 6601 deletions
Download Patch File Download Diff File Expand all files Collapse all files

148
internal/FONT-DEBUG
View File

@@ -1,23 +1,25 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Jul-2025 16:43:34" {WMEDLEY}<internal>FONT-DEBUG.;46 19345
(FILECREATED " 7-Oct-2025 14:52:20" {WMEDLEY}<internal>FONT-DEBUG.;68 23618
:EDIT-BY rmk
:CHANGES-TO (FNS CSBMSIZE FONTSIZE CSSIZE EQCHARBM)
(VARS FONT-DEBUGCOMS)
:CHANGES-TO (FNS LEGACYFONTCREATE)
:PREVIOUS-DATE "19-Jul-2025 12:36:48" {WMEDLEY}<internal>FONT-DEBUG.;41)
:PREVIOUS-DATE " 7-Oct-2025 08:58:03" {WMEDLEY}<internal>FONT-DEBUG.;67)
(PRETTYCOMPRINT FONT-DEBUGCOMS)
(RPAQQ FONT-DEBUGCOMS (
(* ;; "Little tools to help in debugging display fonts")
(RPAQQ FONT-DEBUGCOMS
(
(* ;; "Little tools to help in debugging display fonts")
(FNS DEBUGCHARSET IBM ICS SHOWCACHE SHOWCSBITMAP EQCSBM EQCHARBM CHARSETCHARS
CHARBMDIFFS SHOWCSCHAR CSCOMPARE SHOWBMS SHOWCHARBITMAPS CANDS)
(FNS FONTSIZE CSSIZE CSBMSIZE)))
(FNS DEBUGCHARSET IBM ICS SHOWCACHE SHOWCSBITMAP EQCSBM EQCHARBM CHARSETCHARS CHARBMDIFFS
SHOWCSCHAR CSCOMPARE SHOWBMS SHOWCHARBITMAPS CANDS LEGACYFONTCREATE)
(FNS FONTSIZE CSSIZE CSBMSIZE)
(FNS FONTCOMPARE)
(MACROS TRUEFONT)))
@@ -26,7 +28,8 @@
(DEFINEQ
(DEBUGCHARSET
[LAMBDA (FONTSPEC CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 9-Jul-2025 16:26 by rmk")
[LAMBDA (FONTSPEC CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 27-Aug-2025 17:19 by rmk")
(* ; "Edited 9-Jul-2025 16:26 by rmk")
(* ; "Edited 6-Jul-2025 22:33 by rmk")
(* ; "Edited 2-Jul-2025 16:50 by rmk")
(* ; "Edited 30-Jun-2025 09:27 by rmk")
@@ -43,46 +46,41 @@
(CL:UNLESS INCLUDEMEDLEYFONT
(RESETSAVE DISPLAYFONTEXTENSIONS (REMOVE 'MEDLEYDISPLAYFONT DISPLAYFONTEXTENSIONS)
))
[if (OR (LITATOM FONTSPEC)
(if (OR (LITATOM FONTSPEC)
(STRINGP FONTSPEC))
then (CL:UNLESS CHARSET (SETQ CHARSET 0))
(LET (STRM)
[RESETSAVE (SETQ STRM (OPENSTREAM FONTSPEC 'INPUT))
`(PROGN (CLOSEF? OLDVALUE]
(for FNS CSINFO (FI _ (\FONTINFOFROMFILENAME FONTSPEC 'DISPLAY))
(for FNS CSINFO (FI _ (FONTSPECFROMFILENAME FONTSPEC 'DISPLAY))
in DISPLAYCHARSETFNS
do (CL:WHEN (CAR (NLSETQ (APPLY* (CADR FNS)
STRM)))
(SETQ CSINFO (APPLY* (CADDR FNS)
STRM
(CAR FI)
(CADR FI)
(CADDR FI)
(CADDDR FI)
(CAR (CDDDDR FI))
CHARSET))
STRM CHARSET))
(PUTMULTI (fetch (CHARSETINFO CSINFOPROPS) of CSINFO)
'FILE
(PSEUDOFILENAME FONTSPEC))
(RETURN CSINFO))
(CLOSEF? STRM)))
else (LET ((CS CHARSET))
(CL:MULTIPLE-VALUE-BIND (FAMILY SIZE FACE ROTATION DEVICE CHARSET)
(\FONT.CHECKARGS FONTSPEC)
(CL:WHEN CS (SETQ CHARSET CS))
(\READCHARSET FAMILY SIZE FACE ROTATION 'DISPLAY CHARSET])])
else (\READCHARSET (\FONT.CHECKARGS FONTSPEC)
CHARSET)))])
(IBM
[LAMBDA (FONT CHARSET) (* ; "Edited 29-Jun-2025 17:05 by rmk")
[LAMBDA (FONT CHARSET) (* ; "Edited 27-Aug-2025 17:29 by rmk")
(* ; "Edited 25-Aug-2025 08:58 by rmk")
(* ; "Edited 29-Jun-2025 17:05 by rmk")
(* ; "Edited 20-Jun-2025 16:35 by rmk")
(* ; "Edited 18-Jun-2025 14:09 by rmk")
(* ;; "Inspects the character set bitmap for CHARSET in FONT, which may also be a charset info. If necessary, builds the font (unlike ICS).")
(SETQ CHARSET (CHARSET.DECODE CHARSET))
(SHOWCSBITMAP (if (type? CHARSETINFO FONT)
then FONT
else (\XGETCHARSETINFO (SETQ FONT (FONTCREATE FONT))
(OR CHARSET 0])
elseif FONT
then (\XGETCHARSETINFO (FONTCREATE FONT)
(OR CHARSET 0])
(ICS
[LAMBDA (FONT CHARSET INCLUDEMEDLEYFONT) (* ; "Edited 7-Jul-2025 23:12 by rmk")
@@ -114,7 +112,8 @@
(DV \FONTEXISTS?-CACHE])
(SHOWCSBITMAP
[LAMBDA (CSINFO) (* ; "Edited 29-Jun-2025 17:07 by rmk")
[LAMBDA (CSINFO) (* ; "Edited 17-Aug-2025 12:36 by rmk")
(* ; "Edited 29-Jun-2025 17:07 by rmk")
(* ; "Edited 20-Jun-2025 16:38 by rmk")
(* ;; "Given a charsetinfo, shows the whole bitmap using EDITBM. Unfortunately, that runs in a separate process, so we can't directly get the window to put something useful in the title. If EDITBM is called directly, it doen't return until you quit...in which case it's gone. We'd really like just the displayer.")
@@ -129,7 +128,7 @@
(IGREATERP (BITMAPHEIGHT BM)
0))
then (EVAL.AS.PROCESS (LIST 'EDITBM BM))
else "EMPTY BITMAP")
else (PRINTOUT T "EMPTY BITMAP" T))
CSINFO])
(EQCSBM
@@ -277,11 +276,28 @@
(LET ((CINFOS (CSCOMPARE CS1 CS2 CHARSET INCLUDEMEDLEYFONT)))
(SHOWCHARBITMAPS NIL CINFOS CHARSET INCLUDEMEDLEYFONT T)
CINFOS])
(LEGACYFONTCREATE
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET)
(* ; "Edited 7-Oct-2025 14:50 by rmk")
(* ; "Edited 2-Sep-2025 13:46 by rmk")
(* ; "Edited 29-Aug-2025 22:38 by rmk")
(* ; "Edited 17-Aug-2025 15:47 by rmk")
(* ; "Edited 31-Jul-2025 10:10 by rmk")
(* ; "Edited 25-Jul-2025 13:43 by rmk")
(* ;; "New font, no coercions, no MEDLEYFORMAT")
(LEGACYFONTS (FONTCREATE FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET])
)
(DEFINEQ
(FONTSIZE
[LAMBDA (FONT CHARSETS FILETOO NOERROR) (* ; "Edited 19-Jul-2025 16:42 by rmk")
[LAMBDA (FONT CHARSETS FILETOO NOERROR) (* ; "Edited 16-Aug-2025 23:34 by rmk")
(* ; "Edited 19-Jul-2025 16:42 by rmk")
(* ;; "Estimates the amount of storage occupied by FONT")
(SETQ FONT (FONTCREATE FONT NIL NIL NIL 'DISPLAY NOERROR))
(CL:UNLESS CHARSETS
(SETQ CHARSETS (for CS CSINFO BM from 0 to 255 when (SETQ CSINFO (\XGETCHARSETINFO FONT CS))
@@ -343,10 +359,72 @@
8) finally (PRINTOUT T T))
else 0])
)
(DEFINEQ
(FONTCOMPARE
[LAMBDA (ARGS VIRGIN SHOWFONT) (* ; "Edited 5-Aug-2025 13:14 by rmk")
(* ;; "Prints a line of characters in different fonts, for shape/size comparison. Each argument is a list of the form (FONT CHAR1 CHAR2...) or (FONT CHAR1 - CHARN) (hyphen). Characters can be codes or names.")
(* ;; "If CHARS are not specfied, uses the chars from the previous arg.")
(RESETLST
(RESETSAVE (DSPFONT NIL T))
(CL:WHEN VIRGIN
(RESETSAVE \FONTSINCORE NIL)
(RESETSAVE \DISPLAYCHARSETCOERCIONS NIL)
(RESETSAVE \DISPLAYFONTCOERCIONS NIL)
(RESETSAVE \FONTEXISTS?-CACHE NIL)
(RESETSAVE DISPLAYFONTEXTENSIONS '(DISPLAYFONT)))
(TERPRI T)
(for A CHARS FONT SIZEPOS in ARGS
do (CL:WHEN (CADR A)
(SETQ CHARS (CDR A))
[SETQ CHARS (if (EQ '- (CADR CHARS))
then (for C from (CL:IF (CHARCODEP (CAR CHARS))
(CAR CHARS)
(CHARCODE.DECODE (CAR CHARS)))
to (CL:IF (CHARCODEP (CADDR CHARS))
(CADDR CHARS)
(CHARCODE.DECODE (CADDR CHARS))) collect C)
else (for C in CHARS collect (CL:IF (CHARCODEP C)
C
(CHARCODE.DECODE C))])
(SETQ FONT (FONTCREATE (CAR A)))
(if SHOWFONT
then (SETQ SIZEPOS (IDIFFERENCE (STRPOS "-" FONT)
2))
(PRINTOUT T .FONT '(GACHA 8)
" ["
(SUBSTRING FONT 2 3)
(SUBSTRING FONT SIZEPOS (ADD1 SIZEPOS))
"]")
else (PRINTOUT T .FONT '(GACHA 8)
"/"))
(DSPFONT FONT T)
(for C in CHARS do (PRIN1 (CHARACTER C)
T)))
(TERPRI T))])
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS TRUEFONT MACRO ((FORM) (* ;
 "Execute FORM in a non-medleyfont displayfont environment")
(RESETVARS (\FONTSINCORE \FONTEXISTS?-CACHE DISPLAYFONTCOERCIONS
DISPLAYCHARCOERCIONS (DISPLAYFONTEXTENSIONS '(DISPLAYFONT
))
(DISPLAYFONTDIRECTORIES (MEDLEYDIR "fonts>displayfonts>")
)
(DISPLAYCHARSETFNS (REMOVE (ASSOC 'MEDLEYFONT
DISPLAYCHARSETFNS)
DISPLAYCHARSETFNS)))
(RETURN FORM))))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (818 15839 (DEBUGCHARSET 828 . 4007) (IBM 4009 . 4717) (ICS 4719 . 6013) (SHOWCACHE 6015
. 6362) (SHOWCSBITMAP 6364 . 7478) (EQCSBM 7480 . 8366) (EQCHARBM 8368 . 9129) (CHARSETCHARS 9131 .
9797) (CHARBMDIFFS 9799 . 10675) (SHOWCSCHAR 10677 . 11112) (CSCOMPARE 11114 . 13706) (SHOWBMS 13708
. 13886) (SHOWCHARBITMAPS 13888 . 15479) (CANDS 15481 . 15837)) (15840 19322 (FONTSIZE 15850 . 16535)
(CSSIZE 16537 . 17946) (CSBMSIZE 17948 . 19320)))))
(FILEMAP (NIL (778 16538 (DEBUGCHARSET 788 . 3409) (IBM 3411 . 4409) (ICS 4411 . 5705) (SHOWCACHE 5707
. 6054) (SHOWCSBITMAP 6056 . 7294) (EQCSBM 7296 . 8182) (EQCHARBM 8184 . 8945) (CHARSETCHARS 8947 .
9613) (CHARBMDIFFS 9615 . 10491) (SHOWCSCHAR 10493 . 10928) (CSCOMPARE 10930 . 13522) (SHOWBMS 13524
. 13702) (SHOWCHARBITMAPS 13704 . 15295) (CANDS 15297 . 15653) (LEGACYFONTCREATE 15655 . 16536)) (
16539 20198 (FONTSIZE 16549 . 17411) (CSSIZE 17413 . 18822) (CSBMSIZE 18824 . 20196)) (20199 22606 (
FONTCOMPARE 20209 . 22604)))))
STOP

BIN
internal/FONT-DEBUG.LCOM
View File

Binary file not shown.

14
internal/loadups/LOADUP-FULL
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Sep-2025 11:59:41" {WMEDLEY}<internal>loadups>LOADUP-FULL.;31 5430
(FILECREATED "20-Sep-2025 14:18:19" {WMEDLEY}<internal>loadups>LOADUP-FULL.;34 5662
:EDIT-BY rmk
:CHANGES-TO (FNS LOADUP-FULL)
:CHANGES-TO (FNS LOADFULLFONTS)
:PREVIOUS-DATE "18-Aug-2025 12:09:49" {WMEDLEY}<internal>loadups>LOADUP-FULL.;29)
:PREVIOUS-DATE " 2-Sep-2025 20:07:20" {WMEDLEY}<internal>loadups>LOADUP-FULL.;33)
(PRETTYCOMPRINT LOADUP-FULLCOMS)
@@ -16,7 +16,9 @@
(DEFINEQ
(LOADFULLFONTS
[LAMBDA NIL (* ; "Edited 13-Jul-2025 11:40 by rmk")
[LAMBDA NIL (* ; "Edited 20-Sep-2025 14:17 by rmk")
(* ; "Edited 2-Sep-2025 20:06 by rmk")
(* ; "Edited 13-Jul-2025 11:40 by rmk")
(* ; "Edited 30-Jun-2025 00:04 by rmk")
(* ; "Edited 20-Jun-2025 11:16 by rmk")
(* ; "Edited 16-Jun-2025 15:34 by rmk")
@@ -36,7 +38,7 @@
do (PRINTOUT T SIZE " ")
(for FACE in '(MRR BRR MIR)
do (FONTCREATE FAMILY SIZE FACE 0 'DISPLAY NIL 0)
(for CSET in '(33 34 35 238 239 241)
(for CSET in '("41" "42" "43" "356" "357" "361")
do (NLSETQ (FONTCREATE FAMILY SIZE FACE 0 'DISPLAY NIL CSET]
(PRINTOUT T T))
(PRINTOUT T " Loading postscript fonts" T)
@@ -98,5 +100,5 @@
(FIXMETA)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (456 5392 (LOADFULLFONTS 466 . 2371) (LOADUP-FULL 2373 . 5142) (FIXMETA 5144 . 5390)))))
(FILEMAP (NIL (458 5624 (LOADFULLFONTS 468 . 2603) (LOADUP-FULL 2605 . 5374) (FIXMETA 5376 . 5622)))))
STOP

BIN
internal/loadups/LOADUP-FULL.LCOM
View File

Binary file not shown.