github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-03-03 10:23:36 +00:00
Code Issues Projects Releases Wiki Activity

Add charset functions in LLREAD, move IOCHAR a little bit earlier (#2256)

Browse Source 
CHARSET.DECODE, CHARSET.ENCODE added.  CHARACTER.ENCODE moved here from TEDIT-FNKEYS. Some character names moved here from a few other files.

This anticipates the ability to use names for the charset argument to FONTCREATE.  IOCHAR needed to move a little earlier so that STRING.EQUAL/UPPERCASEARRAY is available before FONTCREATE created the guaranteed displayfont.
This commit is contained in:
rmkaplan
2025-08-15 09:49:21 -07:00
committed by GitHub
parent a39e3d9dc5
commit 92a3cea0eb
3 changed files with 181 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
sources/FILESETS
View File

@@ -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

209
sources/LLREAD
View File

@@ -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

BIN
sources/LLREAD.LCOM
View File

Binary file not shown.