Skip to content

Commit d01503c

Browse files
rmkaplanrmkaplan
committed
LLREAD - removed duplication, added CHARSET.ENCODE. Encode charsets in LOADFULLFONTS
1 parent 2dd5b86 commit d01503c

File tree

4 files changed

+39
-90
lines changed

4 files changed

+39
-90
lines changed

‎internal/loadups/LOADUP-FULL‎

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,12 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

3-
(FILECREATED " 2-Sep-2025 20:07:20" {WMEDLEY}<internal>loadups>LOADUP-FULL.;33 5541
3+
(FILECREATED "20-Sep-2025 14:18:19" {WMEDLEY}<internal>loadups>LOADUP-FULL.;34 5662
44

55
:EDIT-BY rmk
66

77
:CHANGES-TO (FNS LOADFULLFONTS)
88

9-
:PREVIOUS-DATE " 1-Sep-2025 11:59:41" {WMEDLEY}<internal>loadups>LOADUP-FULL.;31)
9+
:PREVIOUS-DATE " 2-Sep-2025 20:07:20" {WMEDLEY}<internal>loadups>LOADUP-FULL.;33)
1010

1111

1212
(PRETTYCOMPRINT LOADUP-FULLCOMS)
@@ -16,7 +16,8 @@
1616
(DEFINEQ
1717

1818
(LOADFULLFONTS
19-
[LAMBDA NIL (* ; "Edited 2-Sep-2025 20:06 by rmk")
19+
[LAMBDA NIL (* ; "Edited 20-Sep-2025 14:17 by rmk")
20+
(* ; "Edited 2-Sep-2025 20:06 by rmk")
2021
(* ; "Edited 13-Jul-2025 11:40 by rmk")
2122
(* ; "Edited 30-Jun-2025 00:04 by rmk")
2223
(* ; "Edited 20-Jun-2025 11:16 by rmk")
@@ -37,7 +38,7 @@
3738
do (PRINTOUT T SIZE " ")
3839
(for FACE in '(MRR BRR MIR)
3940
do (FONTCREATE FAMILY SIZE FACE 0 'DISPLAY NIL 0)
40-
(for CSET in '(33 34 35 238 239 241)
41+
(for CSET in '("41" "42" "43" "356" "357" "361")
4142
do (NLSETQ (FONTCREATE FAMILY SIZE FACE 0 'DISPLAY NIL CSET]
4243
(PRINTOUT T T))
4344
(PRINTOUT T " Loading postscript fonts" T)
@@ -99,5 +100,5 @@
99100

100101
(FIXMETA)
101102
(DECLARE%: DONTCOPY
102-
(FILEMAP (NIL (458 5503 (LOADFULLFONTS 468 . 2482) (LOADUP-FULL 2484 . 5253) (FIXMETA 5255 . 5501)))))
103+
(FILEMAP (NIL (458 5624 (LOADFULLFONTS 468 . 2603) (LOADUP-FULL 2605 . 5374) (FIXMETA 5376 . 5622)))))
103104
STOP

‎internal/loadups/LOADUP-FULL.LCOM‎

12 Bytes
Binary file not shown.

‎sources/LLREAD‎

Lines changed: 33 additions & 85 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,13 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

3-
(FILECREATED "24-Aug-2025 11:47:11" 
4-
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLREAD.;122 102955
3+
(FILECREATED "20-Sep-2025 14:18:31" {WMEDLEY}<sources>LLREAD.;123 99281
54

65
:EDIT-BY rmk
76

8-
:CHANGES-TO (FNS CHARCODEP)
7+
:CHANGES-TO (VARS LLREADCOMS)
8+
(FNS CHARSET.ENCODE)
99

10-
:PREVIOUS-DATE "13-Aug-2025 14:40:39"
11-
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLREAD.;121)
10+
:PREVIOUS-DATE "24-Aug-2025 11:47:11" {WMEDLEY}<sources>LLREAD.;122)
1211

1312

1413
(PRETTYCOMPRINT LLREADCOMS)
@@ -35,7 +34,7 @@
3534
(* ; "Reading characters with #\")
3635
(FNS CHARACTER.READ))
3736
(COMS (* ; "Character names")
38-
(FNS CHARCODE.DECODE CHARCODE.ENCODE CHARCODEP CHARSET.DECODE CHARCODE.ENCODE)
37+
(FNS CHARCODE.DECODE CHARCODE.ENCODE CHARCODEP CHARSET.DECODE CHARSET.ENCODE)
3938
(FNS HEXNUM? OCTALNUM? HEXSTRING)
4039
(GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES)
4140
(ALISTS (CHARACTERNAMES Page Form FF Rubout Del Null Escape Esc Bell Tab Backspace Bs
@@ -1589,76 +1588,25 @@
15891588
then NIL
15901589
else (ERROR "BAD CHARACTER-SET SPECIFICATION" C])
15911590

1592-
(CHARCODE.ENCODE
1593-
[LAMBDA (CODE OCTALCHARS NONCHARIDENTITY) (* ; "Edited 13-Aug-2025 08:54 by rmk")
1594-
(* ; "Edited 7-Aug-2025 11:10 by rmk")
1595-
(* ; "Edited 23-Apr-2025 19:08 by rmk")
1596-
(* ; "Edited 26-Mar-2025 10:37 by rmk")
1597-
(* ; "Edited 23-Mar-2025 14:57 by rmk")
1598-
(* ; "Edited 18-Mar-2025 20:55 by rmk")
1599-
(* ; "Edited 6-Dec-2023 20:30 by rmk")
1600-
(* ; "Edited 20-Sep-2021 15:03 by rmk:")
1601-
1602-
(* ;; "If CODE correspond to a named character, that character is returned.")
1603-
1604-
(* ;; "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%"")
1605-
1606-
(* ;; "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.")
1591+
(CHARSET.ENCODE
1592+
[LAMBDA (CSETCODE OCTAL) (* ; "Edited 20-Sep-2025 14:16 by rmk")
16071593

1608-
(* ;; "If NONCHARIDENTITY, returns CODE if it isn't something that can be interpreted as a character code.")
1594+
(* ;; "If CSETCODE correspond to a named character set and OCTAL is NIL, then name is returned. Otherwise the octal string is returned.")
16091595

1610-
(DECLARE (GLOBALVARS CHARACTERSETNAMES CHARACTERNAMES))
1596+
(DECLARE (GLOBALVARS CHARACTERSETNAMES))
16111597

16121598
(* ;; "")
16131599

1614-
(if (LISTP CODE)
1615-
then (for C in CODE collect (CHARCODE.ENCODE C OCTALCHARS NONCHARIDENTITY))
1616-
elseif (CL:CHARACTERP CODE)
1617-
then (CHARCODE.ENCODE (CL:CHAR-CODE CODE)
1618-
OCTALCHARS NONCHARIDENTITY)
1619-
elseif (NULL CODE)
1600+
(if (LISTP CSETCODE)
1601+
then (for CS in CSETCODE collect (CHARSET.ENCODE CS OCTAL))
1602+
elseif (NULL CSETCODE)
16201603
then NIL
1621-
elseif (NOT (CHARCODEP CODE))
1622-
then (CL:IF NONCHARIDENTITY
1623-
CODE
1624-
(\ILLEGAL.ARG CODE))
1625-
elseif [CAR (find CN in CHARACTERNAMES suchthat (if (CHARCODEP (CADR CN))
1626-
then (IEQP CODE (CADR CN))
1627-
else (IEQP CODE (CHARCODE.DECODE (CADR CN]
1628-
else (LET ((CHARSET (LRSH CODE 8))
1629-
(CHAR (LOGAND CODE 255))
1630-
(ASCIICODE (LOGAND CODE 127))
1631-
CSETNAME CHARNAME ASCIINAME)
1632-
(SETQ CSETNAME (if [CAR (find CN in CHARACTERSETNAMES
1633-
suchthat (STRING.EQUAL CHARSET (CADR CN]
1634-
else (OCTALSTRING CHARSET)))
1635-
[SETQ CHARNAME (if OCTALCHARS
1636-
then (OCTALSTRING CHAR)
1637-
else (CAR (for CC in CHARACTERNAMES when (EQ CHAR (CADR CC))
1638-
smallest (NCHARS (CAR CC]
1639-
(CL:WHEN (STREQUAL CHARNAME "Tenexeol") (* ;
1640-
 "Put (%"^_%" Tenexeol) in CHARACTERNAMES ?")
1641-
(SETQ CHARNAME "^_"))
1642-
1643-
(* ;; "Didn't find the special character name, let's find a corresponding Asciiname to prefix with ^ and/or #")
1644-
1645-
(CL:UNLESS CHARNAME
1646-
[SETQ ASCIINAME (if [CAR (for CC in CHARACTERNAMES
1647-
when (EQ ASCIICODE (CADR CC))
1648-
smallest (NCHARS (CAR CC]
1649-
elseif (ILESSP ASCIICODE (CHARCODE SPACE))
1650-
then [CONCAT "^" (CHARACTER (IPLUS ASCIICODE (CHARCODE @]
1651-
else
1652-
(* ;; "Not named and not a control")
1653-
1654-
(CONCAT (CHARACTER ASCIICODE]
1655-
(SETQ CHARNAME (CL:IF (IGEQ CHAR 128)
1656-
(CONCAT "#" ASCIINAME)
1657-
ASCIINAME)))
1658-
(CL:IF (AND (ZEROP CHARSET)
1659-
(NOT OCTALCHARS))
1660-
CHARNAME
1661-
(CONCAT CSETNAME "," CHARNAME))])
1604+
elseif (NOT (<= 0 CSETCODE \MAXCHARSET))
1605+
then (\ILLEGAL.ARG CSETCODE)
1606+
elseif OCTAL
1607+
then (OCTALSTRING CSETCODE)
1608+
else (OR [CAR (find CSN in CHARACTERSETNAMES suchthat (EQ CSETCODE (CADR CSN]
1609+
(OCTALSTRING CSETCODE])
16621610
)
16631611
(DEFINEQ
16641612

@@ -1892,19 +1840,19 @@
18921840
(ADDTOVAR LAMA CL:PARSE-INTEGER CL:READ-DELIMITED-LIST CL:READ-PRESERVING-WHITESPACE CL:READ)
18931841
)
18941842
(DECLARE%: DONTCOPY
1895-
(FILEMAP (NIL (3870 12314 (LASTC 3880 . 4186) (PEEKC 4188 . 4576) (PEEKCCODE 4578 . 4989) (RATOM 4991
1896-
. 6072) (READ 6074 . 6634) (READC 6636 . 7277) (READCCODE 7279 . 8038) (READP 8040 . 8592) (
1897-
SETREADMACROFLG 8594 . 8893) (SKIPSEPRCODES 8895 . 9975) (SKIPSEPRS 9977 . 10363) (SKREAD 10365 .
1898-
12312)) (12360 20969 (CL:READ 12370 . 12919) (CL:READ-PRESERVING-WHITESPACE 12921 . 13643) (
1899-
CL:READ-DELIMITED-LIST 13645 . 14560) (CL:PARSE-INTEGER 14562 . 20967)) (21062 33539 (RSTRING 21072 .
1900-
21804) (READ-EXTENDED-TOKEN 21806 . 25678) (\RSTRING2 25680 . 33537)) (33575 64308 (\TOP-LEVEL-READ
1901-
33585 . 35568) (\SUBREAD 35570 . 60724) (\SUBREADCONCAT 60726 . 61349) (\ORIG-READ.SYMBOL 61351 .
1902-
62419) (\ORIG-INVALID.SYMBOL 62421 . 63320) (\APPLYREADMACRO 63322 . 63738) (INREADMACROP 63740 .
1903-
64306)) (64467 64642 (READQUOTE 64477 . 64640)) (64667 76571 (READVBAR 64677 . 66008) (READHASHMACRO
1904-
66010 . 71820) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71822 . 72042) (DIGITBASEP 72044 . 72778) (
1905-
READNUMBERINBASE 72780 . 74666) (ESTIMATE-DIMENSIONALITY 74668 . 74993) (SKIP.HASH.COMMENT 74995 .
1906-
75963) (CMLREAD.FEATURE.PARSER 75965 . 76569)) (76615 77881 (CHARACTER.READ 76625 . 77879)) (77914
1907-
93464 (CHARCODE.DECODE 77924 . 83093) (CHARCODE.ENCODE 83095 . 87537) (CHARCODEP 87539 . 88068) (
1908-
CHARSET.DECODE 88070 . 89018) (CHARCODE.ENCODE 89020 . 93462)) (93465 97961 (HEXNUM? 93475 . 95818) (
1909-
OCTALNUM? 95820 . 96633) (HEXSTRING 96635 . 97959)))))
1843+
(FILEMAP (NIL (3828 12272 (LASTC 3838 . 4144) (PEEKC 4146 . 4534) (PEEKCCODE 4536 . 4947) (RATOM 4949
1844+
. 6030) (READ 6032 . 6592) (READC 6594 . 7235) (READCCODE 7237 . 7996) (READP 7998 . 8550) (
1845+
SETREADMACROFLG 8552 . 8851) (SKIPSEPRCODES 8853 . 9933) (SKIPSEPRS 9935 . 10321) (SKREAD 10323 .
1846+
12270)) (12318 20927 (CL:READ 12328 . 12877) (CL:READ-PRESERVING-WHITESPACE 12879 . 13601) (
1847+
CL:READ-DELIMITED-LIST 13603 . 14518) (CL:PARSE-INTEGER 14520 . 20925)) (21020 33497 (RSTRING 21030 .
1848+
21762) (READ-EXTENDED-TOKEN 21764 . 25636) (\RSTRING2 25638 . 33495)) (33533 64266 (\TOP-LEVEL-READ
1849+
33543 . 35526) (\SUBREAD 35528 . 60682) (\SUBREADCONCAT 60684 . 61307) (\ORIG-READ.SYMBOL 61309 .
1850+
62377) (\ORIG-INVALID.SYMBOL 62379 . 63278) (\APPLYREADMACRO 63280 . 63696) (INREADMACROP 63698 .
1851+
64264)) (64425 64600 (READQUOTE 64435 . 64598)) (64625 76529 (READVBAR 64635 . 65966) (READHASHMACRO
1852+
65968 . 71778) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71780 . 72000) (DIGITBASEP 72002 . 72736) (
1853+
READNUMBERINBASE 72738 . 74624) (ESTIMATE-DIMENSIONALITY 74626 . 74951) (SKIP.HASH.COMMENT 74953 .
1854+
75921) (CMLREAD.FEATURE.PARSER 75923 . 76527)) (76573 77839 (CHARACTER.READ 76583 . 77837)) (77872
1855+
89790 (CHARCODE.DECODE 77882 . 83051) (CHARCODE.ENCODE 83053 . 87495) (CHARCODEP 87497 . 88026) (
1856+
CHARSET.DECODE 88028 . 88976) (CHARSET.ENCODE 88978 . 89788)) (89791 94287 (HEXNUM? 89801 . 92144) (
1857+
OCTALNUM? 92146 . 92959) (HEXSTRING 92961 . 94285)))))
19101858
STOP

‎sources/LLREAD.LCOM‎

-812 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)