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

LLREAD - removed duplication, added CHARSET.ENCODE. Encode charsets in LOADFULLFONTS

Browse Source
This commit is contained in:
rmkaplan
2025-09-20 14:24:21 -07:00
parent 2dd5b86913
commit d01503c11e
4 changed files with 39 additions and 90 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
internal/loadups/LOADUP-FULL
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-Sep-2025 20:07:20" {WMEDLEY}<internal>loadups>LOADUP-FULL.;33 5541
(FILECREATED "20-Sep-2025 14:18:19" {WMEDLEY}<internal>loadups>LOADUP-FULL.;34 5662
:EDIT-BY rmk
:CHANGES-TO (FNS LOADFULLFONTS)
:PREVIOUS-DATE " 1-Sep-2025 11:59:41" {WMEDLEY}<internal>loadups>LOADUP-FULL.;31)
:PREVIOUS-DATE " 2-Sep-2025 20:07:20" {WMEDLEY}<internal>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

BIN
internal/loadups/LOADUP-FULL.LCOM
View File

Binary file not shown.

118
sources/LLREAD
View File

@@ -1,14 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Aug-2025 11:47:11" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLREAD.;122 102955
(FILECREATED "20-Sep-2025 14:18:31" {WMEDLEY}<sources>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}<Users>kaplan>Local>medley3.5>working-medley>sources>LLREAD.;121)
:PREVIOUS-DATE "24-Aug-2025 11:47:11" {WMEDLEY}<sources>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

BIN
sources/LLREAD.LCOM
View File

Binary file not shown.