From d01503c11ee50bccec16923a347fcad85fb63e27 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 20 Sep 2025 14:24:21 -0700 Subject: [PATCH] LLREAD - removed duplication, added CHARSET.ENCODE. Encode charsets in LOADFULLFONTS --- internal/loadups/LOADUP-FULL | 11 +-- internal/loadups/LOADUP-FULL.LCOM | Bin 3034 -> 3046 bytes sources/LLREAD | 118 +++++++++--------------------- sources/LLREAD.LCOM | Bin 25704 -> 24892 bytes 4 files changed, 39 insertions(+), 90 deletions(-) diff --git a/internal/loadups/LOADUP-FULL b/internal/loadups/LOADUP-FULL index 3c1734ad..cdeba4e4 100644 --- a/internal/loadups/LOADUP-FULL +++ b/internal/loadups/LOADUP-FULL @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Sep-2025 20:07:20" {WMEDLEY}loadups>LOADUP-FULL.;33 5541 +(FILECREATED "20-Sep-2025 14:18:19" {WMEDLEY}loadups>LOADUP-FULL.;34 5662 :EDIT-BY rmk :CHANGES-TO (FNS LOADFULLFONTS) - :PREVIOUS-DATE " 1-Sep-2025 11:59:41" {WMEDLEY}loadups>LOADUP-FULL.;31) + :PREVIOUS-DATE " 2-Sep-2025 20:07:20" {WMEDLEY}loadups>LOADUP-FULL.;33) (PRETTYCOMPRINT LOADUP-FULLCOMS) @@ -16,7 +16,8 @@ (DEFINEQ (LOADFULLFONTS - [LAMBDA NIL (* ; "Edited 2-Sep-2025 20:06 by rmk") + [LAMBDA NIL (* ; "Edited 20-Sep-2025 14:17 by rmk") + (* ; "Edited 2-Sep-2025 20:06 by rmk") (* ; "Edited 13-Jul-2025 11:40 by rmk") (* ; "Edited 30-Jun-2025 00:04 by rmk") (* ; "Edited 20-Jun-2025 11:16 by rmk") @@ -37,7 +38,7 @@ do (PRINTOUT T SIZE " ") (for FACE in '(MRR BRR MIR) do (FONTCREATE FAMILY SIZE FACE 0 'DISPLAY NIL 0) - (for CSET in '(33 34 35 238 239 241) + (for CSET in '("41" "42" "43" "356" "357" "361") do (NLSETQ (FONTCREATE FAMILY SIZE FACE 0 'DISPLAY NIL CSET] (PRINTOUT T T)) (PRINTOUT T " Loading postscript fonts" T) @@ -99,5 +100,5 @@ (FIXMETA) (DECLARE%: DONTCOPY - (FILEMAP (NIL (458 5503 (LOADFULLFONTS 468 . 2482) (LOADUP-FULL 2484 . 5253) (FIXMETA 5255 . 5501))))) + (FILEMAP (NIL (458 5624 (LOADFULLFONTS 468 . 2603) (LOADUP-FULL 2605 . 5374) (FIXMETA 5376 . 5622))))) STOP diff --git a/internal/loadups/LOADUP-FULL.LCOM b/internal/loadups/LOADUP-FULL.LCOM index 11857189730218d4dd38462589a2fd968bbe1b3d..d5a7e96d2a04a6145c333ba724c9d20a8f55daf9 100644 GIT binary patch delta 217 zcmca5{!DyAxQLN~Zg6UWu91O}se+-2m7#@|q2$! H#l{K%nT0bY delta 172 zcmaDReoK5p_~dnrViR*MC5<%|xRex(bc0h1bd3y*Oce}Gtqe`9j4UVa*JV;Ln)ps! z8B^BSLP?WL!_Cvj)j7!3F~rqn@)|~o$qtN~Y{m+vrY44y^BEn)43W$)G~E22v6@B1*jT~XM8Vip!N}MGh%FV2fLgoQ94DV)lVapr{EUqi033!Z2mk;8 diff --git a/sources/LLREAD b/sources/LLREAD index 918a40b4..d3897704 100644 --- a/sources/LLREAD +++ b/sources/LLREAD @@ -1,14 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "24-Aug-2025 11:47:11"  -{DSK}kaplan>Local>medley3.5>working-medley>sources>LLREAD.;122 102955 +(FILECREATED "20-Sep-2025 14:18:31" {WMEDLEY}LLREAD.;123 99281 :EDIT-BY rmk - :CHANGES-TO (FNS CHARCODEP) + :CHANGES-TO (VARS LLREADCOMS) + (FNS CHARSET.ENCODE) - :PREVIOUS-DATE "13-Aug-2025 14:40:39" -{DSK}kaplan>Local>medley3.5>working-medley>sources>LLREAD.;121) + :PREVIOUS-DATE "24-Aug-2025 11:47:11" {WMEDLEY}LLREAD.;122) (PRETTYCOMPRINT LLREADCOMS) @@ -35,7 +34,7 @@ (* ; "Reading characters with #\") (FNS CHARACTER.READ)) (COMS (* ; "Character names") - (FNS CHARCODE.DECODE CHARCODE.ENCODE CHARCODEP CHARSET.DECODE CHARCODE.ENCODE) + (FNS CHARCODE.DECODE CHARCODE.ENCODE CHARCODEP CHARSET.DECODE CHARSET.ENCODE) (FNS HEXNUM? OCTALNUM? HEXSTRING) (GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES) (ALISTS (CHARACTERNAMES Page Form FF Rubout Del Null Escape Esc Bell Tab Backspace Bs @@ -1589,76 +1588,25 @@ 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:") +(CHARSET.ENCODE + [LAMBDA (CSETCODE OCTAL) (* ; "Edited 20-Sep-2025 14:16 by rmk") - (* ;; "If CODE correspond to a named character, that character is returned.") + (* ;; "If CSETCODE correspond to a named character set and OCTAL is NIL, then name is returned. Otherwise the octal string 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)) + (DECLARE (GLOBALVARS CHARACTERSETNAMES)) (* ;; "") - (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) + (if (LISTP CSETCODE) + then (for CS in CSETCODE collect (CHARSET.ENCODE CS OCTAL)) + elseif (NULL CSETCODE) 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))]) + elseif (NOT (<= 0 CSETCODE \MAXCHARSET)) + then (\ILLEGAL.ARG CSETCODE) + elseif OCTAL + then (OCTALSTRING CSETCODE) + else (OR [CAR (find CSN in CHARACTERSETNAMES suchthat (EQ CSETCODE (CADR CSN] + (OCTALSTRING CSETCODE]) ) (DEFINEQ @@ -1892,19 +1840,19 @@ (ADDTOVAR LAMA CL:PARSE-INTEGER CL:READ-DELIMITED-LIST CL:READ-PRESERVING-WHITESPACE CL:READ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3870 12314 (LASTC 3880 . 4186) (PEEKC 4188 . 4576) (PEEKCCODE 4578 . 4989) (RATOM 4991 - . 6072) (READ 6074 . 6634) (READC 6636 . 7277) (READCCODE 7279 . 8038) (READP 8040 . 8592) ( -SETREADMACROFLG 8594 . 8893) (SKIPSEPRCODES 8895 . 9975) (SKIPSEPRS 9977 . 10363) (SKREAD 10365 . -12312)) (12360 20969 (CL:READ 12370 . 12919) (CL:READ-PRESERVING-WHITESPACE 12921 . 13643) ( -CL:READ-DELIMITED-LIST 13645 . 14560) (CL:PARSE-INTEGER 14562 . 20967)) (21062 33539 (RSTRING 21072 . -21804) (READ-EXTENDED-TOKEN 21806 . 25678) (\RSTRING2 25680 . 33537)) (33575 64308 (\TOP-LEVEL-READ -33585 . 35568) (\SUBREAD 35570 . 60724) (\SUBREADCONCAT 60726 . 61349) (\ORIG-READ.SYMBOL 61351 . -62419) (\ORIG-INVALID.SYMBOL 62421 . 63320) (\APPLYREADMACRO 63322 . 63738) (INREADMACROP 63740 . -64306)) (64467 64642 (READQUOTE 64477 . 64640)) (64667 76571 (READVBAR 64677 . 66008) (READHASHMACRO -66010 . 71820) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71822 . 72042) (DIGITBASEP 72044 . 72778) ( -READNUMBERINBASE 72780 . 74666) (ESTIMATE-DIMENSIONALITY 74668 . 74993) (SKIP.HASH.COMMENT 74995 . -75963) (CMLREAD.FEATURE.PARSER 75965 . 76569)) (76615 77881 (CHARACTER.READ 76625 . 77879)) (77914 -93464 (CHARCODE.DECODE 77924 . 83093) (CHARCODE.ENCODE 83095 . 87537) (CHARCODEP 87539 . 88068) ( -CHARSET.DECODE 88070 . 89018) (CHARCODE.ENCODE 89020 . 93462)) (93465 97961 (HEXNUM? 93475 . 95818) ( -OCTALNUM? 95820 . 96633) (HEXSTRING 96635 . 97959))))) + (FILEMAP (NIL (3828 12272 (LASTC 3838 . 4144) (PEEKC 4146 . 4534) (PEEKCCODE 4536 . 4947) (RATOM 4949 + . 6030) (READ 6032 . 6592) (READC 6594 . 7235) (READCCODE 7237 . 7996) (READP 7998 . 8550) ( +SETREADMACROFLG 8552 . 8851) (SKIPSEPRCODES 8853 . 9933) (SKIPSEPRS 9935 . 10321) (SKREAD 10323 . +12270)) (12318 20927 (CL:READ 12328 . 12877) (CL:READ-PRESERVING-WHITESPACE 12879 . 13601) ( +CL:READ-DELIMITED-LIST 13603 . 14518) (CL:PARSE-INTEGER 14520 . 20925)) (21020 33497 (RSTRING 21030 . +21762) (READ-EXTENDED-TOKEN 21764 . 25636) (\RSTRING2 25638 . 33495)) (33533 64266 (\TOP-LEVEL-READ +33543 . 35526) (\SUBREAD 35528 . 60682) (\SUBREADCONCAT 60684 . 61307) (\ORIG-READ.SYMBOL 61309 . +62377) (\ORIG-INVALID.SYMBOL 62379 . 63278) (\APPLYREADMACRO 63280 . 63696) (INREADMACROP 63698 . +64264)) (64425 64600 (READQUOTE 64435 . 64598)) (64625 76529 (READVBAR 64635 . 65966) (READHASHMACRO +65968 . 71778) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71780 . 72000) (DIGITBASEP 72002 . 72736) ( +READNUMBERINBASE 72738 . 74624) (ESTIMATE-DIMENSIONALITY 74626 . 74951) (SKIP.HASH.COMMENT 74953 . +75921) (CMLREAD.FEATURE.PARSER 75923 . 76527)) (76573 77839 (CHARACTER.READ 76583 . 77837)) (77872 +89790 (CHARCODE.DECODE 77882 . 83051) (CHARCODE.ENCODE 83053 . 87495) (CHARCODEP 87497 . 88026) ( +CHARSET.DECODE 88028 . 88976) (CHARSET.ENCODE 88978 . 89788)) (89791 94287 (HEXNUM? 89801 . 92144) ( +OCTALNUM? 92146 . 92959) (HEXSTRING 92961 . 94285))))) STOP diff --git a/sources/LLREAD.LCOM b/sources/LLREAD.LCOM index be2bc677d0fa6a8a2b418eaa190954bd4f65cb15..0a78b0a669e557d7cad9a2050a1f807370441149 100644 GIT binary patch delta 560 zcmZ{g%Syvg5QdW!M6(d9f?W=AlPnUFXf=(u9Fx;FaBMV5y+9XUT4}Yl;$%NzP|J|~M_VN+CPH4e(4u4wvz z!U4~%R4bdMav=}Z4d7sJZVFojFYJ$QS9iBo3ftp^xENW|h@uV%z;fz$8CjR(x-!hc z(OvAo!@h(wrek3!g;L2ZA@F@#k|YlDOFN;}Uoxu32`rzq2{uDRA6xL#>kIiG#9WgR z5(!mPK*yHti<1kmRapn!OruN+d!p|EKZ{(Cg=Q+#neqhSlNk@f5x12<0DaoUv$m7< zL@R`;P0%s6Wqefc4Mv$&XRNgWx}~u^0bT*e^br9W%&_}@4nY8_7@;V}$VblmucIq0@#;(HN|(&G`gmNkKdgIhzoiLPSDt3Y5g}a4bJG`0AFS+My3jehE^u#R)&U33K~ku`MCv|IjJcM`FRRT3S8AL z!QQntp~b01#dg_=1v!a%c0T#Zi8*$;sVO!-P%^^i)p{!VO~KH> z$kNnQ!OGReGep-ZQlTg}TfqwG1wVJ!VBHXZ1)yX6f)RewRImyNat-rL^A8QybpbjM t=m}$_uraYRF|abWq*BluZob2q?!WoB_j=~dYC#*>SU};r`Bp>{2LO-moX-FN