github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-28 21:08:23 +00:00
Code Issues Projects Releases Wiki Activity

Fix glitches

Browse Source
This commit is contained in:
rmkaplan
2025-10-09 21:21:58 -07:00
parent 63f32bc324
commit 5c011373e2
6 changed files with 130 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
sources/MCCS
View File

@@ -1,14 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Oct-2025 16:44:20" {WMEDLEY}<sources>MCCS.;149 56371
(FILECREATED " 7-Oct-2025 14:52:10" {WMEDLEY}<sources>MCCS.;152 57023
:EDIT-BY rmk
:CHANGES-TO (VARS PALATINOTOMCCS MCCSCOMS)
(FNS MCCSMAPPAIRS XCCS.CS0.UNDEFINED XCCSUNDEFINEDPAIRS XCCSUNDEFINEDCONTROLS
PALATINOTOMCODE MCCSMAPFN)
:CHANGES-TO (FNS MCCSMAPPAIRS)
:PREVIOUS-DATE "20-Sep-2025 09:45:41" {WMEDLEY}<sources>MCCS.;138)
:PREVIOUS-DATE " 6-Oct-2025 16:44:20" {WMEDLEY}<sources>MCCS.;149)
(PRETTYCOMPRINT MCCSCOMS)
@@ -1329,7 +1327,8 @@
NIL])
(MCCSMAPPAIRS
[LAMBDA (FROMENCODING NONIDENTITY) (* ; "Edited 6-Oct-2025 09:47 by rmk")
[LAMBDA (FROMENCODING NONIDENTITY) (* ; "Edited 7-Oct-2025 14:47 by rmk")
(* ; "Edited 6-Oct-2025 09:47 by rmk")
(* ; "Edited 20-Sep-2025 09:45 by rmk")
(* ; "Edited 6-Sep-2025 16:43 by rmk")
(* ; "Edited 31-Aug-2025 16:16 by rmk")
@@ -1337,7 +1336,7 @@
(* ;; "Returns the pairs for MOVEFONTCHARS to use to move charset-0 glyphs into their MCCS positions. For example, the Leftarrow and Lowline glyphs switch positions in an XCCS$ font. Returns NIL (= nothing to do) if there is no function.")
(LET ((FN (MCCSMAPFN FROMENCODING))
PAIRS)
PAIRS KEEPCS0)
(CL:WHEN FN
[SETQ PAIRS (SELECTQ FROMENCODING
(GACHA (* ; "ctrl and upper are slugged")
@@ -1353,8 +1352,10 @@
(Circumflex Uparrow)))
(PALATINO (APPEND (XCCS.CS0.UNDEFINED)
PALATINOTOMCCS))
(for C M from 0 to \MAXTHINCHAR when (SETQ M (APPLY* FN C NONIDENTITY))
collect (LIST C M]
(PROGN (SETQ KEEPCS0 T)
(for C M from 0 to \MAXTHINCHAR
when (SETQ M (APPLY* FN C NONIDENTITY))
collect (LIST C M]
(* ;; "Weed out interspersed comments, convert to charcodes")
@@ -1375,10 +1376,16 @@
(CADR P)
(CHARCODE.DECODE (CADR P)))]
(* ;;
 "Any character that is moved gets replaced by a slug. It may then be coerced from another font.")
(* ;; "Any character that is moved gets replaced by a slug. It may then be coerced from another font. But families like SYMBOL, HIPPO etc. want to preserve CS0 even if they copy their glyphs also to somewhere else.")
[APPEND PAIRS (for P in PAIRS when (CAR P) collect (LIST NIL (CAR P])])
[APPEND PAIRS (for P in PAIRS when (CAR P)
unless [OR (AND KEEPCS0 (ILEQ (CAR P)
\MAXTHINCHAR))
(AND (LISTP (CAR P))
(LITATOM (CADAR P)))
(thereis X in PAIRS suchthat (EQ (CADR X)
(CAR P]
collect (LIST NIL (CAR P])])
(XCCS.CS0.UNDEFINED
[LAMBDA NIL (* ; "Edited 5-Oct-2025 22:44 by rmk")
@@ -1490,15 +1497,15 @@
PCODE])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3015 14586 (\MCCSINCCODE 3025 . 6113) (\MCCSPEEKCCODE 6115 . 9002) (\MCCSOUTCHAR 9004
. 11103) (\MCCSBACKCCODE 11105 . 12649) (\MCCSFORMATBYTESTREAM 12651 . 13381) (\MCCSCHARSETFN 13383
. 14584)) (14587 15469 (\CREATE.MCCS.EXTERNALFORMAT 14597 . 15467)) (15470 16447 (
\MCCS.24BITENCODING.ERROR 15480 . 16445)) (17823 20461 (MTOXCODE 17833 . 18630) (XTOMCODE 18632 .
19289) (XTOMSTRING 19291 . 19876) (MTOXSTRING 19878 . 20459)) (20462 22122 (MTOX$CODE 20472 . 21204) (
X$TOMCODE 21206 . 22120)) (22123 22763 (KANJICHARSETP 22133 . 22389) (CHINESECHARSETP 22391 . 22761))
(43331 45205 (MCCSCODEMAPARRAY 43341 . 45203)) (45821 51491 (MCCSMAPFN 45831 . 47198) (MCCSMAPPAIRS
47200 . 50497) (XCCS.CS0.UNDEFINED 50499 . 51128) (XCCSUNDEFINEDPAIRS 51130 . 51489)) (51596 56348 (
GACHATOMCODE 51606 . 52118) (SYMBOLTOMCODE 52120 . 52768) (SIGMATOMCODE 52770 . 53416) (ATOMCODE 53418
. 53950) (MATHTOMCODE 53952 . 54608) (HIPPOTOMCODE 54610 . 55147) (CYRILLICTOMCODE 55149 . 55583) (
PALATINOTOMCODE 55585 . 56346)))))
(FILEMAP (NIL (2856 14427 (\MCCSINCCODE 2866 . 5954) (\MCCSPEEKCCODE 5956 . 8843) (\MCCSOUTCHAR 8845
. 10944) (\MCCSBACKCCODE 10946 . 12490) (\MCCSFORMATBYTESTREAM 12492 . 13222) (\MCCSCHARSETFN 13224
. 14425)) (14428 15310 (\CREATE.MCCS.EXTERNALFORMAT 14438 . 15308)) (15311 16288 (
\MCCS.24BITENCODING.ERROR 15321 . 16286)) (17664 20302 (MTOXCODE 17674 . 18471) (XTOMCODE 18473 .
19130) (XTOMSTRING 19132 . 19717) (MTOXSTRING 19719 . 20300)) (20303 21963 (MTOX$CODE 20313 . 21045) (
X$TOMCODE 21047 . 21961)) (21964 22604 (KANJICHARSETP 21974 . 22230) (CHINESECHARSETP 22232 . 22602))
(43172 45046 (MCCSCODEMAPARRAY 43182 . 45044)) (45662 52143 (MCCSMAPFN 45672 . 47039) (MCCSMAPPAIRS
47041 . 51149) (XCCS.CS0.UNDEFINED 51151 . 51780) (XCCSUNDEFINEDPAIRS 51782 . 52141)) (52248 57000 (
GACHATOMCODE 52258 . 52770) (SYMBOLTOMCODE 52772 . 53420) (SIGMATOMCODE 53422 . 54068) (ATOMCODE 54070
. 54602) (MATHTOMCODE 54604 . 55260) (HIPPOTOMCODE 55262 . 55799) (CYRILLICTOMCODE 55801 . 56235) (
PALATINOTOMCODE 56237 . 56998)))))
STOP