From 625a5a839cc08e4960f6f71630a66463b812766c Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Thu, 30 Sep 2021 23:17:28 -0700 Subject: [PATCH] Convert UNICODE to LF Don't know why it reverted. Just a MAKEFILE NEW and recompile --- library/UNICODE | 417 +++++++++++++++++++++++++++---------------- library/UNICODE.LCOM | Bin 22194 -> 22117 bytes 2 files changed, 261 insertions(+), 156 deletions(-) diff --git a/library/UNICODE b/library/UNICODE index ad9e3b1c..e7b12cc8 100644 --- a/library/UNICODE +++ b/library/UNICODE @@ -1,18 +1,16 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-Aug-2021 13:13:04"  -{DSK}kaplan>Local>medley3.5>git-medley>library>UNICODE.;193 64903 +(FILECREATED "30-Sep-2021 16:03:18"  +{DSK}kaplan>Local>medley3.5>git-medley>library>UNICODE.;194 64783 - changes to%: (FNS MAKE-UNICODE-TRANSLATION-TABLES) - - previous date%: " 8-Aug-2021 13:10:17" -{DSK}kaplan>Local>medley3.5>git-medley>library>UNICODE.;192) + previous date%: "21-Aug-2021 13:13:04" +{DSK}kaplan>Local>medley3.5>git-medley>library>UNICODE.;193) (PRETTYCOMPRINT UNICODECOMS) (RPAQQ UNICODECOMS [(COMS - (* ;; "External formats") + (* ;; "External formats") (FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN) (FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16.BACKCCODEFN) @@ -25,14 +23,14 @@ (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE)) (FNS XTOUCODE UTOXCODE)) [COMS - (* ;; "Unicode mapping files") + (* ;; "Unicode mapping files") (FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING WRITE-UNICODE-MAPPING WRITE-UNICODE-INCLUDED WRITE-UNICODE-MAPPING-HEADER WRITE-UNICODE-MAPPING-FILENAME ) (VARS XCCS-SET-NAMES) - (* ;; "Automate dumping of a documentation prefix") + (* ;; "Automate dumping of a documentation prefix") [DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (MISSINGCODE (CL:PARSE-INTEGER "FFFE" :RADIX 16)) @@ -43,7 +41,7 @@ (P (PUSHNEW UNICODEDIRECTORIES (PACK* (UNIX-GETENV "MEDLEYDIR") '/unicode/xerox/] (COMS - (* ;; "Set up translation tables for UTF8 and UTFBE external formats") + (* ;; "Set up translation tables for UTF8 and UTFBE external formats") (FNS MAKE-UNICODE-TRANSLATION-TABLES) [INITVARS (DEFAULT-XCCS-CHARSETS '(LATIN SYMBOLS1 SYMBOLS2 EXTENDED-LATIN FORMS @@ -63,7 +61,7 @@ "NOTE: UNICODE requires EXPORTS.ALL for compilation" T))) - (* ;; "These control the layout of the translation tables. Since many of the upper panels are sparse, doing it per-panel (128) seems more space-efficient, and residual alists can be shorter") + (* ;; "These control the layout of the translation tables. Since many of the upper panels are sparse, doing it per-panel (128) seems more space-efficient, and residual alists can be shorter") (CONSTANTS (TRANSLATION-SEGMENT-SIZE 128) (MAX-ALIST-LENGTH 10) @@ -78,13 +76,13 @@ (DEFINEQ (UTF8.OUTCHARFN - [LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 8-Aug-2021 13:02 by rmk:") - (* ; "Edited 17-Aug-2020 08:45 by rmk:") - (* ; "Edited 30-Jan-2020 23:08 by rmk:") + [LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 8-Aug-2021 13:02 by rmk:") + (* ; "Edited 17-Aug-2020 08:45 by rmk:") + (* ; "Edited 30-Jan-2020 23:08 by rmk:") - (* ;; "Perhaps the translation table should already do the mapping for EOL to LF, but that seems to be a separate property of the stream. Also, CRLF=2 bytes.") + (* ;; "Perhaps the translation table should already do the mapping for EOL to LF, but that seems to be a separate property of the stream. Also, CRLF=2 bytes.") - (* ;; "Print UTF8 sequence for CHARCODE. Do not do XCCS to Unicode translation if RAW.") + (* ;; "Print UTF8 sequence for CHARCODE. Do not do XCCS to Unicode translation if RAW.") (IF (EQ CHARCODE (CHARCODE EOL)) THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) @@ -97,13 +95,13 @@ DO (IF (ILESSP C 128) THEN (\BOUT STREAM C) ELSEIF (ILESSP C 2048) - THEN (* ; "x800") + THEN (* ; "x800") (\BOUT STREAM (LOGOR (LLSH 3 6) (LRSH C 6))) (\BOUT STREAM (LOGOR (LLSH 2 6) (LOADBYTE C 0 6))) ELSEIF (ILESSP C 65536) - THEN (* ; "x10000") + THEN (* ; "x10000") (\BOUT STREAM (LOGOR (LLSH 7 5) (LRSH C 12))) (\BOUT STREAM (LOGOR (LLSH 2 6) @@ -111,7 +109,7 @@ (\BOUT STREAM (LOGOR (LLSH 2 6) (LOADBYTE C 0 6))) ELSEIF (ILESSP C 2097152) - THEN (* ; "x200000") + THEN (* ; "x200000") (\BOUT STREAM (LOGOR (LLSH 15 4) (LRSH C 18))) (\BOUT STREAM (LOGOR (LLSH 2 6) @@ -123,29 +121,29 @@ ELSE (ERROR "CHARCODE too big for UTF8" C]) (UTF8.INCCODEFN - [LAMBDA (STREAM COUNTP RAW) (* ; "Edited 6-Aug-2021 16:02 by rmk:") - (* ; "Edited 6-Aug-2020 17:13 by rmk:") + [LAMBDA (STREAM COUNTP RAW) (* ; "Edited 6-Aug-2021 16:02 by rmk:") + (* ; "Edited 6-Aug-2020 17:13 by rmk:") - (* ;; "Do not do UNICODE to XCSS translation if RAW.") + (* ;; "Do not do UNICODE to XCSS translation if RAW.") - (* ;; "Test for smallp because the stream's End-of-file operation may suppress the error") + (* ;; "Test for smallp because the stream's End-of-file operation may suppress the error") (DECLARE (USEDFREE *BYTECOUNTER*)) (LET (BYTE1 BYTE2 BYTE3 BYTE4 CODE (COUNT 1)) (SETQ BYTE1 (\BIN STREAM)) - (* ;; "Distinguish on header bytes (modulo peculiar EOF behavior--the caller will get whatever ended up in BYTE1") + (* ;; "Distinguish on header bytes (modulo peculiar EOF behavior--the caller will get whatever ended up in BYTE1") (CL:WHEN (SMALLP BYTE1) [SETQ CODE (IF (ILESSP BYTE1 128) THEN - (* ;; - "Test first: Ascii is the common case. EOL requires its own translation") + (* ;; + "Test first: Ascii is the common case. EOL requires its own translation") (SELCHARQ BYTE1 (CR (SELECTC (FETCH (STREAM EOLCONVENTION) OF STREAM) - (CR.EOLC (* ; "Also eq BYTE1") + (CR.EOLC (* ; "Also eq BYTE1") (CHARCODE EOL)) (CRLF.EOLC (IF (EQ (CHARCODE LF) (\PEEKBIN STREAM T)) @@ -160,7 +158,7 @@ BYTE1)) BYTE1) ELSEIF (IGEQ BYTE1 (LLSH 15 4)) - THEN (* ; "4 bytes") + THEN (* ; "4 bytes") (SETQ BYTE2 (\BIN STREAM)) (CL:WHEN (OR (NOT (SMALLP BYTE2)) (ILESSP BYTE2 128)) @@ -182,7 +180,7 @@ 6) (LOADBYTE BYTE4 0 6)) ELSEIF (IGEQ BYTE1 (LLSH 7 5)) - THEN (* ; "3 bytes") + THEN (* ; "3 bytes") (SETQ BYTE2 (\BIN STREAM)) (CL:WHEN (OR (NOT (SMALLP BYTE2)) (ILESSP BYTE2 128)) @@ -197,7 +195,7 @@ (LLSH (LOADBYTE BYTE2 0 6) 6) (LOADBYTE BYTE3 0 6)) - ELSE (* ; "Must be 2 bytes") + ELSE (* ; "Must be 2 bytes") (SETQ COUNT 2) (SETQ BYTE2 (\BIN STREAM)) (CL:WHEN (OR (NOT (SMALLP BYTE2)) @@ -211,12 +209,97 @@ (CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT)) CODE]) -(UTF8.PEEKCCODEFN [LAMBDA (STREAM NOERROR RAW) (* ; "Edited 14-Jun-2021 22:53 by rmk:") (* ;; "Modeled this after \EUCPEEK on LLREAD. In the multi-byte (non-ASCII) case, backs the file pointer to the beginning by the proper number of \BACKFILEPTRs, and returns a count of 0. Returns NIL if NOERROR and either invalid UTF8 or end of file.") (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.") (* ;; "Do not do UNICODE to XCCS translation if RAW") (PROG (BYTE1 BYTE2 BYTE3 BYTE4 CODE) (SETQ BYTE1 (\PEEKBIN STREAM NOERROR)) (* ;; "Distinguish on header bytex") (CL:UNLESS BYTE1 (RETURN NIL)) [IF (ILESSP BYTE1 128) THEN (* ;;  "Test first: Ascii is the common case. No need to back up, since we peeked.") (SETQ CODE BYTE1) ELSEIF (IGEQ BYTE1 (LLSH 15 4)) THEN (* ; "4 bytes") (\BIN STREAM) (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) (IGEQ BYTE2 128)) (\BACKFILEPTR STREAM) (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (RETURN CODE)) (\BIN STREAM) (CL:UNLESS (AND (SETQ BYTE3 (\PEEKBIN STREAM NOERROR)) (IGEQ BYTE3 128)) (\BACKFILEPTR STREAM) (\BACKFILEPTR STREAM) (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (RETURN CODE)) (\BIN STREAM) (SETQ BYTE4 (\PEEKBIN STREAM NOERROR)) (* ;  "PEEK the last, no need to back it up") (\BACKFILEPTR STREAM) (\BACKFILEPTR STREAM) (\BACKFILEPTR STREAM) (IF (AND BYTE4 (IGEQ BYTE4 128)) THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 3) 18) (LLSH (LOADBYTE BYTE2 0 6) 12) (LLSH (LOADBYTE BYTE3 0 6) 6) (LOADBYTE BYTE4 0 6))) ELSEIF NOERROR ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) ELSEIF (IGEQ BYTE1 (LLSH 7 5)) THEN (* ; "3 bytes") (\BIN STREAM) (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) (IGEQ BYTE2 128)) (\BACKFILEPTR STREAM) (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (RETURN CODE)) (\BIN STREAM) (SETQ BYTE3 (\PEEKBIN STREAM NOERROR)) (\BACKFILEPTR STREAM) (\BACKFILEPTR STREAM) (IF (AND BYTE3 (IGEQ BYTE3 128)) THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 4) 12) (LLSH (LOADBYTE BYTE2 0 6) 6) (LOADBYTE BYTE3 0 6))) ELSEIF NOERROR ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) ELSE (* ; "Must be 2 bytes") (\BIN STREAM) (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) (\BACKFILEPTR STREAM) (IF (AND BYTE2 (IGEQ BYTE2 128)) THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 5) 6) (LOADBYTE BYTE2 0 6))) ELSEIF NOERROR ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2] (CL:WHEN (AND CODE (NOT RAW)) (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))) (RETURN CODE]) +(UTF8.PEEKCCODEFN + [LAMBDA (STREAM NOERROR RAW) (* ; "Edited 14-Jun-2021 22:53 by rmk:") + + (* ;; "Modeled this after \EUCPEEK on LLREAD. In the multi-byte (non-ASCII) case, backs the file pointer to the beginning by the proper number of \BACKFILEPTRs, and returns a count of 0. Returns NIL if NOERROR and either invalid UTF8 or end of file.") + + (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.") + + (* ;; "Do not do UNICODE to XCCS translation if RAW") + + (PROG (BYTE1 BYTE2 BYTE3 BYTE4 CODE) + (SETQ BYTE1 (\PEEKBIN STREAM NOERROR)) + + (* ;; "Distinguish on header bytex") + + (CL:UNLESS BYTE1 (RETURN NIL)) + [IF (ILESSP BYTE1 128) + THEN + + (* ;; + "Test first: Ascii is the common case. No need to back up, since we peeked.") + + (SETQ CODE BYTE1) + ELSEIF (IGEQ BYTE1 (LLSH 15 4)) + THEN (* ; "4 bytes") + (\BIN STREAM) + (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) + (IGEQ BYTE2 128)) + (\BACKFILEPTR STREAM) + (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) + (RETURN CODE)) + (\BIN STREAM) + (CL:UNLESS (AND (SETQ BYTE3 (\PEEKBIN STREAM NOERROR)) + (IGEQ BYTE3 128)) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) + (RETURN CODE)) + (\BIN STREAM) + (SETQ BYTE4 (\PEEKBIN STREAM NOERROR)) (* ; + "PEEK the last, no need to back it up") + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (IF (AND BYTE4 (IGEQ BYTE4 128)) + THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 3) + 18) + (LLSH (LOADBYTE BYTE2 0 6) + 12) + (LLSH (LOADBYTE BYTE3 0 6) + 6) + (LOADBYTE BYTE4 0 6))) + ELSEIF NOERROR + ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) + ELSEIF (IGEQ BYTE1 (LLSH 7 5)) + THEN (* ; "3 bytes") + (\BIN STREAM) + (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) + (IGEQ BYTE2 128)) + (\BACKFILEPTR STREAM) + (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) + (RETURN CODE)) + (\BIN STREAM) + (SETQ BYTE3 (\PEEKBIN STREAM NOERROR)) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (IF (AND BYTE3 (IGEQ BYTE3 128)) + THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 4) + 12) + (LLSH (LOADBYTE BYTE2 0 6) + 6) + (LOADBYTE BYTE3 0 6))) + ELSEIF NOERROR + ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) + ELSE (* ; "Must be 2 bytes") + (\BIN STREAM) + (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) + (\BACKFILEPTR STREAM) + (IF (AND BYTE2 (IGEQ BYTE2 128)) + THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 5) + 6) + (LOADBYTE BYTE2 0 6))) + ELSEIF NOERROR + ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2] + (CL:WHEN (AND CODE (NOT RAW)) + (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))) + (RETURN CODE]) (\UTF8.BACKCCODEFN - [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:04 by rmk:") + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:04 by rmk:") - (* ;; "\BACKFILEPTR is NIL at beginning of FILE, just return COUNT") + (* ;; "\BACKFILEPTR is NIL at beginning of FILE, just return COUNT") (DECLARE (USEDFREE *BYTECOUNTER*)) (BIND (C _ 0) WHILE (CL:WHEN (\BACKFILEPTR STREAM) @@ -228,12 +311,12 @@ (DEFINEQ (UTF16BE.OUTCHARFN - [LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 8-Aug-2021 13:09 by rmk:") - (* ; "Edited 30-Jan-2020 23:08 by rmk:") + [LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 8-Aug-2021 13:09 by rmk:") + (* ; "Edited 30-Jan-2020 23:08 by rmk:") - (* ;; "PRINT UTF16 sequence for CHARCODE. Do not do XCCS to UNICODE translation if RAW.") + (* ;; "PRINT UTF16 sequence for CHARCODE. Do not do XCCS to UNICODE translation if RAW.") - (* ;; "Not sure about EOL conversion if truly %"raw%"") + (* ;; "Not sure about EOL conversion if truly %"raw%"") (IF (EQ CHARCODE (CHARCODE EOL)) THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) @@ -245,10 +328,10 @@ DO (\WOUT STREAM C]) (UTF16BE.INCCODEFN - [LAMBDA (STREAM COUNTP RAW) (* ; "Edited 6-Aug-2021 16:05 by rmk:") + [LAMBDA (STREAM COUNTP RAW) (* ; "Edited 6-Aug-2021 16:05 by rmk:") - (* ;; - "Do not do UNICODE to XCCS translation if RAW. Test for SMALLPin case of funky EOF behavior") + (* ;; + "Do not do UNICODE to XCCS translation if RAW. Test for SMALLPin case of funky EOF behavior") (DECLARE (USEDFREE *BYTECOUNTER*)) (LET (CODE BYTE1 BYTE2 COUNT) @@ -264,14 +347,37 @@ CODE ELSE (ERROR "ODD NUMBER OF BYTES IN UTF16 FILE" STREAM]) -(UTF16BE.PEEKCCODEFN [LAMBDA (STREAM NOERROR RAW) (* ; "Edited 14-Jun-2021 22:58 by rmk:") (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.") (* ;; "Do not do UNICODE to XCCS translation if RAW") (LET (BYTE1 BYTE2 CODE) (SETQ BYTE1 (\PEEKBIN STREAM NOERROR)) (IF BYTE1 THEN (\BIN STREAM) (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) (\BACKFILEPTR STREAM) (IF BYTE2 THEN (SETQ CODE (LOGOR (LLSH BYTE1 8) BYTE2)) (CL:IF RAW CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)) ELSEIF NOERROR THEN NIL) ELSEIF NOERROR THEN NIL ELSE (ERROR "INVALID UTF16 CHARACTER" (LIST BYTE1 BYTE2]) +(UTF16BE.PEEKCCODEFN + [LAMBDA (STREAM NOERROR RAW) (* ; "Edited 14-Jun-2021 22:58 by rmk:") + + (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.") + + (* ;; "Do not do UNICODE to XCCS translation if RAW") + + (LET (BYTE1 BYTE2 CODE) + (SETQ BYTE1 (\PEEKBIN STREAM NOERROR)) + (IF BYTE1 + THEN (\BIN STREAM) + (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) + (\BACKFILEPTR STREAM) + (IF BYTE2 + THEN (SETQ CODE (LOGOR (LLSH BYTE1 8) + BYTE2)) + (CL:IF RAW + CODE + (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)) + ELSEIF NOERROR + THEN NIL) + ELSEIF NOERROR + THEN NIL + ELSE (ERROR "INVALID UTF16 CHARACTER" (LIST BYTE1 BYTE2]) (\UTF16.BACKCCODEFN - [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:07 by rmk:") + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:07 by rmk:") - (* ;; "\BACKFILEPTR is NIL at beginning of FILE, do nothing.") + (* ;; "\BACKFILEPTR is NIL at beginning of FILE, do nothing.") - (* ;; "Common for big-ending and little-ending") + (* ;; "Common for big-ending and little-ending") (DECLARE (USEDFREE *BYTECOUNTER*)) (CL:WHEN (\BACKFILEPTR STREAM) @@ -285,11 +391,11 @@ (DEFINEQ (MAKE-UNICODE-FORMATS - [LAMBDA (EXTERNALEOL) (* ; "Edited 6-Aug-2021 16:08 by rmk:") + [LAMBDA (EXTERNALEOL) (* ; "Edited 6-Aug-2021 16:08 by rmk:") - (* ;; "RAW formats do not do XCCS/Unicode translation, just deal with the byte encoding.") + (* ;; "RAW formats do not do XCCS/Unicode translation, just deal with the byte encoding.") - (* ;; "The EXTERNALEOL specifies the EOLCONVENTION of the stream, particularly to produce output files with the desired convention. On input the macro \CHECKEOLC (LLREAD) coerces only that coding to the internal EOL, which is a mistake.") + (* ;; "The EXTERNALEOL specifies the EOLCONVENTION of the stream, particularly to produce output files with the desired convention. On input the macro \CHECKEOLC (LLREAD) coerces only that coding to the internal EOL, which is a mistake.") (MAKE-EXTERNALFORMAT :UTF-8 (FUNCTION UTF8.INCCODEFN) (FUNCTION UTF8.PEEKCCODEFN) @@ -325,11 +431,11 @@ (DEFINEQ (UNICODE.UNMAPPED - [LAMBDA (CODE TRANSLATION-TABLE) (* ; "Edited 11-Aug-2020 20:23 by rmk:") + [LAMBDA (CODE TRANSLATION-TABLE) (* ; "Edited 11-Aug-2020 20:23 by rmk:") - (* ;; "This is the slow fall-out when UNICODE.TRANSLATE determines that CODED has no fast mapping in TRANSLATION-TABLE.") + (* ;; "This is the slow fall-out when UNICODE.TRANSLATE determines that CODED has no fast mapping in TRANSLATION-TABLE.") - (* ;; "We return an existing entry in the hash array of the table. If CODE has not previously been seen, we allocate a new code in the forward unmapped hasharray and put the inverse in the backward array.") + (* ;; "We return an existing entry in the hash array of the table. If CODE has not previously been seen, we allocate a new code in the forward unmapped hasharray and put the inverse in the backward array.") (LET ((FORWARD (CL:SVREF TRANSLATION-TABLE N-TRANSLATION-SEGMENTS)) INVERSE NEXTCODE) @@ -349,9 +455,9 @@ (DEFINEQ (XCCS-UTF8-AFTER-OPEN - [LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 13-Aug-2020 11:54 by rmk:") + [LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 13-Aug-2020 11:54 by rmk:") - (* ;; "If added to STREAM-AFTER-OPEN-FNS, causes mapping files to be opened as UTF8.") + (* ;; "If added to STREAM-AFTER-OPEN-FNS, causes mapping files to be opened as UTF8.") (CL:WHEN (AND (STRPOS "XCCS-" (U-CASE (FULLNAME STREAM))) [EQ 'TXT (U-CASE (FILENAMEFIELD (FULLNAME STREAM) @@ -379,11 +485,11 @@ (DEFINEQ (XTOUCODE - [LAMBDA (XCCSCODE) (* ; "Edited 9-Aug-2020 09:04 by rmk:") + [LAMBDA (XCCSCODE) (* ; "Edited 9-Aug-2020 09:04 by rmk:") (UNICODE.TRANSLATE XCCSCODE *XCCSTOUNICODE*]) (UTOXCODE - [LAMBDA (UNICODE) (* ; "Edited 9-Aug-2020 09:04 by rmk:") + [LAMBDA (UNICODE) (* ; "Edited 9-Aug-2020 09:04 by rmk:") (UNICODE.TRANSLATE UNICODE *UNICODETOXCCS*]) ) @@ -394,9 +500,8 @@ (DEFINEQ (READ-UNICODE-MAPPING-FILENAMES - [LAMBDA (FILESPEC) (* ; "Edited 5-Aug-2020 15:59 by kaplan") - (* ; - "Edited 4-Aug-2020 17:31 by rmk:") + [LAMBDA (FILESPEC) (* ; "Edited 5-Aug-2020 15:59 by kaplan") + (* ; "Edited 4-Aug-2020 17:31 by rmk:") (FOR F X CSI INSIDE FILESPEC COLLECT (IF (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT) T UNICODEDIRECTORIES) @@ -412,24 +517,24 @@ ELSE F]) (READ-UNICODE-MAPPING - [LAMBDA (FILESPEC NOPRINT NOERROR) (* ; "Edited 3-Jul-2021 13:37 by rmk:") + [LAMBDA (FILESPEC NOPRINT NOERROR) (* ; "Edited 3-Jul-2021 13:37 by rmk:") - (* ;; "Combines the char-mapping tables from FILES coded in the Uncode-CDROM format. Comments prefixed by # and") + (* ;; "Combines the char-mapping tables from FILES coded in the Uncode-CDROM format. Comments prefixed by # and") - (* ;; " Column 1: Input hex code in the format 0xXXXX") + (* ;; " Column 1: Input hex code in the format 0xXXXX") - (* ;; " Column 2: Corresponding Unicode code-sequence in the format") + (* ;; " Column 2: Corresponding Unicode code-sequence in the format") - (* ;; " 0xXXXX ... 0xYYYY") + (* ;; " 0xXXXX ... 0xYYYY") - (* ;; - " Column 3: (after #) Character name in some mapping files, utf-8 character") + (* ;; + " Column 3: (after #) Character name in some mapping files, utf-8 character") - (* ;; " for XCCS mapping files") + (* ;; " for XCCS mapping files") - (* ;; "") + (* ;; "") - (* ;; "Result is a list of (fromcode tocode1 ... tocoden) integer lists (almost always with only a single tocode") + (* ;; "Result is a list of (fromcode tocode1 ... tocoden) integer lists (almost always with only a single tocode") (FOR FILE [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE] IN (  READ-UNICODE-MAPPING-FILENAMES @@ -461,18 +566,18 @@ (NTHCHARCODE LINE START]) (WRITE-UNICODE-MAPPING - [LAMBDA (MAPPING INCLUDECHARSETS FILE EMPTYOK) (* ; "Edited 16-Aug-2020 16:56 by rmk:") + [LAMBDA (MAPPING INCLUDECHARSETS FILE EMPTYOK) (* ; "Edited 16-Aug-2020 16:56 by rmk:") - (* ;; "Writes a symbol unicode mapping file. Mapping is a list of (XCCS-code Unicode) pairs, which may contain codes in multiple character sets.") + (* ;; "Writes a symbol unicode mapping file. Mapping is a list of (XCCS-code Unicode) pairs, which may contain codes in multiple character sets.") - (* ;; "If FILE is NIL, it defaults to a name XCCS- followed by the octal character sets in the mapping, in the unicode/XEROX directory.") + (* ;; "If FILE is NIL, it defaults to a name XCCS- followed by the octal character sets in the mapping, in the unicode/XEROX directory.") - (* ;; "The output lines are of the form x0XXXx0UUUU# Unicode-char") + (* ;; "The output lines are of the form x0XXXx0UUUU# Unicode-char") - (* ;; - "If INCLUDECHARSETS=T then the mappings are split up into separate per-character set files.") + (* ;; + "If INCLUDECHARSETS=T then the mappings are split up into separate per-character set files.") - (* ;; "Otherwise, all and only mappings included in thos charsets are included in a single output file--an implicit subset.") + (* ;; "Otherwise, all and only mappings included in thos charsets are included in a single output file--an implicit subset.") (IF (AND (EQ INCLUDECHARSETS T) (NULL FILE)) @@ -513,15 +618,15 @@ " # " (SELECTC FIRSTRIGHTC (UNDEFINEDCODE - (* ;; "FFFF") + (* ;; "FFFF") "UNDEFINED") (MISSINGCODE - (* ;; "FFFE") + (* ;; "FFFE") "MISSING") (IF (ILESSP FIRSTRIGHTC 32) - THEN (* ; "Control chars") + THEN (* ; "Control chars") [CONCAT "^" (CHARACTER (IPLUS FIRSTRIGHTC (CHARCODE @] ELSE (CHARACTER FIRSTRIGHTC))) @@ -535,13 +640,13 @@ NIL]) (WRITE-UNICODE-INCLUDED - [LAMBDA (MAPPING INCLUDECHARSETS) (* ; "Edited 4-Aug-2020 17:47 by rmk:") + [LAMBDA (MAPPING INCLUDECHARSETS) (* ; "Edited 4-Aug-2020 17:47 by rmk:") - (* ;; "CSETINFO is a list of (num string name) for each included character set.") + (* ;; "CSETINFO is a list of (num string name) for each included character set.") (LET (CHARSETS CSETINFO RANGES ICSETS IMAPPING) - (* ;; "Normalize the INCLUDECHARSETS, then reduce MAPPING to the included mappings") + (* ;; "Normalize the INCLUDECHARSETS, then reduce MAPPING to the included mappings") [SETQ ICSETS (FOR C POS KNOWN INSIDE (OR INCLUDECHARSETS (FOR CSI IN XCCS-SET-NAMES @@ -569,13 +674,13 @@ ICSETS)) COLLECT - (* ;; "The attested subset of INCLUDED") + (* ;; "The attested subset of INCLUDED") (CL:UNLESS (MEMB CSI CSETINFO) (PUSH CSETINFO CSI)) M)) - (* ;; "Sort as numbers, not octal strings, then group into consecutive ranges") + (* ;; "Sort as numbers, not octal strings, then group into consecutive ranges") (SETQ CSETINFO (SORT CSETINFO T)) [SETQ RANGES (FOR CTAIL C START END ON (FOR CSI IN CSETINFO @@ -587,7 +692,7 @@ COLLECT (SETQ CTAIL (CDR CTAIL)) (SETQ END (CAR CTAIL] - (* ;; "Split out groups of less than 3. But if a range exhaustively covers a known subset (like JIS), replace by the name") + (* ;; "Split out groups of less than 3. But if a range exhaustively covers a known subset (like JIS), replace by the name") [SETQ RANGES (FOR R STR KNOWN LAST IN RANGES JOIN (SETQ LAST (CAR (LAST R))) @@ -607,9 +712,9 @@ (CL:VALUES IMAPPING CSETINFO RANGES]) (WRITE-UNICODE-MAPPING-HEADER - [LAMBDA (STREAM CSETINFO RANGES) (* ; "Edited 4-Aug-2020 17:38 by rmk:") + [LAMBDA (STREAM CSETINFO RANGES) (* ; "Edited 4-Aug-2020 17:38 by rmk:") - (* ;; "Writes the standard per-file header information") + (* ;; "Writes the standard per-file header information") (FOR LINE IN UNICODE-MAPPING-HEADER DO (PRINTOUT STREAM "#" 2) @@ -620,7 +725,7 @@ THEN (PRINTOUT STREAM "s:" -4) (FOR R IN RANGES DO (PRINTOUT STREAM R " ")) (TERPRI STREAM) - ELSE (* ; "Singleton") + ELSE (* ; "Singleton") (PRINTOUT STREAM ": " -4 (CADAR CSETINFO) " " (CADDAR CSETINFO))) @@ -632,7 +737,7 @@ (TERPRI STREAM]) (WRITE-UNICODE-MAPPING-FILENAME - [LAMBDA (FILE CSETINFO RANGES) (* ; "Edited 4-Aug-2020 19:34 by rmk:") + [LAMBDA (FILE CSETINFO RANGES) (* ; "Edited 4-Aug-2020 19:34 by rmk:") (PACKFILENAME 'BODY [OR FILE (CONCATLIST (CONS 'XCCS- (IF (CDR CSETINFO) THEN (FOR RTAIL R ON RANGES @@ -736,53 +841,53 @@ (DEFINEQ (MAKE-UNICODE-TRANSLATION-TABLES - [LAMBDA (MAPPING LTORVAR RTOLVAR) (* ; "Edited 21-Aug-2021 13:12 by rmk:") - (* ; "Edited 17-Aug-2020 08:46 by rmk:") + [LAMBDA (MAPPING LTORVAR RTOLVAR) (* ; "Edited 21-Aug-2021 13:12 by rmk:") + (* ; "Edited 17-Aug-2020 08:46 by rmk:") - (* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to a Unicode mapping file.") + (* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to a Unicode mapping file.") - (* ;; "This produces two recoding arrays, one maps left-side codes into right-side codes (e.g. XCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. XCCS).") + (* ;; "This produces two recoding arrays, one maps left-side codes into right-side codes (e.g. XCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. XCCS).") - (* ;; "") + (* ;; "") - (* ;; "We assume that the left-to-right mapping into Unicode is functional, so that each left code maps to a unique right (Unicode) code, because Unicode is presumably the most refined coding scheme. But several Unicode codes may map to the same left code, for logically different codes that happen to have the same glyphs. In that case the heuristic is to map each %"from%" code to the lowest of the possible %"to%" codes. This means that round-trip reading/writing or writing/reading from one or both starting points may not always be lossless.") + (* ;; "We assume that the left-to-right mapping into Unicode is functional, so that each left code maps to a unique right (Unicode) code, because Unicode is presumably the most refined coding scheme. But several Unicode codes may map to the same left code, for logically different codes that happen to have the same glyphs. In that case the heuristic is to map each %"from%" code to the lowest of the possible %"to%" codes. This means that round-trip reading/writing or writing/reading from one or both starting points may not always be lossless.") - (* ;; " ") + (* ;; " ") - (* ;; " Each recoding array has 256 elements, one for each possible high-order byte of a character code. An array entry is either NIL, a 256-array of codes indexed by low-order bytes, or an alist of (lower-order-bytes . codes). The latter is used to save space for sparsely populated character sets.") + (* ;; " Each recoding array has 256 elements, one for each possible high-order byte of a character code. An array entry is either NIL, a 256-array of codes indexed by low-order bytes, or an alist of (lower-order-bytes . codes). The latter is used to save space for sparsely populated character sets.") - (* ;; "") + (* ;; "") - (* ;; "The element 256 of each array contains a hash table for characters that might be encountered in XCCS memory or Unicode files for which there is no mapping. Element 257 contains the corresponding inverse unmapped hash-array, so that UNICODE.TRANSLATE can update them consistently.") + (* ;; "The element 256 of each array contains a hash table for characters that might be encountered in XCCS memory or Unicode files for which there is no mapping. Element 257 contains the corresponding inverse unmapped hash-array, so that UNICODE.TRANSLATE can update them consistently.") - (* ;; "") + (* ;; "") - (* ;; "UNICODE.TRANSLATE assigns an unmapped Unicode character to a %"not used%" XCCS code position (from 5,0 to 40,FF, leaving other low not-used sets for other internal uses (TEDIT?).") + (* ;; "UNICODE.TRANSLATE assigns an unmapped Unicode character to a %"not used%" XCCS code position (from 5,0 to 40,FF, leaving other low not-used sets for other internal uses (TEDIT?).") - (* ;; "") + (* ;; "") - (* ;; - "An unmapped XCCS character is assigned a code in the %"private use%" code blocks 0xE000-F8FF") + (* ;; + "An unmapped XCCS character is assigned a code in the %"private use%" code blocks 0xE000-F8FF") - (* ;; "") + (* ;; "") - (* ;; "For the convenience of not having to deal with the multiple values, if LTORVAR or RTOLVAR are given, they are set to the constructed arrays before return.") + (* ;; "For the convenience of not having to deal with the multiple values, if LTORVAR or RTOLVAR are given, they are set to the constructed arrays before return.") - (* ;; "") + (* ;; "") (LET ((LTORARRAY (CL:MAKE-ARRAY (IPLUS 2 N-TRANSLATION-SEGMENTS) :INITIAL-ELEMENT NIL)) (RTOLARRAY (CL:MAKE-ARRAY (IPLUS 2 N-TRANSLATION-SEGMENTS) :INITIAL-ELEMENT NIL))) - (* ;; "The left-to-right direction (into Unicode). We start by distributing the mappings into alists in arrays indexed by the higher-order (charaset set byte). The second loop converts long alists into arrays.") + (* ;; "The left-to-right direction (into Unicode). We start by distributing the mappings into alists in arrays indexed by the higher-order (charaset set byte). The second loop converts long alists into arrays.") [FOR M LEFTC RBASE RCODES IN MAPPING EACHTIME (SETQ RCODES (CDR M)) (SETQ RBASE (CAR RCODES)) UNLESS (IGEQ RBASE MISSINGCODE) DO (SETQ LEFTC (CAR M)) - (* ;; - "(CDR RCODES) contains combiners on the base") + (* ;; + "(CDR RCODES) contains combiners on the base") (CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK) (CL:IF (CDR RCODES) @@ -796,7 +901,7 @@ MAX-ALIST-LENGTH) DO - (* ;; "Leave it alone if the alist is short") + (* ;; "Leave it alone if the alist is short") (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE :INITIAL-ELEMENT NIL)) (FOR P IN (CL:SVREF LTORARRAY I) @@ -806,17 +911,17 @@ (CL:SETF (CL:SVREF LTORARRAY I) CSA)) - (* ;; "") + (* ;; "") - (* ;; "Now the right-to-left direction (from Unicode). Here we have to detect and compensate for ambiguity.") + (* ;; "Now the right-to-left direction (from Unicode). Here we have to detect and compensate for ambiguity.") (FOR M LEFTC RBASE RCOMBINERS PREV IN MAPPING EACHTIME (SETQ RBASE (CADR M)) (SETQ RCOMBINERS (CDDR M)) UNLESS (OR (IGEQ RBASE MISSINGCODE) RCOMBINERS) DO - (* ;; - "Have we already seen an explicit mapping from right to left?") + (* ;; + "Have we already seen an explicit mapping from right to left?") (SETQ LEFTC (CAR M)) [SETQ PREV (ASSOC (LOGAND RBASE TRANSLATION-MASK) @@ -838,7 +943,7 @@ MAX-ALIST-LENGTH) DO - (* ;; "Long list, make an array") + (* ;; "Long list, make an array") (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE :INITIAL-ELEMENT NIL)) (FOR P IN (CL:SVREF RTOLARRAY I) @@ -848,9 +953,9 @@ (CL:SETF (CL:SVREF RTOLARRAY I) CSA)) - (* ;; "") + (* ;; "") - (* ;; "Allocate the hash arrays for future out-of-map codes. We we have to keep track of the next available and last possible codes, as well as the first available, for error checking.") + (* ;; "Allocate the hash arrays for future out-of-map codes. We we have to keep track of the next available and last possible codes, as well as the first available, for error checking.") (CL:SETF (CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS) (LIST (HASHARRAY 10) @@ -863,14 +968,14 @@ (CHARCODE.DECODE "U+F8FF") (CHARCODE.DECODE "U+E000"))) - (* ;; "Now put in the inverse unmapped hash arrays") + (* ;; "Now put in the inverse unmapped hash arrays") (CL:SETF (CL:SVREF LTORARRAY (ADD1 N-TRANSLATION-SEGMENTS)) (CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS)) (CL:SETF (CL:SVREF RTOLARRAY (ADD1 N-TRANSLATION-SEGMENTS)) (CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS)) - (* ;; "") + (* ;; "") (CL:WHEN LTORVAR (SETATOMVAL LTORVAR LTORARRAY)) (CL:WHEN RTOLVAR (SETATOMVAL RTOLVAR RTOLARRAY)) @@ -892,11 +997,11 @@ (DEFINEQ (HEXSTRING - [LAMBDA (N WIDTH) (* ; "Edited 23-Jul-2020 08:28 by rmk:") - (* ; "Edited 20-Dec-93 17:51 by rmk:") + [LAMBDA (N WIDTH) (* ; "Edited 23-Jul-2020 08:28 by rmk:") + (* ; "Edited 20-Dec-93 17:51 by rmk:") - (* ;; - "Converts positive numbers to Hex strings, padding on the right with 0 up to WIDTH if given.") + (* ;; + "Converts positive numbers to Hex strings, padding on the right with 0 up to WIDTH if given.") (CL:UNLESS (FIXP N) (SETQ N (CHARCODE.DECODE N))) @@ -915,21 +1020,21 @@ STR]) (UTF8HEXSTRING - [LAMBDA (CHARCODE) (* ; "Edited 10-Aug-2020 08:33 by rmk:") + [LAMBDA (CHARCODE) (* ; "Edited 10-Aug-2020 08:33 by rmk:") - (* ;; "Utility to produces the UTF8 hexstring representing CODE") + (* ;; "Utility to produces the UTF8 hexstring representing CODE") (HEXSTRING (IF (ILESSP CHARCODE 128) THEN CHARCODE ELSEIF (ILESSP CHARCODE 2048) - THEN (* ; "x800") + THEN (* ; "x800") (LOGOR (LLSH (LOGOR (LLSH 3 6) (LRSH CHARCODE 6)) 8) (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 65536) - THEN (* ; "x10000") + THEN (* ; "x10000") (LOGOR (LLSH (LOGOR (LLSH 7 5) (LRSH CHARCODE 12)) 16) @@ -939,7 +1044,7 @@ (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 2097152) - THEN (* ; "x200000") + THEN (* ; "x200000") (LOGOR (LLSH (LOGOR (LLSH 15 4) (LRSH CHARCODE 18)) 24) @@ -954,27 +1059,27 @@ ELSE (ERROR "CHARCODE too big for UTF8" CHARCODE]) (NUTF8CODEBYTES - [LAMBDA (N) (* ; "Edited 10-Aug-2020 12:35 by rmk:") + [LAMBDA (N) (* ; "Edited 10-Aug-2020 12:35 by rmk:") - (* ;; "Returns the number of bytes needed to encode N in UTF8, ") + (* ;; "Returns the number of bytes needed to encode N in UTF8, ") (IF (ILESSP N 128) THEN 1 ELSEIF (ILESSP N 2048) - THEN (* ; "x800") + THEN (* ; "x800") 4 ELSEIF (ILESSP N 65536) - THEN (* ; "x10000") + THEN (* ; "x10000") 3 ELSEIF (ILESSP N 2097152) - THEN (* ; "x200000") + THEN (* ; "x200000") 2 ELSE (SHOULDNT]) (NUTF8STRINGBYTES - [LAMBDA (STRING RAWFLG) (* ; "Edited 10-Aug-2020 09:06 by rmk:") + [LAMBDA (STRING RAWFLG) (* ; "Edited 10-Aug-2020 09:06 by rmk:") - (* ;; "Returns the number of bytes it would take to represent STRING in UTF8, assuming it is an XCCS string unless RAWFLG. ") + (* ;; "Returns the number of bytes it would take to represent STRING in UTF8, assuming it is an XCCS string unless RAWFLG. ") (FOR I C FROM 1 WHILE (SETQ C (NTHCHARCODE STRING I)) SUM (NUTF8CODEBYTES (CL:IF RAWFLG @@ -982,11 +1087,11 @@ (XTOUCODE C))]) (XTOUSTRING - [LAMBDA (XCCSSTRING RAWFLG) (* ; "Edited 10-Aug-2020 21:42 by rmk:") + [LAMBDA (XCCSSTRING RAWFLG) (* ; "Edited 10-Aug-2020 21:42 by rmk:") - (* ;; "Produces a string that contains the UTF8 bytes that represent the characters in XCCSSTRING. Applies the XCCSTOUNICODE translation unless RAWFLG. ") + (* ;; "Produces a string that contains the UTF8 bytes that represent the characters in XCCSSTRING. Applies the XCCSTOUNICODE translation unless RAWFLG. ") - (* ;; "The resulting string will not be readable inside Medley.") + (* ;; "The resulting string will not be readable inside Medley.") (LET [(USTR (ALLOCSTRING (NUTF8STRINGBYTES XCCSSTRING RAWFLG] (FOR I CHARCODE (SINDEX _ 0) FROM 1 WHILE (SETQ CHARCODE (NTHCHARCODE XCCSSTRING @@ -997,7 +1102,7 @@ THEN (RPLCHARCODE USTR (ADD SINDEX 1) CHARCODE) ELSEIF (ILESSP CHARCODE 2048) - THEN (* ; "x800") + THEN (* ; "x800") (RPLCHARCODE USTR (ADD SINDEX 1) (LOGOR (LLSH 3 6) (LRSH CHARCODE 6))) @@ -1005,7 +1110,7 @@ (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 65536) - THEN (* ; "x10000") + THEN (* ; "x10000") (RPLCHARCODE USTR (ADD SINDEX 1) (LOGOR (LLSH 7 5) (LRSH CHARCODE 12))) @@ -1016,7 +1121,7 @@ (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 2097152) - THEN (* ; "x200000") + THEN (* ; "x200000") (RPLCHARCODE USTR (ADD SINDEX 1) (LOGOR (LLSH 15 4) (LRSH CHARCODE 18))) @@ -1033,9 +1138,9 @@ USTR]) (XCCSSTRING - [LAMBDA (CODE) (* ; "Edited 13-Aug-2020 12:16 by rmk:") + [LAMBDA (CODE) (* ; "Edited 13-Aug-2020 12:16 by rmk:") - (* ;; "Returns XCCS character representation of string %"cset,char%"") + (* ;; "Returns XCCS character representation of string %"cset,char%"") (CL:UNLESS (FIXP CODE) (SETQ CODE (CHCON1 CODE))) @@ -1046,14 +1151,14 @@ (DEFINEQ (SHOWCHARS - [LAMBDA (FROMCHAR TOCHAR FONT) (* ; "Edited 1-Aug-2020 09:27 by rmk:") + [LAMBDA (FROMCHAR TOCHAR FONT) (* ; "Edited 1-Aug-2020 09:27 by rmk:") (RESETFORM (DSPFONT (OR FONT '(CLASSIC 12)) T) (CL:WHEN (AND (SMALLP FROMCHAR) (NOT TOCHAR)) - (* ;; - "If a small number, assume it's an octal (in decimal) character set, no need for string quotes") + (* ;; + "If a small number, assume it's an octal (in decimal) character set, no need for string quotes") (SETQ TOCHAR (CONCAT FROMCHAR "," 376)) (SETQ FROMCHAR (CONCAT FROMCHAR "," 41))) @@ -1100,15 +1205,15 @@ ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4105 17785 (UTF8.OUTCHARFN 4115 . 6946) (UTF8.INCCODEFN 6948 . 12438) (UTF8.PEEKCCODEFN - 12440 . 17214) (\UTF8.BACKCCODEFN 17216 . 17783)) (17786 21112 (UTF16BE.OUTCHARFN 17796 . 18620) ( -UTF16BE.INCCODEFN 18622 . 19521) (UTF16BE.PEEKCCODEFN 19523 . 20594) (\UTF16.BACKCCODEFN 20596 . 21110 -)) (21142 22950 (MAKE-UNICODE-FORMATS 21152 . 22948)) (23047 24353 (UNICODE.UNMAPPED 23057 . 24351)) ( -24354 24890 (XCCS-UTF8-AFTER-OPEN 24364 . 24888)) (25960 26309 (XTOUCODE 25970 . 26138) (UTOXCODE -26140 . 26307)) (26349 42532 (READ-UNICODE-MAPPING-FILENAMES 26359 . 27521) (READ-UNICODE-MAPPING -27523 . 30821) (WRITE-UNICODE-MAPPING 30823 . 35040) (WRITE-UNICODE-INCLUDED 35042 . 39764) ( -WRITE-UNICODE-MAPPING-HEADER 39766 . 40998) (WRITE-UNICODE-MAPPING-FILENAME 41000 . 42530)) (45869 -54348 (MAKE-UNICODE-TRANSLATION-TABLES 45879 . 54346)) (54769 62673 (HEXSTRING 54779 . 55940) ( -UTF8HEXSTRING 55942 . 58147) (NUTF8CODEBYTES 58149 . 58812) (NUTF8STRINGBYTES 58814 . 59295) ( -XTOUSTRING 59297 . 62308) (XCCSSTRING 62310 . 62671)) (62674 64143 (SHOWCHARS 62684 . 64141))))) + (FILEMAP (NIL (4046 17726 (UTF8.OUTCHARFN 4056 . 6887) (UTF8.INCCODEFN 6889 . 12379) (UTF8.PEEKCCODEFN + 12381 . 17155) (\UTF8.BACKCCODEFN 17157 . 17724)) (17727 21053 (UTF16BE.OUTCHARFN 17737 . 18561) ( +UTF16BE.INCCODEFN 18563 . 19462) (UTF16BE.PEEKCCODEFN 19464 . 20535) (\UTF16.BACKCCODEFN 20537 . 21051 +)) (21083 22891 (MAKE-UNICODE-FORMATS 21093 . 22889)) (22988 24294 (UNICODE.UNMAPPED 22998 . 24292)) ( +24295 24831 (XCCS-UTF8-AFTER-OPEN 24305 . 24829)) (25901 26250 (XTOUCODE 25911 . 26079) (UTOXCODE +26081 . 26248)) (26290 42412 (READ-UNICODE-MAPPING-FILENAMES 26300 . 27401) (READ-UNICODE-MAPPING +27403 . 30701) (WRITE-UNICODE-MAPPING 30703 . 34920) (WRITE-UNICODE-INCLUDED 34922 . 39644) ( +WRITE-UNICODE-MAPPING-HEADER 39646 . 40878) (WRITE-UNICODE-MAPPING-FILENAME 40880 . 42410)) (45749 +54228 (MAKE-UNICODE-TRANSLATION-TABLES 45759 . 54226)) (54649 62553 (HEXSTRING 54659 . 55820) ( +UTF8HEXSTRING 55822 . 58027) (NUTF8CODEBYTES 58029 . 58692) (NUTF8STRINGBYTES 58694 . 59175) ( +XTOUSTRING 59177 . 62188) (XCCSSTRING 62190 . 62551)) (62554 64023 (SHOWCHARS 62564 . 64021))))) STOP diff --git a/library/UNICODE.LCOM b/library/UNICODE.LCOM index 4f7ba73a53b26e7f54ec06fe870b041e5fb61315..1204a0dd15a7f20592320a82492d9ce4ef4b25b7 100644 GIT binary patch delta 243 zcmdnAmhtHt#tC5}#s<2=IP_=9OUX4;_9NHWNaXUuo>biLklH^$pTD{dL~>7W+vtq#tH>Rsb!h@ mrNv;Aflg2|GSqb}O^15L*vin@%D`kYFOv(S@#Y|=gb)C30zVJ{ delta 264 zcmaF5hH=wc#tC5}MuxhMrRlmx21bSohQ?MvWMDEeE5y)PQ$fkl5=qX;%D~*p$V5pY zsVFr$Ker$=CpCpjAvq&4FFmzb)kLPajw3AXmo_R~MinEN+_Y&*&^|%%xyvVrgIuvsR%bA850N wn_n=