MCCS coding for UNIX-GETENV, fix MTOUTF8STRING (#2474)
* MCCS translations for strings passed to/from UNIX-GETENV and other system interfaces. * INTERPRET.REM.CM assumes system external format is UTF-8. ISO8859/1 external format is defined in MCCS as a dummy for UTF-8 until UNICODE is loaded * Add string translation interface to EXTERNALFORMAT datatype, * Set the external format of the default reader environment to *DEFAULT-EXTERNALFORMAT* = :MCCS * Add external format :THROUGH16 for 16 bit codes, used by linebuffer
This commit is contained in:
rmkaplan
GitHub
265
sources/MCCS
265
sources/MCCS
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Oct-2025 08:50:00" {WMEDLEY}<sources>MCCS.;155 57020
|
||||
(FILECREATED " 5-Feb-2026 15:58:32" {WMEDLEY}<sources>MCCS.;163 65441
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS MCCSCOMS)
|
||||
:CHANGES-TO (FNS \DUMMY-UTF8-FORMAT \CREATE.XCCS.EXTERNALFORMAT)
|
||||
|
||||
:PREVIOUS-DATE "15-Oct-2025 18:31:01" {WMEDLEY}<sources>MCCS.;154)
|
||||
:PREVIOUS-DATE " 5-Feb-2026 12:26:39" {WMEDLEY}<sources>MCCS.;161)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MCCSCOMS)
|
||||
@@ -17,14 +17,14 @@
|
||||
|
||||
(FNS \MCCSINCCODE \MCCSPEEKCCODE \MCCSOUTCHAR \MCCSBACKCCODE \MCCSFORMATBYTESTREAM
|
||||
\MCCSCHARSETFN)
|
||||
(FNS \CREATE.MCCS.EXTERNALFORMAT)
|
||||
(FNS \CREATE.MCCS.EXTERNALFORMAT \CREATE.XCCS.EXTERNALFORMAT)
|
||||
(FNS \MCCS.24BITENCODING.ERROR)
|
||||
(INITVARS (*SIGNAL-MCCS.24BITENCODING.ERROR*))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS (\NORUNCODE 255)
|
||||
(NSCHARSETSHIFT 255))
|
||||
(MACROS \RUNCODED)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.MCCS.EXTERNALFORMAT :MCCS)
|
||||
(\CREATE.MCCS.EXTERNALFORMAT :XCCS)))
|
||||
(\CREATE.XCCS.EXTERNALFORMAT :XCCS)))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -57,7 +57,14 @@
|
||||
"Mappings into MCCS: needed for hardcopy and Tedit coercion, e.g. \TEDIT.MCCS.TRANSLATE")
|
||||
|
||||
(FNS GACHATOMCODE SYMBOLTOMCODE SIGMATOMCODE ATOMCODE MATHTOMCODE HIPPOTOMCODE
|
||||
CYRILLICTOMCODE PALATINOTOMCODE])
|
||||
CYRILLICTOMCODE PALATINOTOMCODE)))
|
||||
(COMS (* ; "ISO8859/1")
|
||||
(FNS ISO1TOMCODE MTOISO1CODE \CREATE.ISO1.FORMAT \DUMMY-UTF8-FORMAT)
|
||||
(FNS ISO1TOMSTRING MTOISO1STRING)
|
||||
(VARS ISO1TOMCCS)
|
||||
(GLOBALVARS ISO1TOMCCS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.ISO1.FORMAT)
|
||||
(\DUMMY-UTF8-FORMAT])
|
||||
|
||||
|
||||
|
||||
@@ -291,6 +298,33 @@
|
||||
(FUNCTION \MCCSFORMATBYTESTREAM)
|
||||
(OR EOL 'LF)
|
||||
T NIL NIL (FUNCTION \MCCSCHARSETFN])
|
||||
|
||||
(\CREATE.XCCS.EXTERNALFORMAT
|
||||
[LAMBDA (NAME EOL) (* ; "Edited 5-Feb-2026 15:54 by rmk")
|
||||
(* ; "Edited 1-Feb-2026 12:22 by rmk")
|
||||
(* ; "Edited 23-Apr-2025 14:19 by rmk")
|
||||
(* ; "Edited 7-Dec-2023 23:03 by rmk")
|
||||
(* ; "Edited 30-Jun-2022 18:08 by rmk")
|
||||
(* ; "Edited 10-Sep-2021 19:49 by rmk:")
|
||||
|
||||
(* ;;; "Create the :XCCS external format. Stream's EOL overrides the (vacuous) default here. Just like :MCCS except for switch of underscore-circumflex/arrows.")
|
||||
|
||||
(MAKE-EXTERNALFORMAT (OR NAME :XCCS)
|
||||
[FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(XTOMCODE (\MCCSINCCODE STREAM COUNTP]
|
||||
[FUNCTION (LAMBDA (STREAM NOERROR)
|
||||
(XTOMCODE (\MCCSPEEKCCODE STREAM NOERROR]
|
||||
[FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(XTOMCODE (\MCCSBACKCCODE STREAM COUNTP]
|
||||
[FUNCTION (LAMBDA (STREAM CHARCODE)
|
||||
(\MCCSOUTCHAR STREAM (MTOXCODE CHARCODE]
|
||||
(FUNCTION \MCCSFORMATBYTESTREAM)
|
||||
(OR EOL 'LF)
|
||||
T
|
||||
(FUNCTION MTOXSTRING)
|
||||
NIL
|
||||
(FUNCTION \MCCSCHARSETFN)
|
||||
(FUNCTION XTOMSTRING])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -338,7 +372,7 @@
|
||||
|
||||
(\CREATE.MCCS.EXTERNALFORMAT :MCCS)
|
||||
|
||||
(\CREATE.MCCS.EXTERNALFORMAT :XCCS)
|
||||
(\CREATE.XCCS.EXTERNALFORMAT :XCCS)
|
||||
)
|
||||
|
||||
|
||||
@@ -1246,7 +1280,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MCCSCODEMAPARRAY
|
||||
[LAMBDA (MAP) (* ; "Edited 6-Sep-2025 18:26 by rmk")
|
||||
[LAMBDA (MAP INVERT) (* ; "Edited 5-Feb-2026 11:02 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:11 by rmk")
|
||||
(* ; "Edited 6-Sep-2025 18:26 by rmk")
|
||||
(* ; "Edited 31-Aug-2025 16:15 by rmk")
|
||||
(* ; "Edited 7-Aug-2025 08:55 by rmk")
|
||||
(* ; "Edited 2-Jun-2025 11:45 by rmk")
|
||||
@@ -1260,19 +1296,28 @@
|
||||
(XCCS (SETQ MAP (APPEND MTOXCODEMAP ALTOTEXT2MCCS)))
|
||||
(MCCS (SETQ MAP ALTOTEXT2MCCS))
|
||||
NIL)
|
||||
(LET ((TABLE (ARRAY (ADD1 \MAXTHINCHAR)
|
||||
'WORD 0 0)))
|
||||
(for I from 0 to \MAXTHINCHAR do (SETA TABLE I I))
|
||||
(LET ((ARRAY (ARRAY (ADD1 \MAXTHINCHAR)
|
||||
'WORD 0 0))
|
||||
HARRAY)
|
||||
(for I from 0 to \MAXTHINCHAR do (SETA ARRAY I I)) (* ; "Default")
|
||||
[for PAIR FROMCODE in MAP when (LISTP PAIR) unless (EQ '* (CAR PAIR))
|
||||
when (SETQ FROMCODE (CL:IF (CHARCODEP (CAR PAIR))
|
||||
(CAR PAIR)
|
||||
when (SETQ FROMCODE (OR (CHARCODEP (CAR PAIR))
|
||||
(CHARCODE.DECODE (CAR PAIR)
|
||||
T))) do (SETA TABLE FROMCODE (CL:IF (CHARCODEP
|
||||
(CADR PAIR))
|
||||
(CADR PAIR)
|
||||
T))) do (SETA ARRAY FROMCODE (OR (CHARCODEP (CADR PAIR))
|
||||
(CHARCODE.DECODE
|
||||
(CADR PAIR)))]
|
||||
TABLE])
|
||||
(CADR PAIR]
|
||||
(CL:WHEN INVERT
|
||||
(SETQ HARRAY (HASHARRAY 20))
|
||||
(for I from 0 to \MAXTHINCHAR do (PUTHASH I I HARRAY))
|
||||
(for PAIR FROMCODE in MAP when (LISTP PAIR) unless (EQ '* (CAR PAIR))
|
||||
do (PUTHASH (OR (CHARCODEP (CADR PAIR))
|
||||
(CHARCODE.DECODE (CADR PAIR)))
|
||||
(OR (CHARCODEP (CAR PAIR))
|
||||
(CHARCODE.DECODE (CAR PAIR)))
|
||||
HARRAY)))
|
||||
(CL:IF HARRAY
|
||||
(LIST ARRAY HARRAY)
|
||||
ARRAY)])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -1496,16 +1541,178 @@
|
||||
MCODE)))
|
||||
PCODE])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ; "ISO8859/1")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(ISO1TOMCODE
|
||||
[LAMBDA (ICODE) (* ; "Edited 5-Feb-2026 12:09 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:14 by rmk")
|
||||
(* ; "Edited 7-Sep-2025 22:39 by rmk")
|
||||
(* ; "Edited 3-Sep-2025 10:21 by rmk")
|
||||
(* ; "Edited 7-Aug-2025 09:37 by rmk")
|
||||
|
||||
(* ;; "ISO codes are 8bit, MCODES maybe not. Caller shouldn't pass a fat code.")
|
||||
|
||||
(OR [CAR (find PAIR in ISO1TOMCCS suchthat (EQ ICODE (CADR PAIR]
|
||||
ICODE])
|
||||
|
||||
(MTOISO1CODE
|
||||
[LAMBDA (MCODE) (* ; "Edited 5-Feb-2026 12:26 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 22:58 by rmk")
|
||||
(OR (CADR (ASSOC MCODE ISO1TOMCCS))
|
||||
MCODE])
|
||||
|
||||
(\CREATE.ISO1.FORMAT
|
||||
[LAMBDA NIL (* ; "Edited 5-Feb-2026 10:42 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:37 by rmk")
|
||||
(* ; "Edited 1-Feb-2026 11:18 by rmk")
|
||||
(* ; "Edited 5-Aug-2021 22:15 by rmk:")
|
||||
(* ; "Edited 9-Mar-99 17:19 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 16:24 by ")
|
||||
(* ; "Edited 7-Dec-95 16:20 by ")
|
||||
(MAKE-EXTERNALFORMAT :ISO8859/1 [FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(ISO1TOMCODE (\THROUGHIN STREAM COUNTP]
|
||||
[FUNCTION (LAMBDA (STREAM NOERRORFLG)
|
||||
(ISO1TOMCODE (\PEEKBIN STREAM NOERRORFLG]
|
||||
(FUNCTION \THROUGHBACKCCODE)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
NIL NIL (FUNCTION MTOISO1STRING)
|
||||
NIL
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION ISO1TOMSTRING])
|
||||
|
||||
(\DUMMY-UTF8-FORMAT
|
||||
[LAMBDA NIL (* ; "Edited 5-Feb-2026 15:58 by rmk")
|
||||
(* ; "Edited 1-Feb-2026 13:16 by rmk")
|
||||
|
||||
(* ;; "Works only for 7-bit codes, during the loadup")
|
||||
|
||||
(\INSTALL.EXTERNALFORMAT (create EXTERNALFORMAT using (FIND-FORMAT :ISO8859/1)
|
||||
NAME _ :UTF-8])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(ISO1TOMSTRING
|
||||
[LAMBDA (ISTRING DESTRUCTIVE) (* ; "Edited 5-Feb-2026 11:01 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:46 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 12:14 by rmk")
|
||||
(* ; "Edited 29-Apr-2025 13:08 by rmk")
|
||||
|
||||
(* ;; "Converts ISO8859/1 codes to MCCS codes in MSTRING.")
|
||||
|
||||
(for I ICODE (MSTRING _ (CL:IF DESTRUCTIVE
|
||||
ISTRING
|
||||
(CONCAT ISTRING))) from 1 while (SETQ ICODE (NTHCHARCODE ISTRING I))
|
||||
do (RPLCHARCODE MSTRING I (ISO1TOMCODE ICODE)) finally (RETURN MSTRING])
|
||||
|
||||
(MTOISO1STRING
|
||||
[LAMBDA (MSTRING DESTRUCTIVE) (* ; "Edited 2-Feb-2026 23:47 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 12:22 by rmk")
|
||||
(* ; "Edited 29-Apr-2025 13:08 by rmk")
|
||||
|
||||
(* ;; "Converts MCCS to ISO8859/1 codes in MSTRING.")
|
||||
|
||||
(for I MCODE (ISTRING _ (CL:IF DESTRUCTIVE
|
||||
MSTRING
|
||||
(CONCAT MSTRING))) from 1 while (SETQ MCODE (NTHCHARCODE MSTRING I))
|
||||
do (RPLCHARCODE ISTRING I (MTOISO1CODE MCODE)) finally (RETURN ISTRING])
|
||||
)
|
||||
|
||||
(RPAQQ ISO1TOMCCS
|
||||
((94 8593)
|
||||
(95 8592)
|
||||
(169 8216)
|
||||
(170 8220)
|
||||
(172 95)
|
||||
(173 94)
|
||||
(174 8594)
|
||||
(175 8595)
|
||||
(180 215)
|
||||
(184 247)
|
||||
(185 8217)
|
||||
(186 8221)
|
||||
(193 768)
|
||||
(194 769)
|
||||
(195 770)
|
||||
(196 771)
|
||||
(197 772)
|
||||
(198 774)
|
||||
(199 775)
|
||||
(200 776)
|
||||
(202 778)
|
||||
(203 807)
|
||||
(204 818)
|
||||
(205 779)
|
||||
(206 808)
|
||||
(207 780)
|
||||
(208 8213)
|
||||
(209 185)
|
||||
(210 174)
|
||||
(211 169)
|
||||
(212 8482)
|
||||
(213 9834)
|
||||
(220 8539)
|
||||
(221 8540)
|
||||
(222 8541)
|
||||
(223 8542)
|
||||
(224 8486)
|
||||
(225 198)
|
||||
(226 208)
|
||||
(227 170)
|
||||
(228 294)
|
||||
(229 567)
|
||||
(230 306)
|
||||
(231 319)
|
||||
(232 321)
|
||||
(233 216)
|
||||
(234 338)
|
||||
(235 186)
|
||||
(236 222)
|
||||
(237 358)
|
||||
(238 330)
|
||||
(239 329)
|
||||
(240 312)
|
||||
(241 230)
|
||||
(242 273)
|
||||
(243 240)
|
||||
(244 295)
|
||||
(245 305)
|
||||
(246 307)
|
||||
(247 320)
|
||||
(248 322)
|
||||
(249 248)
|
||||
(250 339)
|
||||
(251 223)
|
||||
(252 254)
|
||||
(253 359)
|
||||
(254 331)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS ISO1TOMCCS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(\CREATE.ISO1.FORMAT)
|
||||
|
||||
(\DUMMY-UTF8-FORMAT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2853 14424 (\MCCSINCCODE 2863 . 5951) (\MCCSPEEKCCODE 5953 . 8840) (\MCCSOUTCHAR 8842
|
||||
. 10941) (\MCCSBACKCCODE 10943 . 12487) (\MCCSFORMATBYTESTREAM 12489 . 13219) (\MCCSCHARSETFN 13221
|
||||
. 14422)) (14425 15307 (\CREATE.MCCS.EXTERNALFORMAT 14435 . 15305)) (15308 16285 (
|
||||
\MCCS.24BITENCODING.ERROR 15318 . 16283)) (17661 20299 (MTOXCODE 17671 . 18468) (XTOMCODE 18470 .
|
||||
19127) (XTOMSTRING 19129 . 19714) (MTOXSTRING 19716 . 20297)) (20300 21960 (MTOX$CODE 20310 . 21042) (
|
||||
X$TOMCODE 21044 . 21958)) (21961 22601 (KANJICHARSETP 21971 . 22227) (CHINESECHARSETP 22229 . 22599))
|
||||
(43169 45043 (MCCSCODEMAPARRAY 43179 . 45041)) (45659 52140 (MCCSMAPFN 45669 . 47036) (MCCSMAPPAIRS
|
||||
47038 . 51146) (XCCS.CS0.UNDEFINED 51148 . 51777) (XCCSUNDEFINEDPAIRS 51779 . 52138)) (52245 56997 (
|
||||
GACHATOMCODE 52255 . 52767) (SYMBOLTOMCODE 52769 . 53417) (SIGMATOMCODE 53419 . 54065) (ATOMCODE 54067
|
||||
. 54599) (MATHTOMCODE 54601 . 55257) (HIPPOTOMCODE 55259 . 55796) (CYRILLICTOMCODE 55798 . 56232) (
|
||||
PALATINOTOMCODE 56234 . 56995)))))
|
||||
(FILEMAP (NIL (3345 14916 (\MCCSINCCODE 3355 . 6443) (\MCCSPEEKCCODE 6445 . 9332) (\MCCSOUTCHAR 9334
|
||||
. 11433) (\MCCSBACKCCODE 11435 . 12979) (\MCCSFORMATBYTESTREAM 12981 . 13711) (\MCCSCHARSETFN 13713
|
||||
. 14914)) (14917 17368 (\CREATE.MCCS.EXTERNALFORMAT 14927 . 15797) (\CREATE.XCCS.EXTERNALFORMAT 15799
|
||||
. 17366)) (17369 18346 (\MCCS.24BITENCODING.ERROR 17379 . 18344)) (19722 22360 (MTOXCODE 19732 .
|
||||
20529) (XTOMCODE 20531 . 21188) (XTOMSTRING 21190 . 21775) (MTOXSTRING 21777 . 22358)) (22361 24021 (
|
||||
MTOX$CODE 22371 . 23103) (X$TOMCODE 23105 . 24019)) (24022 24662 (KANJICHARSETP 24032 . 24288) (
|
||||
CHINESECHARSETP 24290 . 24660)) (45230 47719 (MCCSCODEMAPARRAY 45240 . 47717)) (48335 54816 (MCCSMAPFN
|
||||
48345 . 49712) (MCCSMAPPAIRS 49714 . 53822) (XCCS.CS0.UNDEFINED 53824 . 54453) (XCCSUNDEFINEDPAIRS
|
||||
54455 . 54814)) (54921 59673 (GACHATOMCODE 54931 . 55443) (SYMBOLTOMCODE 55445 . 56093) (SIGMATOMCODE
|
||||
56095 . 56741) (ATOMCODE 56743 . 57275) (MATHTOMCODE 57277 . 57933) (HIPPOTOMCODE 57935 . 58472) (
|
||||
CYRILLICTOMCODE 58474 . 58908) (PALATINOTOMCODE 58910 . 59671)) (59700 62493 (ISO1TOMCODE 59710 .
|
||||
60459) (MTOISO1CODE 60461 . 60751) (\CREATE.ISO1.FORMAT 60753 . 62018) (\DUMMY-UTF8-FORMAT 62020 .
|
||||
62491)) (62494 64025 (ISO1TOMSTRING 62504 . 63320) (MTOISO1STRING 63322 . 64023)))))
|
||||
STOP
|
||||
|
||||
Reference in New Issue
Block a user