Add charset functions in LLREAD, move IOCHAR a little bit earlier

sources/FILESETS

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "17-Jul-2025 12:07:14" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;15
 6295   
+
(FILECREATED "13-Aug-2025 16:22:29" {MEDLEY}<sources>FILESETS.;2
 6206   
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS EXPORTFILES 0LISPSET)
+      :CHANGES-TO (VARS 0LISPSET)
 
-      :PREVIOUS-DATE "17-Jul-2025 09:32:58" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;14)
+      :PREVIOUS-DATE "17-Jul-2025 12:07:14" {MEDLEY}<sources>FILESETS.;1)
 
 
 (PRETTYCOMPRINT FILESETSCOMS)
@@ -51,8 +50,8 @@
 
 (RPAQQ 0LISPSET
 (PACKAGE-CONVERSION-TABLE LLFAULT LLSUBRS LLBFS LLNEW FILEIO EXTERNALFORMAT IMAGEIO 
                        LLBASIC LLGC LLARRAYELT LLINTERP LLMVS DEFSTRUCT-RUN-TIME SETF-RUNTIME 
-                       CMLSEQBASICS LLARITH LLFLOAT LLBIGNUM LLREAD XCCS LLCHAR LLSTK LLDATATYPE 
-                       IOCHAR LLKEY LLTIMER))
+                       CMLSEQBASICS LLARITH LLFLOAT LLBIGNUM LLREAD IOCHAR XCCS LLCHAR LLSTK 
+                       LLDATATYPE LLKEY LLTIMER))
 
 (RPAQQ 1LISPSET

        (ASTACK DTDECLARE ATBL LLCODE ACODE COREIO AOFD ADIR PMAP VANILLADISK ATERM APRINT ABASIC 

sources/LLREAD

@@ -1,12 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "13-Jun-2025 16:34:10" {WMEDLEY}<sources>LLREAD.;112
 95152  
+
(FILECREATED "13-Aug-2025 14:40:39" {WMEDLEY}<sources>LLREAD.;121
 102895 
 
       :EDIT-BY rmk
 
       :CHANGES-TO (VARS LLREADCOMS)
+                  (FNS CHARCODE.ENCODE CHARSET.DECODE)
 
-      :PREVIOUS-DATE "12-Jun-2025 10:02:38" {WMEDLEY}<sources>LLREAD.;111)
+      :PREVIOUS-DATE " 8-Aug-2025 10:13:49" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLREAD.;118)
 
 
 (PRETTYCOMPRINT LLREADCOMS)
@@ -29,13 +31,17 @@
               (FNS READQUOTE))
         (COMS                                                (* ; "# macro")

               (FNS READVBAR READHASHMACRO DEFMACRO-LAMBDA-LIST-KEYWORD-P DIGITBASEP READNUMBERINBASE
-                   ESTIMATE-DIMENSIONALITY SKIP.HASH.COMMENT CMLREAD.FEATURE.PARSER))
-        (COMS                                                (* ; "Reading characters with #\")

-              (FNS CHARACTER.READ CHARCODE.DECODE CHARCODE.ENCODE CHARCODEP)
-              (FNS HEXNUM? OCTALNUM?)
+                   ESTIMATE-DIMENSIONALITY SKIP.HASH.COMMENT CMLREAD.FEATURE.PARSER)
+                                                             (* ; "Reading characters with #\")

+              (FNS CHARACTER.READ))
+        (COMS                                                (* ; "Character names")

+              (FNS CHARCODE.DECODE CHARCODE.ENCODE CHARCODEP CHARSET.DECODE CHARCODE.ENCODE)
+              (FNS HEXNUM? OCTALNUM? HEXSTRING)
+              (GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES)
               (ALISTS (CHARACTERNAMES Page Form FF Rubout Del Null Escape Esc Bell Tab Backspace Bs 
                              Newline CR EOL Return Tenexeol Space Sp Linefeed LF Zero One Two Three 
-                             Four Five Six Seven Eight Nine)
+                             Four Five Six Seven Eight Nine INFINITY EMQUAD ENQUAD THINSPACE 
+                             FIGURESPACE LEFT-DOUBLEQUOTE RIGHT-DOUBLEQUOTE EMDASH)
                      (CHARACTERSETNAMES Meta Function Greek Cyrillic Hira Hiragana Kata Katakana 
                             Kanji)))
         (DECLARE%: DOEVAL@COMPILE DONTCOPY (CONSTANTS * READTYPES)
@@ -1384,6 +1390,13 @@
 
                                                     "Read a whole name, up to the next break/sepr")

                (CL:CODE-CHAR (CHARCODE.DECODE
 (CONCAT (ALLOCSTRING 1 NEXTCHAR)
                                                          (READ-EXTENDED-TOKEN
 STREAM])
+)
+
+
+
+(* ; "Character names")

+
+(DEFINEQ
 
 (CHARCODE.DECODE

   [LAMBDA (C NOERROR)
                                        (* ; "Edited 25-Apr-2025 11:14 by rmk")


@@ -1474,7 +1487,9 @@
                                          (ERROR "BAD CHARACTER SPECIFICATION" C])
 
 (CHARCODE.ENCODE

-  [LAMBDA (CODE OCTALCHARS NONCHARIDENTITY)
                  (* ; "Edited 23-Apr-2025 19:08 by rmk")


+  [LAMBDA (CODE OCTALCHARS NONCHARIDENTITY)
                  (* ; "Edited 13-Aug-2025 08:54 by rmk")


+                                                             (* ; "Edited  7-Aug-2025 11:10 by rmk")


+                                                             (* ; "Edited 23-Apr-2025 19:08 by rmk")


                                                              (* ; "Edited 26-Mar-2025 10:37 by rmk")


                                                              (* ; "Edited 23-Mar-2025 14:57 by rmk")


                                                              (* ; "Edited 18-Mar-2025 20:55 by rmk")


@@ -1489,16 +1504,12 @@
 
     (* ;; "If NONCHARIDENTITY, returns CODE if it isn't something that can be interpreted as a character code.")

 
-    (DECLARE
 (USEDFREE CHARACTERSETNAMES CHARACTERNAMES))
+    (DECLARE
 (GLOBALVARS CHARACTERSETNAMES CHARACTERNAMES))
 
     (* ;; "")

 
     (if
 (LISTP CODE)
-        then
 (CONS (CHARCODE.ENCODE
 (CAR CODE)
-                          OCTALCHARS NONCHARIDENTITY)
-                   (AND (CDR CODE)
-                        (CHARCODE.ENCODE
 (CDR CODE)
-                               OCTALCHARS NONCHARIDENTITY)))
+        then
 (for
 C in
 CODE collect
 (CHARCODE.ENCODE
 C OCTALCHARS NONCHARIDENTITY))
       elseif
 (CL:CHARACTERP CODE)
         then
 (CHARCODE.ENCODE
 (CL:CHAR-CODE CODE)
                     OCTALCHARS NONCHARIDENTITY)
@@ -1547,11 +1558,107 @@
                     (CONCAT CSETNAME "," CHARNAME))])
 
 (CHARCODEP

-  [LAMBDA (CHCODE)                                           (* gbn "22-Jul-85 16:35")

+  [LAMBDA (CHCODE)
                                           (* ; "Edited  8-Aug-2025 09:16 by rmk")

+                                                             (* gbn "22-Jul-85 16:35")

                                                              (* ; "is CHCODE a legal character code?")

-    (AND (SMALLP CHCODE)
-         (IGEQ CHCODE 0)
-         (ILEQ CHCODE \MAXNSCHAR])
+    (CL:WHEN (AND (SMALLP CHCODE)
+                  (IGEQ CHCODE 0)
+                  (ILEQ CHCODE \MAXNSCHAR))
+           CHCODE])
+
+(CHARSET.DECODE

+  [LAMBDA (C NOERROR)
+    (DECLARE
 (GLOBALVARS CHARACTERSETNAMES))
                 (* ; "Edited 13-Aug-2025 07:59 by rmk")


+                                                             (* ; "Edited  8-Aug-2025 10:13 by rmk")

+
+    (* ;; "Coerces C to a character-set number or list of character-set numbers")

+
+    (if
 (AND (SMALLP C)
+             (<= 0 C \MAXCHARSET))
+        then
 C
+      elseif
 (NULL C)
+        then
 NIL
+      elseif
 (AND (OR (STRINGP C)
+                      (LITATOM C))
+                  (OR (OCTALNUM?
 C)
+                      (HEXNUM?
 C T)))
+      elseif
 (LISTP C)
+        then
 (for
 CC in
 C collect
 (CHARSET.DECODE
 CC T))
+      elseif
 [CADR (find
 PAIR in
 CHARACTERSETNAMES suchthat
 (STRING.EQUAL C (CAR PAIR]
+      elseif
 NOERROR
+        then
 NIL
+      else
 (ERROR "BAD CHARACTER-SET SPECIFICATION" C])
+
+(CHARCODE.ENCODE

+  [LAMBDA (CODE OCTALCHARS NONCHARIDENTITY)
                  (* ; "Edited 13-Aug-2025 08:54 by rmk")


+                                                             (* ; "Edited  7-Aug-2025 11:10 by rmk")


+                                                             (* ; "Edited 23-Apr-2025 19:08 by rmk")


+                                                             (* ; "Edited 26-Mar-2025 10:37 by rmk")


+                                                             (* ; "Edited 23-Mar-2025 14:57 by rmk")


+                                                             (* ; "Edited 18-Mar-2025 20:55 by rmk")


+                                                             (* ; "Edited  6-Dec-2023 20:30 by rmk")


+                                                            (* ; "Edited 20-Sep-2021 15:03 by rmk:")

+
+    (* ;; "If CODE correspond to a named character, that character is returned.")

+
+    (* ;; "Otherwise, if OCTALCHARS the result is of the form %"cset,octal-char%" where cset is a known name (Meta) or the octal string for an unknown character set.  Ascii codes show up with %"0,xx%"")

+
+    (* ;; "If not OCTALCHARS, the character-name part is constructed from the name of its Ascii equivalent, modified by ^ or #. %"0,%" is suppressed in front of the names for character-set 0.")

+
+    (* ;; "If NONCHARIDENTITY, returns CODE if it isn't something that can be interpreted as a character code.")

+
+    (DECLARE
 (GLOBALVARS CHARACTERSETNAMES CHARACTERNAMES))
+
+    (* ;; "")

+
+    (if
 (LISTP CODE)
+        then
 (for
 C in
 CODE collect
 (CHARCODE.ENCODE
 C OCTALCHARS NONCHARIDENTITY))
+      elseif
 (CL:CHARACTERP CODE)
+        then
 (CHARCODE.ENCODE
 (CL:CHAR-CODE CODE)
+                    OCTALCHARS NONCHARIDENTITY)
+      elseif
 (NULL CODE)
+        then
 NIL
+      elseif
 (NOT (CHARCODEP
 CODE))
+        then
 (CL:IF NONCHARIDENTITY
+                 CODE
+                 (\ILLEGAL.ARG CODE))
+      elseif
 [CAR (find
 CN in
 CHARACTERNAMES suchthat
 (if
 (CHARCODEP
 (CADR CN))
+                                                          then
 (IEQP CODE (CADR CN))
+                                                        else
 (IEQP CODE (CHARCODE.DECODE
 (CADR CN]
+      else
 (LET ((CHARSET (LRSH CODE 8))
+                 (CHAR (LOGAND CODE 255))
+                 (ASCIICODE (LOGAND CODE 127))
+                 CSETNAME CHARNAME ASCIINAME)
+                (SETQ CSETNAME (if
 [CAR (find
 CN in
 CHARACTERSETNAMES
+                                           suchthat
 (STRING.EQUAL CHARSET (CADR CN]
+                                 else
 (OCTALSTRING CHARSET)))
+                [SETQ CHARNAME (if
 OCTALCHARS
+                                   then
 (OCTALSTRING CHAR)
+                                 else
 (CAR (for
 CC in
 CHARACTERNAMES when
 (EQ CHAR (CADR CC))
+                                              smallest
 (NCHARS (CAR CC]
+                (CL:WHEN (STREQUAL CHARNAME "Tenexeol")      (* ; 
+
                                                          "Put (%"^_%" Tenexeol) in CHARACTERNAMES ?")

+                    (SETQ CHARNAME "^_"))
+
+                (* ;; "Didn't find the special character name, let's find a corresponding Asciiname to prefix with ^ and/or #")

+
+                (CL:UNLESS CHARNAME
+                    [SETQ ASCIINAME (if
 [CAR (for
 CC in
 CHARACTERNAMES
+                                                when
 (EQ ASCIICODE (CADR CC))
+                                                smallest
 (NCHARS (CAR CC]
+                                      elseif
 (ILESSP ASCIICODE (CHARCODE SPACE))
+                                        then
 [CONCAT "^" (CHARACTER (IPLUS ASCIICODE (CHARCODE @]
+                                      else
 
+                                           (* ;; "Not named and not a control")

+
+                                           (CONCAT (CHARACTER ASCIICODE]
+                    (SETQ CHARNAME (CL:IF (IGEQ CHAR 128)
+                                       (CONCAT "#" ASCIINAME)
+                                       ASCIINAME)))
+                (CL:IF (AND (ZEROP CHARSET)
+                            (NOT OCTALCHARS))
+                    CHARNAME
+                    (CONCAT CSETNAME "," CHARNAME))])
 )
 (DEFINEQ
 
@@ -1603,6 +1710,33 @@
                   THEN
 [SETQ NUM (IPLUS (LLSH NUM 3)
                                             (IDIFFERENCE C (CHARCODE 0]
                 ELSE
 (RETURN NIL)) FINALLY
 (RETURN NUM])
+
+(HEXSTRING

+  [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.")

+
+    (CL:UNLESS (FIXP N)
+        (SETQ N (CHARCODE.DECODE
 N)))
+    (LET [CHAR (STR (ALLOCSTRING [IMAX (OR WIDTH 0)
+                                       (FOR
 I (LEFT _ N) FROM
 0 UNTIL
 (EQ LEFT 0)
+                                          DO
 (SETQ LEFT (LRSH LEFT 4))
+                                          FINALLY
 (RETURN (MAX I 1]
+                           (CHARCODE 0]
+         (FOR
 I FROM
 -1 BY
 -1 UNTIL
 (EQ N 0) DO
 (SETQ CHAR (LOGAND N 15))
+                                                [RPLCHARCODE STR I
+                                                       (IF
 (ILESSP CHAR 10)
+                                                           THEN
 (+ CHAR (CHARCODE 0))
+                                                         ELSE
 (+ (- CHAR 10)
+                                                                 (CHARCODE A]
+                                                (SETQ N (LRSH N 4)))
+         STR])
+)
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES)
 )
 
 (ADDTOVAR CHARACTERNAMES

@@ -1636,7 +1770,15 @@
           (Six 54)
           (Seven 55)
           (Eight 56)
-          (Nine 57))
+          (Nine 57)
+          (INFINITY "41,147")
+          (EMQUAD "357,55")
+          (ENQUAD "357,54")
+          (THINSPACE "357,57")
+          (FIGURESPACE "357,56")
+          (LEFT-DOUBLEQUOTE "0,252")
+          (RIGHT-DOUBLEQUOTE "0,272")
+          (EMDASH "357,045"))
 
 (ADDTOVAR CHARACTERSETNAMES
 (Meta 1)
                             (Function 2)
@@ -1750,18 +1892,19 @@
 (ADDTOVAR LAMA
 CL:PARSE-INTEGER CL:READ-DELIMITED-LIST CL:READ-PRESERVING-WHITESPACE CL:READ)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3463 11907 (LASTC 3473 . 3779) (PEEKC 3781 . 4169) (PEEKCCODE 4171 . 4582) (RATOM 4584
- . 5665) (READ 5667 . 6227) (READC 6229 . 6870) (READCCODE 6872 . 7631) (READP 7633 . 8185) (
-SETREADMACROFLG 8187 . 8486) (SKIPSEPRCODES 8488 . 9568) (SKIPSEPRS 9570 . 9956) (SKREAD 9958 . 11905)
-) (11953 20562 (CL:READ 11963 . 12512) (CL:READ-PRESERVING-WHITESPACE 12514 . 13236) (
-CL:READ-DELIMITED-LIST 13238 . 14153) (CL:PARSE-INTEGER 14155 . 20560)) (20655 33132 (RSTRING 20665 . 
-21397) (READ-EXTENDED-TOKEN 21399 . 25271) (\RSTRING2 25273 . 33130)) (33168 63901 (\TOP-LEVEL-READ 
-33178 . 35161) (\SUBREAD 35163 . 60317) (\SUBREADCONCAT 60319 . 60942) (\ORIG-READ.SYMBOL 60944 . 
-62012) (\ORIG-INVALID.SYMBOL 62014 . 62913) (\APPLYREADMACRO 62915 . 63331) (INREADMACROP 63333 . 
-63899)) (64060 64235 (READQUOTE 64070 . 64233)) (64260 76164 (READVBAR 64270 . 65601) (READHASHMACRO 
-65603 . 71413) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71415 . 71635) (DIGITBASEP 71637 . 72371) (
-READNUMBERINBASE 72373 . 74259) (ESTIMATE-DIMENSIONALITY 74261 . 74586) (SKIP.HASH.COMMENT 74588 . 
-75556) (CMLREAD.FEATURE.PARSER 75558 . 76162)) (76208 87325 (CHARACTER.READ 76218 . 77472) (
-CHARCODE.DECODE 77474 . 82643) (CHARCODE.ENCODE 82645 . 87024) (CHARCODEP 87026 . 87323)) (87326 90496
- (HEXNUM? 87336 . 89679) (OCTALNUM? 89681 . 90494)))))
+  (FILEMAP (NIL (3886 12330 (LASTC 3896 . 4202) (PEEKC 4204 . 4592) (PEEKCCODE 4594 . 5005) (RATOM 5007
+ . 6088) (READ 6090 . 6650) (READC 6652 . 7293) (READCCODE 7295 . 8054) (READP 8056 . 8608) (
+SETREADMACROFLG 8610 . 8909) (SKIPSEPRCODES 8911 . 9991) (SKIPSEPRS 9993 . 10379) (SKREAD 10381 . 
+12328)) (12376 20985 (CL:READ 12386 . 12935) (CL:READ-PRESERVING-WHITESPACE 12937 . 13659) (
+CL:READ-DELIMITED-LIST 13661 . 14576) (CL:PARSE-INTEGER 14578 . 20983)) (21078 33555 (RSTRING 21088 . 
+21820) (READ-EXTENDED-TOKEN 21822 . 25694) (\RSTRING2 25696 . 33553)) (33591 64324 (\TOP-LEVEL-READ 
+33601 . 35584) (\SUBREAD 35586 . 60740) (\SUBREADCONCAT 60742 . 61365) (\ORIG-READ.SYMBOL 61367 . 
+62435) (\ORIG-INVALID.SYMBOL 62437 . 63336) (\APPLYREADMACRO 63338 . 63754) (INREADMACROP 63756 . 
+64322)) (64483 64658 (READQUOTE 64493 . 64656)) (64683 76587 (READVBAR 64693 . 66024) (READHASHMACRO 
+66026 . 71836) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71838 . 72058) (DIGITBASEP 72060 . 72794) (
+READNUMBERINBASE 72796 . 74682) (ESTIMATE-DIMENSIONALITY 74684 . 75009) (SKIP.HASH.COMMENT 75011 . 
+75979) (CMLREAD.FEATURE.PARSER 75981 . 76585)) (76631 77897 (CHARACTER.READ 76641 . 77895)) (77930 
+93404 (CHARCODE.DECODE 77940 . 83109) (CHARCODE.ENCODE 83111 . 87553) (CHARCODEP 87555 . 88008) (
+CHARSET.DECODE 88010 . 88958) (CHARCODE.ENCODE 88960 . 93402)) (93405 97901 (HEXNUM? 93415 . 95758) (
+OCTALNUM? 95760 . 96573) (HEXSTRING 96575 . 97899)))))
 STOP