From 4549ad1e65553d16e0eb644a74d89b24499e209e Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Thu, 11 Sep 2025 23:45:34 -0700 Subject: [PATCH] MCCS as default format -- see docs/internal/MCCS.TEDIT --- internal/loadups/LOADUP-FULL | 11 +- internal/loadups/LOADUP-FULL.LCOM | Bin 3030 -> 3034 bytes sources/BOOTSTRAP | 139 ++- sources/BOOTSTRAP.LCOM | Bin 14652 -> 14452 bytes sources/EXTERNALFORMAT | 28 +- sources/FILESETS | 8 +- sources/LLKEY | 76 +- sources/LLKEY.LCOM | Bin 66413 -> 66413 bytes sources/MCCS | 1379 +++++++++++++++++++++++++++++ sources/MCCS.LCOM | Bin 0 -> 21214 bytes sources/PRETTY | 42 +- sources/PRETTY.LCOM | Bin 30501 -> 30333 bytes 12 files changed, 1524 insertions(+), 159 deletions(-) create mode 100644 sources/MCCS create mode 100644 sources/MCCS.LCOM diff --git a/internal/loadups/LOADUP-FULL b/internal/loadups/LOADUP-FULL index ed1583f5..3c1734ad 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 " 1-Sep-2025 11:59:41" {WMEDLEY}loadups>LOADUP-FULL.;31 5430 +(FILECREATED " 2-Sep-2025 20:07:20" {WMEDLEY}loadups>LOADUP-FULL.;33 5541 :EDIT-BY rmk - :CHANGES-TO (FNS LOADUP-FULL) + :CHANGES-TO (FNS LOADFULLFONTS) - :PREVIOUS-DATE "18-Aug-2025 12:09:49" {WMEDLEY}loadups>LOADUP-FULL.;29) + :PREVIOUS-DATE " 1-Sep-2025 11:59:41" {WMEDLEY}loadups>LOADUP-FULL.;31) (PRETTYCOMPRINT LOADUP-FULLCOMS) @@ -16,7 +16,8 @@ (DEFINEQ (LOADFULLFONTS - [LAMBDA NIL (* ; "Edited 13-Jul-2025 11:40 by rmk") + [LAMBDA NIL (* ; "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") (* ; "Edited 16-Jun-2025 15:34 by rmk") @@ -98,5 +99,5 @@ (FIXMETA) (DECLARE%: DONTCOPY - (FILEMAP (NIL (456 5392 (LOADFULLFONTS 466 . 2371) (LOADUP-FULL 2373 . 5142) (FIXMETA 5144 . 5390))))) + (FILEMAP (NIL (458 5503 (LOADFULLFONTS 468 . 2482) (LOADUP-FULL 2484 . 5253) (FIXMETA 5255 . 5501))))) STOP diff --git a/internal/loadups/LOADUP-FULL.LCOM b/internal/loadups/LOADUP-FULL.LCOM index e28b50b4377f37a6a0e900de6bb56a4fdff8d3f7..11857189730218d4dd38462589a2fd968bbe1b3d 100644 GIT binary patch delta 238 zcmca6eoK5pgs_oraB6|Bk%5t^f{}rhfw`5D!NhE9Nn=d~E+qvdNkdaBLlY|_%ZdA? z(%nLReBAu~LV^`C^AwaoJOyN>dU|?F3Mq*tsVP{^Ft$+A=IP_=9OUX4;_5Pa4WqWMsMd IJ>zRm0B=Gv#{d8T diff --git a/sources/BOOTSTRAP b/sources/BOOTSTRAP index c81fa655..6dc3543d 100644 --- a/sources/BOOTSTRAP +++ b/sources/BOOTSTRAP @@ -1,16 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "27-Sep-2021 10:25:31"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;60 47698 - changes to%: (FNS PRINT-READER-ENVIRONMENT READ-READER-ENVIRONMENT) +(FILECREATED "23-Apr-2025 23:39:10" {WMEDLEY}BOOTSTRAP.;61 47417 - previous date%: "17-Aug-2021 00:08:39" -{DSK}kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;58) + :EDIT-BY rmk + :CHANGES-TO (FNS PRINT-READER-ENVIRONMENT \DO-DEFINE-FILE-INFO) + + :PREVIOUS-DATE "27-Sep-2021 10:25:31" {WMEDLEY}BOOTSTRAP.;59) -(* ; " -Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT BOOTSTRAPCOMS) @@ -19,7 +16,7 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation. (FNS GETPROP SETATOMVAL RPAQQ RPAQ RPAQ? MOVD MOVD? SELECTQ SELECTQ1 NCONC1 PUTPROP PROPNAMES ADDPROP REMPROP MEMB CLOSEF?)) (COMS (* ; - "Need these in order to load even compiled files SYSLOAD") + "Need these in order to load even compiled files SYSLOAD") (FNS LOAD \LOAD-STREAM FILECREATED FILECREATED1 PRETTYCOMPRINT BOOTSTRAP-NAMEFIELD PUTPROPS DECLARE%: DECLARE%:1 ROOTFILENAME)) [COMS (* ; "For DEFINE-FILE-INFO") @@ -714,66 +711,64 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation. (SET-READER-ENVIRONMENT (\DO-DEFINE-FILE-INFO NIL ARGS]) (\DO-DEFINE-FILE-INFO - [LAMBDA (STREAM ARGS) (* ; "Edited 17-Aug-2021 00:05 by rmk:") + [LAMBDA (STREAM ARGS) (* ; "Edited 23-Apr-2025 23:12 by rmk") + (* ; "Edited 17-Aug-2021 00:05 by rmk:") -(* ;;; "Processes the (DEFINE-FILE-INFO . ARGS) at the front of STREAM. This converts the ARGS list to a READER-ENVIRONMENT, and also imposes the external format on STREAM, if non-NIL.") +(* ;;; "Processes the (DEFINE-FILE-INFO . ARGS) at the front of STREAM. This converts the ARGS list to a READER-ENVIRONMENT, and also imposes the external format on STREAM, if non-NIL.") - (* ;; "Include the :PACKAGE... for bootstrapping before in sysouts without an updated version of \LOAD-STREAM") + (* ;; "Include the :PACKAGE... for bootstrapping before in sysouts without an updated version of \LOAD-STREAM") -(* ;;; "") +(* ;;; "") -(* ;;; "The LISTP forms for package and readtable are to allow for those to be created if they don't already exist. If they do exist, the forms should not make any incompatiblel changes--those should be in a file command somewhere.") +(* ;;; "The LISTP forms for package and readtable are to allow for those to be created if they don't already exist. If they do exist, the forms should not make any incompatiblel changes--those should be in a file command somewhere.") -(* ;;; "It doesn't make sense to produce an a new number base by evaluation in a particular runtime environment. I'm leaving this in for reading, for backward compatibility. Presumably future writing will instantiate to the particular number.") +(* ;;; "It doesn't make sense to produce an a new number base by evaluation in a particular runtime environment. I'm leaving this in for reading, for backward compatibility. Presumably future writing will instantiate to the particular number.") (LET (PACKAGE READTABLE BASE FORMAT VALUE PACKAGEFORM READTABLEFORM) [for TAIL on ARGS by (CDDR TAIL) do (SETQ VALUE (CADR TAIL)) - (SELECTQ (CAR TAIL) - ((:PACKAGE %:PACKAGE) - (SETQ PACKAGE (if (LISTP VALUE) - then (SETQ PACKAGEFORM VALUE) - (EVAL VALUE) - ELSE VALUE)) - (IF (TYPEP PACKAGE 'PACKAGE) - ELSEIF (SETQ PACKAGE (CL:FIND-PACKAGE PACKAGE)) - ELSE + (SELECTQ (CAR TAIL) + ((:PACKAGE %:PACKAGE) + (SETQ PACKAGE (if (LISTP VALUE) + then (SETQ PACKAGEFORM VALUE) + (EVAL VALUE) + ELSE VALUE)) + (IF (TYPEP PACKAGE 'PACKAGE) + ELSEIF (SETQ PACKAGE (CL:FIND-PACKAGE PACKAGE)) + ELSE + (* ;; "Better message than just \DTEST") - (* ;; "Better message than just \DTEST") + (ERROR "Can't find package for DEFINE-FILE-INFO reader environment" + VALUE))) + ((:READTABLE %:READTABLE) + (SETQ READTABLE (if (LISTP VALUE) + then (SETQ READTABLEFORM VALUE) + (EVAL VALUE) + ELSE VALUE)) + (IF (TYPEP READTABLE 'READTABLEP) + ELSEIF (SETQ READTABLE (FIND-READTABLE READTABLE)) + ELSE + (* ;; "Better message than just \DTEST") - (ERROR - "Can't find package for DEFINE-FILE-INFO reader environment" - VALUE))) - ((:READTABLE %:READTABLE) - (SETQ READTABLE (if (LISTP VALUE) - then (SETQ READTABLEFORM VALUE) - (EVAL VALUE) - ELSE VALUE)) - (IF (TYPEP READTABLE 'READTABLEP) - ELSEIF (SETQ READTABLE (FIND-READTABLE READTABLE)) - ELSE + (ERROR "Can't find read table for DEFINE-FILE-INFO reader environment" + VALUE))) + ((:BASE %:BASE) (* ; + "RMK: An EVAL form here makes no sense. ") + (SETQ BASE (OR (\CHECKRADIX (if (LISTP VALUE) + then (EVAL VALUE) + else VALUE)) + (ERROR "Bad read base for DEFINE-FILE-INFO reader environment" + VALUE)))) + ((:FORMAT FORMAT %:FORMAT) + (SETQ FORMAT (FETCH (EXTERNALFORMAT NAME) OF (FIND-FORMAT VALUE)))) + (ERROR "Unrecognized file info key" (CAR TAIL] - (* ;; "Better message than just \DTEST") + (* ;; "Set the defaults. Is this essentially ignoring the *DEFAULT-MAKEFILE-ENVIRONMENT*? Maybe the defaults should be take from there?") - (ERROR - "Can't find read table for DEFINE-FILE-INFO reader environment" - VALUE))) - ((:BASE %:BASE) (* ; - "RMK: An EVAL form here makes no sense. ") - (SETQ BASE (OR (\CHECKRADIX (if (LISTP VALUE) - then (EVAL VALUE) - else VALUE)) - (ERROR - "Bad read base for DEFINE-FILE-INFO reader environment" - VALUE)))) - ((:FORMAT FORMAT %:FORMAT) - (SETQ FORMAT (FETCH (EXTERNALFORMAT NAME) OF (FIND-FORMAT - VALUE)))) - (ERROR "Unrecognized file info key" (CAR TAIL] - - (* ;; "Set the defaults. Is this essentially ignoring the *DEFAULT-MAKEFILE-ENVIRONMENT*? Maybe the defaults should be take from there?") - - (CL:UNLESS FORMAT (SETQ FORMAT :XCCS)) + (CL:UNLESS FORMAT + (SETQ FORMAT (CL:IF (FIND-FORMAT :MCCS T) + :MCCS + :XCCS))) (CL:WHEN STREAM (\EXTERNALFORMAT STREAM FORMAT)) (create READER-ENVIRONMENT REPACKAGE _ (OR PACKAGE *INTERLISP-PACKAGE*) @@ -784,7 +779,8 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation. REREADTABLEFORM _ READTABLEFORM]) (PRINT-READER-ENVIRONMENT - [LAMBDA (ENV STREAM) (* ; "Edited 27-Sep-2021 10:24 by rmk:") + [LAMBDA (ENV STREAM) (* ; "Edited 23-Apr-2025 23:38 by rmk") + (* ; "Edited 27-Sep-2021 10:24 by rmk:") (* ;;; "If ENV is not the old default interlisp reader environment, writes a DEFINE-FILE-INFO expression on STREAM that will produce this environment when the file is loaded.") @@ -798,13 +794,14 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation. [SETQ RDTBL (IF (FETCH REREADTABLEFORM OF ENV) ELSEIF (fetch REREADTABLE of ENV) THEN (READTABLEPROP (fetch REREADTABLE of ENV) - 'NAME] + 'NAME] (PRINT [CONS 'DEFINE-FILE-INFO `(,@[AND PKG `(:PACKAGE ,PKG] ,@[AND RDTBL `(:READTABLE ,RDTBL] :BASE ,(fetch REBASE of ENV) - ,@(CL:UNLESS (EQ :XCCS (FETCH REFORMAT OF ENV)) + ,@(CL:UNLESS (EQMEMB (FETCH REFORMAT OF ENV) + '(:MCCS :XCCS)) `(:FORMAT ,(FETCH REFORMAT OF ENV)))] STREAM (FETCH (READER-ENVIRONMENT REREADTABLE) OF *DEFINE-FILE-INFO-ENV*)) @@ -953,8 +950,8 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation. (FUNCTION (LAMBDA (X) (OR (CCODEP (CDR X)) (MOVD (CAR X) - (CDR X) - NIL T] + (CDR X) + NIL T] (AND (CCODEP 'BOOTSTRAP-NAMEFIELD) (PUTD 'BOOTSTRAP-NAMEFIELD)) @@ -979,16 +976,14 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation. (ADDTOVAR LAMA ) ) -(PUTPROPS BOOTSTRAP COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 -1992 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4751 14423 (GETPROP 4761 . 5333) (SETATOMVAL 5335 . 5464) (RPAQQ 5466 . 5519) (RPAQ -5521 . 5833) (RPAQ? 5835 . 6205) (MOVD 6207 . 8071) (MOVD? 8073 . 8503) (SELECTQ 8505 . 8692) ( -SELECTQ1 8694 . 9036) (NCONC1 9038 . 9234) (PUTPROP 9236 . 10720) (PROPNAMES 10722 . 10913) (ADDPROP -10915 . 12978) (REMPROP 12980 . 13834) (MEMB 13836 . 14095) (CLOSEF? 14097 . 14421)) (14496 35060 ( -LOAD 14506 . 15675) (\LOAD-STREAM 15677 . 28751) (FILECREATED 28753 . 30171) (FILECREATED1 30173 . -31281) (PRETTYCOMPRINT 31283 . 31768) (BOOTSTRAP-NAMEFIELD 31770 . 32730) (PUTPROPS 32732 . 33100) ( -DECLARE%: 33102 . 33234) (DECLARE%:1 33236 . 34108) (ROOTFILENAME 34110 . 35058)) (35098 45530 ( -DEFINE-FILE-INFO 35108 . 35543) (\DO-DEFINE-FILE-INFO 35545 . 39891) (PRINT-READER-ENVIRONMENT 39893 - . 41475) (READ-READER-ENVIRONMENT 41477 . 44252) (MAKE-DEFINE-FILE-INFO-ENV 44254 . 45528))))) + (FILEMAP (NIL (4617 14289 (GETPROP 4627 . 5199) (SETATOMVAL 5201 . 5330) (RPAQQ 5332 . 5385) (RPAQ +5387 . 5699) (RPAQ? 5701 . 6071) (MOVD 6073 . 7937) (MOVD? 7939 . 8369) (SELECTQ 8371 . 8558) ( +SELECTQ1 8560 . 8902) (NCONC1 8904 . 9100) (PUTPROP 9102 . 10586) (PROPNAMES 10588 . 10779) (ADDPROP +10781 . 12844) (REMPROP 12846 . 13700) (MEMB 13702 . 13961) (CLOSEF? 13963 . 14287)) (14362 34926 ( +LOAD 14372 . 15541) (\LOAD-STREAM 15543 . 28617) (FILECREATED 28619 . 30037) (FILECREATED1 30039 . +31147) (PRETTYCOMPRINT 31149 . 31634) (BOOTSTRAP-NAMEFIELD 31636 . 32596) (PUTPROPS 32598 . 32966) ( +DECLARE%: 32968 . 33100) (DECLARE%:1 33102 . 33974) (ROOTFILENAME 33976 . 34924)) (34964 45363 ( +DEFINE-FILE-INFO 34974 . 35409) (\DO-DEFINE-FILE-INFO 35411 . 39554) (PRINT-READER-ENVIRONMENT 39556 + . 41308) (READ-READER-ENVIRONMENT 41310 . 44085) (MAKE-DEFINE-FILE-INFO-ENV 44087 . 45361))))) STOP diff --git a/sources/BOOTSTRAP.LCOM b/sources/BOOTSTRAP.LCOM index a431b0c730486e8a08286a079d2fa4b64677958e..ea5f87950da76400b8009cd26cd2eed938ed76c6 100644 GIT binary patch delta 1843 zcmah}&2QXP5RcQeN;gv2q-oU{lukFa*(`GKv!6d{qj>GN$r7*a+TLs;_E6MBZA40< zv>Z@{R!E#UK`s6OZhTw{%aIEw#1S|l!GU8D5;-7F9GGWs=mt>n#c$@#n~&ejZ@xVI z{ouW|Ua8t>`pk`)lQIt~iYhq=hms;I8YrqwEt?n>s8(+6-#ysf+u4Tw*P#LrIxXh; zZ0oIS_x9g7ytQ+0xgLgTlEzN7^pZ{%p>)!bVr#0c(F)w>e)bl&VHe#r+P>ezC{H3T zEiF}G`_=mx=f517mBpv0t75wH|E34jpu_;1dChcIs&B#J-Pgc&*PLLLB~ltfwbTfb z_kR<+T`!b8)@TMy;wVYYpb;*D9mQ;;8MYJ2L(ni&LrQiIIA#QhY%7|rk_wcb3X*2^ z-yGeV$UZL5$q<2JLDIDCTHq%vz0vTU)f(5DP>bTwWz3UYCt*phG%}bx-(R2nTDVSt zrxmTQHvCm+fU2Oqw6Bz2kM3J1=+q&T{{8c}@@-+4%Ie zQ&VGNe|`F0Vd2@rY)#zV&+P+o>eO6l=02uxbJfuoW1*h?dG2wK0*m7?Mo5VXt1Qh+ zO=GYu1#nzFuuS!YUYAdZ)PmFv0~aiM@&dt*;%1P7MF{v#6r(Gd48Juk0=;7lz|_wUB4*y5SSbX48V7qK~&&fVL4Vlj<6vc|Ip|N(McN}^Dp`_po~ti z8(RtY%;A-v2%3rD9p7lWl1tnhXgDefb{Z(vpuqD6P(F36k=A3RDoc@0W`BHE5JnX% zn-DJxv@eODo)LQeAK-#8(-(7E?3Oq=KFH7SWJi}@dCoAQ%QjOM2aez10HnAtc;$g7 zWu3~~RfL!)8+&Qp2Nf}`;mos`Gg!4| delta 1887 zcmbtVOKcle6wTyQTDKKWo3@DyfnS zf`AAawn&u_vxOxq*dTXV30M}`vS$mcE>PFpH{-NP#0FuF@4Wl&d-rqhXZ}8X*7|b! zTCQBNh~W`EAZGLpGup{zx0;U+_x8hWXdXZoQYWUr^69-=J8ZQ}A2bg48wVw;xz*S& zJr1|`!;gi6RNC1)$|qc@-8^n>h3(R!;{<-->2Bd&nVp3!FXjF4Fwe6*2Rv64czjU# z`>pVmxvkyC!OmdVo+?J~F`4MM{3zK&56U&mg0t5Pg+dm#8%N=G>REurd$- ze-I!lvZg}pW!Q$J=2Q`KW!r~nVv>4$r#=gZt?9wTfj{b+@-6NAtN!ML^XTyugbp=%(qr#IkyaHLxnaTVJmD0V)<*3%^7_KMwQjF3bm!CWFwAmf58r#knR|YDc<65T$?zA<%v;IP2bsNQ ze8@7%u?^6~^8&=m^(uA%8Yh9JyB?}yrL%WcO@huT4xq|1U{X%)tCG}HtcnV_wOD}Q zg35BRX*s%?#~vbjRcBe22St+4s#bUb=22VVxR_&5@J^Lf7eQ84sJSL~G_`~3Iv^`p z60hybGJn>ZEV49J^fbskdRW!{Wy%>&)d!gqVAH1I^B^H$u?Cjk(CaQ1oPtcU7Bs1=-Yzg>Qe6BA<_Z*T+8BtX zqD7rMnGOOIR!EGMg=MU8+=U$(Av%9XM*ow1^!i5TFdG{_)r|16;%i3I z5WG`~q~NSXj%ou5OU1`bgD7f{;JFGStvXT;7Cr1&5@3XU_rWN`^b0~%9h<3?Ekq~53=Y37CI7<5{VL-5`_|#5)FyQLJBDl^y@Y|o3blb>L2(v B=OO?A diff --git a/sources/EXTERNALFORMAT b/sources/EXTERNALFORMAT index 4efd98db..1b188919 100644 --- a/sources/EXTERNALFORMAT +++ b/sources/EXTERNALFORMAT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Mar-2024 18:24:39" {WMEDLEY}EXTERNALFORMAT.;88 38921 +(FILECREATED "24-Apr-2025 08:43:01" {WMEDLEY}EXTERNALFORMAT.;91 38905 :EDIT-BY rmk - :CHANGES-TO (FNS \FORMATBYTESTRING \FORMATBYTESTREAM) + :CHANGES-TO (VARS EXTERNALFORMATCOMS) - :PREVIOUS-DATE "12-Jan-2024 10:59:18" {WMEDLEY}EXTERNALFORMAT.;86) + :PREVIOUS-DATE "19-Mar-2024 18:24:39" {WMEDLEY}EXTERNALFORMAT.;90) (PRETTYCOMPRINT EXTERNALFORMATCOMS) @@ -22,7 +22,7 @@ (FNS SYSTEM-EXTERNALFORMAT) (GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*) (INITVARS (*EXTERNALFORMATS* NIL) - (*DEFAULT-EXTERNALFORMAT* :XCCS)) + (*DEFAULT-EXTERNALFORMAT* :MCCS)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (DEFPRINT 'EXTERNALFORMAT (FUNCTION \EXTERNALFORMAT.DEFPRINT ] @@ -311,7 +311,7 @@ (RPAQ? *EXTERNALFORMATS* NIL) -(RPAQ? *DEFAULT-EXTERNALFORMAT* :XCCS) +(RPAQ? *DEFAULT-EXTERNALFORMAT* :MCCS) (DECLARE%: DONTEVAL@LOAD DOCOPY (DEFPRINT 'EXTERNALFORMAT (FUNCTION \EXTERNALFORMAT.DEFPRINT)) @@ -737,13 +737,13 @@ (\CREATE.THROUGH.EXTERNALFORMAT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6726 13559 (\EXTERNALFORMAT 6736 . 10514) (MAKE-EXTERNALFORMAT 10516 . 13086) ( -\EXTERNALFORMAT.DEFPRINT 13088 . 13557)) (13560 16601 (\INSTALL.EXTERNALFORMAT 13570 . 15019) ( -\REMOVE.EXTERNALFORMAT 15021 . 15852) (FIND-FORMAT 15854 . 16599)) (16602 17014 (SYSTEM-EXTERNALFORMAT - 16612 . 17012)) (17363 33340 (\OUTCHAR 17373 . 18590) (\INCCODE 18592 . 19745) (\BACKCCODE 19747 . -21426) (\BACKCCODE.EOLC 21428 . 23618) (\PEEKCCODE 23620 . 23945) (\PEEKCCODE.EOLC 23947 . 24326) ( -\INCCODE.EOLC 24328 . 26127) (\FORMATBYTESTREAM 26129 . 28573) (\FORMATBYTESTRING 28575 . 30275) ( -\CHECKEOLC.CRLF 30277 . 33338)) (34622 36858 (\NULLDEVICE 34632 . 36534) (\NULL.OPENFILE 36536 . 36856 -)) (36998 38825 (\CREATE.THROUGH.EXTERNALFORMAT 37008 . 37794) (\THROUGHIN 37796 . 38216) ( -\THROUGHBACKCCODE 38218 . 38485) (\THROUGHOUTCHARFN 38487 . 38823))))) + (FILEMAP (NIL (6710 13543 (\EXTERNALFORMAT 6720 . 10498) (MAKE-EXTERNALFORMAT 10500 . 13070) ( +\EXTERNALFORMAT.DEFPRINT 13072 . 13541)) (13544 16585 (\INSTALL.EXTERNALFORMAT 13554 . 15003) ( +\REMOVE.EXTERNALFORMAT 15005 . 15836) (FIND-FORMAT 15838 . 16583)) (16586 16998 (SYSTEM-EXTERNALFORMAT + 16596 . 16996)) (17347 33324 (\OUTCHAR 17357 . 18574) (\INCCODE 18576 . 19729) (\BACKCCODE 19731 . +21410) (\BACKCCODE.EOLC 21412 . 23602) (\PEEKCCODE 23604 . 23929) (\PEEKCCODE.EOLC 23931 . 24310) ( +\INCCODE.EOLC 24312 . 26111) (\FORMATBYTESTREAM 26113 . 28557) (\FORMATBYTESTRING 28559 . 30259) ( +\CHECKEOLC.CRLF 30261 . 33322)) (34606 36842 (\NULLDEVICE 34616 . 36518) (\NULL.OPENFILE 36520 . 36840 +)) (36982 38809 (\CREATE.THROUGH.EXTERNALFORMAT 36992 . 37778) (\THROUGHIN 37780 . 38200) ( +\THROUGHBACKCCODE 38202 . 38469) (\THROUGHOUTCHARFN 38471 . 38807))))) STOP diff --git a/sources/FILESETS b/sources/FILESETS index ca9d7604..0cc75efb 100644 --- a/sources/FILESETS +++ b/sources/FILESETS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-Aug-2025 16:22:29" {MEDLEY}FILESETS.;2 6206 +(FILECREATED " 7-Aug-2025 10:11:01" {WMEDLEY}FILESETS.;24 6210 :EDIT-BY rmk :CHANGES-TO (VARS 0LISPSET) - :PREVIOUS-DATE "17-Jul-2025 12:07:14" {MEDLEY}FILESETS.;1) + :PREVIOUS-DATE "10-Jun-2025 18:00:09" {WMEDLEY}FILESETS.;23) (PRETTYCOMPRINT FILESETSCOMS) @@ -50,7 +50,7 @@ (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 IOCHAR XCCS LLCHAR LLSTK + CMLSEQBASICS LLARITH LLFLOAT LLBIGNUM LLREAD IOCHAR MCCS LLCHAR LLSTK LLDATATYPE LLKEY LLTIMER)) (RPAQQ 1LISPSET @@ -68,7 +68,7 @@ (IOCHAR MODARITH LLPARAMS LLCODE AERROR AOFD APRINT ATERM LLARRAYELT LLDATATYPE LLNEW LLBASIC LLCHAR LLSTK PMAP LLGC ATBL FILEIO EXTERNALFORMAT LLARITH LLFLOAT FONT LLKEY LLDISPLAY ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER - IMAGEIO PROC XCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS + IMAGEIO PROC MCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS DTDECLARE)) (RPAQQ MAKEINITFILES (MAKEINIT MEM I-NEW)) diff --git a/sources/LLKEY b/sources/LLKEY index ad5216cf..032f719b 100644 --- a/sources/LLKEY +++ b/sources/LLKEY @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 4-Apr-2025 17:10:10" {WMEDLEY}LLKEY.;11 199518 +(FILECREATED " 5-May-2025 20:57:08" {WMEDLEY}LLKEY.;15 199508 :EDIT-BY rmk - :CHANGES-TO (VARS LLKEYCOMS) - (FNS \DECODETRANSITION) + :CHANGES-TO (VARS \MAIKOKEYACTIONS \KEYNAMES) - :PREVIOUS-DATE "13-Feb-2025 08:22:19" {WMEDLEY}LLKEY.;8) + :PREVIOUS-DATE " 4-Apr-2025 17:10:10" {WMEDLEY}LLKEY.;11) (PRETTYCOMPRINT LLKEYCOMS) @@ -1522,7 +1521,7 @@ (UTIL0 SUN-KEYPAD=) (UTIL1 SUN-KEYPAD/) (UTIL2 SUPER/SUB) - (UTIL3 CASE) + (UTIL3 CASE SUN-F4) (UTIL4 STRIKEOUT) (UTIL5 KEYPAD2 DOWNARROW) (UTIL6 KEYPAD3 PGDN) @@ -1556,7 +1555,7 @@ (K52 KEYPAD0 INS) (BOLD) (ITALICS) - (UNDERLINE) + (UNDERLINE SUN-F6) (SUPERSCRIPT) (SUBSCRIPT) (LARGER SMALLER) @@ -1766,9 +1765,9 @@ (97 ("Function,A" "Function,a" NOLOCKSHIFT)) (99 ("Function,B" "Function,b" NOLOCKSHIFT)) (100 ("Function,C" "Function,c" NOLOCKSHIFT)) - (67 ("Function,D" "Function,d" NOLOCKSHIFT)) + (67 ("0,244" "0,244")) (68 ("Function,E" "Function,e" NOLOCKSHIFT)) - (101 ("Function,F" "Function,f" NOLOCKSHIFT)) + (101 ("0,255" "0,255" NOLOCKSHIFT)) (66 ("Function,G" "Function,g" NOLOCKSHIFT)) (104 ("Function,H" "Function,h" NOLOCKSHIFT)) (80 ("Function,I" "Function,i" NOLOCKSHIFT)) @@ -1784,7 +1783,8 @@ (14 METADOWN . METAUP) (71 ("LF" "LF" NOLOCKSHIFT)) (47 ("Function,^R" "Function,62" NOLOCKSHIFT)) - (105 ("\" "|" NOLOCKSHIFT)))) + (105 ("\" "|" NOLOCKSHIFT)) + (106 ("0,254" "0,254")))) (RPAQQ \MAIKOKEYACTIONST4 ((61 ("^E" "Bell" NOLOCKSHIFT)) @@ -3916,33 +3916,33 @@ (ADDTOVAR LAMA CURSORPROP METASHIFT MOUSECHORDWAIT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (14626 21942 (BKSYSCHARCODE 14636 . 14985) (\CLEARSYSBUF 14987 . 15545) (\GETKEY 15547 - . 16722) (\NSYSBUFCHARS 16724 . 17466) (\SAVESYSBUF 17468 . 19077) (\SYSBUFP 19079 . 19383) ( -\GETSYSBUF 19385 . 19565) (\PUTSYSBUF 19567 . 20780) (\PEEKSYSBUF 20782 . 21940)) (23227 60785 ( -\KEYBOARDINIT 23237 . 24957) (\KEYBOARDEVENTFN 24959 . 29659) (\ALLOCLOCKED 29661 . 30251) ( -\SETIOPOINTERS 30253 . 34789) (\KEYBOARDOFF 34791 . 35205) (\KEYBOARDON 35207 . 35586) (\KEYHANDLER -35588 . 35719) (\KEYHANDLER1 35721 . 43167) (\RESETKEYBOARD 43169 . 44817) (\DOMOUSECHORDING 44819 . -48639) (\DOTRANSITIONS 48641 . 49318) (\DECODETRANSITION 49320 . 56733) (MOUSECHORDWAIT 56735 . 57399) - (\TRACKCURSOR 57401 . 60783)) (95237 117110 (KEYACTION 95247 . 96100) (KEYACTIONTABLE 96102 . 97284) -(KEYBOARDTYPE 97286 . 98388) (RESETKEYACTION 98390 . 100149) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS -100151 . 102053) (\KEYACTION1 102055 . 112171) (KEYDOWNP 112173 . 112508) (KEYNUMBERP 112510 . 112708) - (\KEYNAMETONUMBER 112710 . 113404) (\KEYNUMBERTONAME 113406 . 113596) (MODIFY.KEYACTIONS 113598 . -114459) (METASHIFT 114461 . 115405) (SHIFTDOWNP 115407 . 117108)) (117173 117469 ( -SETUP.OFFICE.KEYBOARD 117183 . 117467)) (120448 122160 (\INIT.KEYBOARD.STREAM 120458 . 122158)) ( -122425 138802 (\DOBUFFEREDTRANSITIONS 122435 . 137865) (\TIMER.INTERRUPTFRAME 137867 . 138592) ( -\PERIODIC.INTERRUPTFRAME 138594 . 138800)) (139056 143133 (\HARDCURSORUP 139066 . 140948) ( -\HARDCURSORPOSITION 140950 . 142986) (\HARDCURSORDOWN 142988 . 143131)) (143134 167194 (CURSOR.INIT -143144 . 146844) (\CURSORDESTINATION 146846 . 149164) (\SOFTCURSORUP 149166 . 154420) ( -\SOFTCURSORUPCURRENT 154422 . 161458) (\SOFTCURSORPOSITION 161460 . 162225) (\SOFTCURSORDOWN 162227 . -162935) (CURSORPROP 162937 . 163279) (GETCURSORPROP 163281 . 163469) (PUTCURSORPROP 163471 . 164626) ( -\CURSORBITSPERPIXEL 164628 . 166744) (\CURSORIMAGEPROPNAME 166746 . 166970) (\CURSORMASKPROPNAME -166972 . 167192)) (167195 185145 (CURSORCREATE 167205 . 169880) (CURSOR 169882 . 171694) ( -\CURSOR-VALID-P 171696 . 172783) (\CURSORUP 172785 . 174500) (\CURSORPOSITION 174502 . 177030) ( -\CURSORDOWN 177032 . 177265) (ADJUSTCURSORPOSITION 177267 . 177845) (CURSORPOSITION 177847 . 179389) ( -CURSORSCREEN 179391 . 180047) (CURSOREXIT 180049 . 181440) (FLIPCURSOR 181442 . 182568) (FLIPCURSORBAR - 182570 . 183550) (LASTMOUSEX 183552 . 183806) (LASTMOUSEY 183808 . 184062) (CREATEPOSITION 184064 . -184270) (POSITIONP 184272 . 184556) (CURSORHOTSPOT 184558 . 185143)) (186383 187931 (GETMOUSESTATE -186393 . 187052) (\EVENTKEYS 187054 . 187929)) (194130 194926 (MACHINETYPE 194140 . 194540) ( -SETMAINTPANEL 194542 . 194924)) (194956 196095 (BEEPON 194966 . 195619) (BEEPOFF 195621 . 196093)) ( -196546 196809 (WITHOUT-INTERRUPTS 196556 . 196807))))) + (FILEMAP (NIL (14602 21918 (BKSYSCHARCODE 14612 . 14961) (\CLEARSYSBUF 14963 . 15521) (\GETKEY 15523 + . 16698) (\NSYSBUFCHARS 16700 . 17442) (\SAVESYSBUF 17444 . 19053) (\SYSBUFP 19055 . 19359) ( +\GETSYSBUF 19361 . 19541) (\PUTSYSBUF 19543 . 20756) (\PEEKSYSBUF 20758 . 21916)) (23203 60761 ( +\KEYBOARDINIT 23213 . 24933) (\KEYBOARDEVENTFN 24935 . 29635) (\ALLOCLOCKED 29637 . 30227) ( +\SETIOPOINTERS 30229 . 34765) (\KEYBOARDOFF 34767 . 35181) (\KEYBOARDON 35183 . 35562) (\KEYHANDLER +35564 . 35695) (\KEYHANDLER1 35697 . 43143) (\RESETKEYBOARD 43145 . 44793) (\DOMOUSECHORDING 44795 . +48615) (\DOTRANSITIONS 48617 . 49294) (\DECODETRANSITION 49296 . 56709) (MOUSECHORDWAIT 56711 . 57375) + (\TRACKCURSOR 57377 . 60759)) (95227 117100 (KEYACTION 95237 . 96090) (KEYACTIONTABLE 96092 . 97274) +(KEYBOARDTYPE 97276 . 98378) (RESETKEYACTION 98380 . 100139) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS +100141 . 102043) (\KEYACTION1 102045 . 112161) (KEYDOWNP 112163 . 112498) (KEYNUMBERP 112500 . 112698) + (\KEYNAMETONUMBER 112700 . 113394) (\KEYNUMBERTONAME 113396 . 113586) (MODIFY.KEYACTIONS 113588 . +114449) (METASHIFT 114451 . 115395) (SHIFTDOWNP 115397 . 117098)) (117163 117459 ( +SETUP.OFFICE.KEYBOARD 117173 . 117457)) (120438 122150 (\INIT.KEYBOARD.STREAM 120448 . 122148)) ( +122415 138792 (\DOBUFFEREDTRANSITIONS 122425 . 137855) (\TIMER.INTERRUPTFRAME 137857 . 138582) ( +\PERIODIC.INTERRUPTFRAME 138584 . 138790)) (139046 143123 (\HARDCURSORUP 139056 . 140938) ( +\HARDCURSORPOSITION 140940 . 142976) (\HARDCURSORDOWN 142978 . 143121)) (143124 167184 (CURSOR.INIT +143134 . 146834) (\CURSORDESTINATION 146836 . 149154) (\SOFTCURSORUP 149156 . 154410) ( +\SOFTCURSORUPCURRENT 154412 . 161448) (\SOFTCURSORPOSITION 161450 . 162215) (\SOFTCURSORDOWN 162217 . +162925) (CURSORPROP 162927 . 163269) (GETCURSORPROP 163271 . 163459) (PUTCURSORPROP 163461 . 164616) ( +\CURSORBITSPERPIXEL 164618 . 166734) (\CURSORIMAGEPROPNAME 166736 . 166960) (\CURSORMASKPROPNAME +166962 . 167182)) (167185 185135 (CURSORCREATE 167195 . 169870) (CURSOR 169872 . 171684) ( +\CURSOR-VALID-P 171686 . 172773) (\CURSORUP 172775 . 174490) (\CURSORPOSITION 174492 . 177020) ( +\CURSORDOWN 177022 . 177255) (ADJUSTCURSORPOSITION 177257 . 177835) (CURSORPOSITION 177837 . 179379) ( +CURSORSCREEN 179381 . 180037) (CURSOREXIT 180039 . 181430) (FLIPCURSOR 181432 . 182558) (FLIPCURSORBAR + 182560 . 183540) (LASTMOUSEX 183542 . 183796) (LASTMOUSEY 183798 . 184052) (CREATEPOSITION 184054 . +184260) (POSITIONP 184262 . 184546) (CURSORHOTSPOT 184548 . 185133)) (186373 187921 (GETMOUSESTATE +186383 . 187042) (\EVENTKEYS 187044 . 187919)) (194120 194916 (MACHINETYPE 194130 . 194530) ( +SETMAINTPANEL 194532 . 194914)) (194946 196085 (BEEPON 194956 . 195609) (BEEPOFF 195611 . 196083)) ( +196536 196799 (WITHOUT-INTERRUPTS 196546 . 196797))))) STOP diff --git a/sources/LLKEY.LCOM b/sources/LLKEY.LCOM index 0fc5012ce4d61e3a031aab473c0fe3da6decfd3d..aba3cfe8d386dc1fbab732dd63b15a700e970837 100644 GIT binary patch delta 546 zcmZurziSgw94C-c`%q(O!K%@FeNecRT)15BMRSWh?q1q!?pN6(@?XU9EHM&}@61=hg=K01*f2~2vNN(81 zZefB)Exs#_Q(S8{sR~Yx%&oc1Zu@PXFf+D&FT!gAd(7og85=>!muID;ZQJC%g`elQO||4ip=x(NLmm@s$n d5ME!532Ely?o>@}V0qYnwMcc+O^&A?{Rdh~pjH3? delta 468 zcmaFc#`3m}WkQ6oiLPTok*<+}k*R{Axs{;-5KYY1ku=m);8IdRmNd08Ft9Q*nYcm2 z8cA4BPftl9C9xzm1*>{vLnTcv4L468SLYyC#}HSS$uk&@*%S;dElmw4`!Fi;`uKRe zMmqcZ25Ty4xJ_QTOhipn!73ogHO$jLG+5UKs6|1^&{)?kH3{NI0}Cr7BP&D8$?F)U z87(%SW}JO=a_(_yPM|3PjxI(DT$3jr59Rl9bqn$JbaC-<1&Ra3z8;U@4G#6w4R8z% zb_LqRH96`;2){4T3fD+iA0Pj4u-M)cL4qKijzK|S5pNSypk9TOUX!y=N-}ayZaL{X z`P4~iAnWN#4H=-8;LrfqpkU`9&wvmx&k4q!Ykaplan>Local>medley3.5>working-medley>sources>MCCS.;137 51129 + + :EDIT-BY rmk + + :CHANGES-TO (FNS \MCCS.24BITENCODING.ERROR \MCCSINCCODE \MCCSPEEKCCODE) + + :PREVIOUS-DATE " 7-Sep-2025 22:43:03" +{DSK}kaplan>Local>medley3.5>working-medley>sources>MCCS.;136) + + +(PRETTYCOMPRINT MCCSCOMS) + +(RPAQQ MCCSCOMS + [ + (* ;; "Stringlet number encoding common to MCCS and XCCS") + + (FNS \MCCSINCCODE \MCCSPEEKCCODE \MCCSOUTCHAR \MCCSBACKCCODE \MCCSFORMATBYTESTREAM + \MCCSCHARSETFN) + (FNS \CREATE.MCCS.EXTERNALFORMAT) + (FNS \MCCS.24BITENCODING.ERROR) + (INITVARS (*SIGNAL-MCCS.24BITENCODING.ERROR*)) + (DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS (\NORUNCODE 255) + (NSCHARSETSHIFT 255)) + (MACROS \RUNCODED))) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.MCCS.EXTERNALFORMAT :MCCS) + (\CREATE.MCCS.EXTERNALFORMAT :XCCS))) + + (* ;; "") + + + (* ;; "Assignment of MCCS characters") + + (ALISTS (CHARACTERNAMES Lowline Circumflex Currency Leftarrow Uparrow Dollar Underline)) + + (* ;; "Mapping between true XCCS and MCCS codes") + + (FNS MTOXCODE XTOMCODE XTOMSTRING MTOXSTRING) + (FNS MTOX$CODE X$TOMCODE) + (FNS KANJICHARSETP CHINESECHARSETP) + (COMS (* ; " Mapping functions to MCCS") + + (* ;; "Used by \TEDIT.MCCS.TRANSLATE .") + + (VARS ALTOTEXT2MCCS SYMBOLTOMCCS SIGMATOMCCS HIPPOTOMCCS CYRILLICTOMCCS MATHTOMCCS) + (FNS MCCSCODEMAPARRAY) + (GLOBALVARS ALTOTOMCCSARRAY SYMBOLTOMCCSARRAY HIPPOTOMCCSARRAY CYRILLICTOMCCSARRAY + MATHTOMCCSARRAY SIGMATOMCCSARRAY) + (INITVARS (ALTOTOMCCSARRAY (MCCSCODEMAPARRAY 'MCCS)) + (SYMBOLTOMCCSARRAY (MCCSCODEMAPARRAY SYMBOLTOMCCS)) + (HIPPOTOMCCSARRAY (MCCSCODEMAPARRAY HIPPOTOMCCS)) + (CYRILLICTOMCCSARRAY (MCCSCODEMAPARRAY CYRILLICTOMCCS)) + (MATHTOMCCSARRAY (MCCSCODEMAPARRAY MATHTOMCCS)) + (SIGMATOMCCSARRAY (MCCSCODEMAPARRAY SIGMATOMCCS))) + (FNS MCCSMAPFN MCCSMAPPAIRS XCCSUNDEFINEDPAIRS) + (COMS (* ; + "Mappings into MCCS: needed for hardcopy and Tedit coercion") + (FNS GACHATOMCODE SYMBOLTOMCODE SIGMATOMCODE ATOMCODE MATHTOMCODE HIPPOTOMCODE + CYRILLICTOMCODE]) + + + +(* ;; "Stringlet number encoding common to MCCS and XCCS") + +(DEFINEQ + +(\MCCSINCCODE + [LAMBDA (STREAM COUNTP) (* ; "Edited 9-Sep-2025 22:42 by rmk") + (* ; "Edited 8-Dec-2023 15:28 by rmk") + (* ; "Edited 6-Aug-2021 15:57 by rmk:") + +(* ;;; "Returns a 16 bit character code. SHIFTEDCSET is STREAM's char set left shifted 8.") + +(* ;;; "If COUNTP is non-NIL, the variable *BYTECOUNTER* is set freely to the number of bytes read.") + +(* ;;; "This doesn't do EOL conversion, \INCHAR does that") + + (DECLARE (USEDFREE *BYTECOUNTER*)) + (\DTEST STREAM 'STREAM) + (LET (NUMBYTES (CSET (ffetch (STREAM CHARSET) of STREAM)) + (CHAR (\BIN STREAM))) (* ; + "Error on EOF unless ENDOFSTREAMOP does something else.") + + (* ;; " NUMBYTES tracks the number of \BINs. ") + + (IF (EQ CHAR NSCHARSETSHIFT) + THEN (* ; + "Shifting character sets, toss CHAR") + (SETQ CSET (\BIN STREAM)) + (IF (NEQ NSCHARSETSHIFT CSET) + THEN (* ; + "Shift to new runcode CSET: SH CS CH") + (SETQ CHAR (\BIN STREAM)) + (SETQ NUMBYTES 3) + (freplace (STREAM CHARSET) of STREAM with CSET) + ELSEIF (EQ 0 (\BIN STREAM)) + THEN (* ; "SH SH CSH CS CH where CSH is 0") + + (* ;; + "The high-order character set byte must be 0, because we don't support obese characters (24 bit)") + + (SETQ CSET (\BIN STREAM)) + (SETQ CHAR (\BIN STREAM)) (* ; "To align with below") + (SETQ NUMBYTES 5) + (freplace (STREAM CHARSET) of STREAM with \NORUNCODE) + ELSE (\MCCS.24BITENCODING.ERROR STREAM)) + + (* ;; "The stream now knows the new character set, runcoded or not.") + + ELSEIF (EQ CSET \NORUNCODE) + THEN (* ; "2-bytes") + (SETQ CSET CHAR) + (SETQ CHAR (\BIN STREAM)) + (SETQ NUMBYTES 2) + ELSE + (* ;; "Runcoded CSET and CHAR") + + (SETQ NUMBYTES 1)) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* NUMBYTES)) + (CL:WHEN CHAR (* ; + "Typically NIL if ENDOFSTREAMOP returned NIL at EOF ") + (LOGOR (UNFOLD CSET 256) + CHAR))]) + +(\MCCSPEEKCCODE + [LAMBDA (STREAM NOERROR) (* ; "Edited 9-Sep-2025 22:43 by rmk") + (* ; "Edited 23-Apr-2025 14:16 by rmk") + (* ; "Edited 8-Dec-2023 15:32 by rmk") + (* ; "Edited 21-Jun-2021 23:44 by rmk:") + + (* ;; + "Modeled on \MCCSINCCODE, but peeks at the last byte in the sequence, leaves the stream unchanged") + + (\DTEST STREAM 'STREAM) + (LET ((CSET (ffetch (STREAM CHARSET) of STREAM)) + (CHAR (\PEEKBIN STREAM NOERROR))) + + (* ;; "Returns a 16 bit character code. Doesn't do EOL conversion--\PEEKCCODE does that. ") + + (* ;; "We don't change the charset in the stream, put the file ptr back the way it was.") + + (CL:WHEN CHAR + (IF (EQ CHAR NSCHARSETSHIFT) + THEN (\BIN STREAM) (* ; "Read the peeked shifting byte") + (SETQ CSET (\BIN STREAM)) (* ; "Consume the char shift byte") + (IF (NEQ CSET NSCHARSETSHIFT) + THEN + (* ;; + "Shift to new runcode CSET: SH CS CH. We have to BIN what we peeked, BIN, and peek again") + + (SETQ CHAR (\PEEKBIN STREAM NOERROR)) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + ELSEIF (EQ 0 (\BIN STREAM)) + THEN (* ; "SH SH CSH CS CH where CSH is 0") + + (* ;; + "Note: no eof error check on this \BIN -- an eof in the middle of a charset shift is an error") + + (SETQ CSET (\BIN STREAM)) + (SETQ CHAR (\PEEKBIN STREAM NOERROR)) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + ELSE (\MCCS.24BITENCODING.ERROR STREAM)) + ELSEIF (EQ CSET \NORUNCODE) + THEN (* ; "2 byte runs, BIN/PEEK/BACK") + (SETQ CSET CHAR) + (\BIN STREAM) + (SETQ CHAR (\PEEKBIN STREAM NOERROR)) (* ; "One BACKFILEPTR seems OK") + (\BACKFILEPTR STREAM)) + + (* ;; "No need to back up for the runcoded case") + + (CL:WHEN CHAR + (LOGOR (UNFOLD CSET 256) + CHAR)))]) + +(\MCCSOUTCHAR + [LAMBDA (STREAM CHARCODE) (* ; "Edited 23-Apr-2025 14:16 by rmk") + (* ; "Edited 13-Aug-2021 10:24 by rmk:") + + (* ;; "Closed function for the :MCCS external format") + + (COND + ((EQ CHARCODE (CHARCODE EOL)) + (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) + [COND + [(NOT (\RUNCODED STREAM)) (* ; + "Charset is a constant 0, we put out the high-order byte.") + (\BOUT STREAM (\CHARSET (CHARCODE EOL] + ((EQ (\CHARSET (CHARCODE EOL)) + (ffetch (STREAM CHARSET) of STREAM))) + (T (* ; + "We are runcoded, and not in character set 0, have to shift.") + (\BOUT STREAM NSCHARSETSHIFT) + (\BOUT STREAM (freplace (STREAM CHARSET) of STREAM with (\CHARSET (CHARCODE EOL] + + (* ;; "We are now in the right charset (0) for the first EOL byte. For CRLF, the CR is immediately followed by the LF byte, without the prefix 0 byte even if not runcoded, i.e. the 2 bytes are though of as a composite. The stream is left in CSET0 (the freplace above), read for another shift according to the next shift in a runcoded file.") + + (\BOUTEOL STREAM)) + (T (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) + (IPLUS16 1 DATUM)) + (COND + ((NOT (\RUNCODED STREAM)) + (\BOUT STREAM (\CHARSET CHARCODE)) + (\BOUT STREAM (\CHAR8CODE CHARCODE))) + ((EQ (\CHARSET CHARCODE) + (ffetch (STREAM CHARSET) of STREAM)) + (\BOUT STREAM (\CHAR8CODE CHARCODE))) + (T (\BOUT STREAM NSCHARSETSHIFT) + (\BOUT STREAM (freplace (STREAM CHARSET) of STREAM with (\CHARSET CHARCODE))) + (\BOUT STREAM (\CHAR8CODE CHARCODE]) + +(\MCCSBACKCCODE + [LAMBDA (STREAM COUNTP) (* ; "Edited 8-Dec-2023 15:34 by rmk") + (* ; "Edited 19-Jul-2022 17:12 by rmk") + (* ; "Edited 13-Aug-2021 14:08 by rmk:") + (DECLARE (USEDFREE *BYTECOUNTER*)) + (LET ((BYTE (AND (\BACKFILEPTR STREAM) + (\PEEKBIN STREAM))) + (CSET (fetch (STREAM CHARSET) of STREAM))) + (CL:WHEN BYTE + + (* ;; "The immediately preceding byte must be a character byte. If it is a byte in a runcode, then we are done, even if the byte before is part of a shift sequence.") + + (* ;; "But if we are currently in a nonruncoded file, we have to go back one more to get the character set byte.") + + (* ;; "If we can't back up, we are already at the beginning.") + + (IF (EQ \NORUNCODE CSET) + THEN (IF (\BACKFILEPTR STREAM) + THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2)) + (LOGOR (UNFOLD (\PEEKBIN STREAM) + 256) + BYTE) + ELSE (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1)) + NIL) + ELSE (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1)) + (LOGOR (UNFOLD CSET 256) + BYTE)))]) + +(\MCCSFORMATBYTESTREAM + [LAMBDA (STREAM BYTESTREAM) (* ; "Edited 27-May-2025 23:42 by rmk") + (* ; "Edited 26-Mar-2024 11:00 by rmk") + (* ; "Edited 19-Mar-2024 16:02 by rmk") + (\EXTERNALFORMAT BYTESTREAM (\EXTERNALFORMAT STREAM)) + + (* ;; "This stream may be read as a continuation of STREAM (TTYIN, LAFITE?), and we want to make sure that the bytes are encoded properly. So let's assert (and possibly mark) that that's its current situation.") + + (\MCCSCHARSETFN BYTESTREAM (fetch (STREAM CHARSET) of STREAM)) + BYTESTREAM]) + +(\MCCSCHARSETFN + [LAMBDA (STREAM CHARSET DONTMARKSTREAM) (* ; "Edited 9-Dec-2023 11:18 by rmk") + + (* ;; "This differs from \GENERIC.CHARSET in that it actually writes the shifting bytes into an output stream, unless DONTMARKSTREAM. It will do write the shifts, even if it just replicates the situation that is already there (presumably CHARSET = the old CHARSET). The client should test and avoid calling if useless shifts are not desired.") + + (LET [(CSET (ffetch (STREAM CHARSET) of (\DTEST STREAM 'STREAM] + (CL:WHEN CHARSET + (CL:WHEN (EQ CHARSET T) + (SETQ CHARSET \NORUNCODE)) + (CL:UNLESS (EQ CHARSET CSET) + (freplace (STREAM CHARSET) of STREAM with CHARSET) + (CL:UNLESS DONTMARKSTREAM + (CL:WHEN (\IOMODEP STREAM 'OUTPUT T) + (\BOUT STREAM NSCHARSETSHIFT) + (if (EQ CHARSET \NORUNCODE) + then (\BOUT STREAM \NORUNCODE) + (\BOUT STREAM 0) + else (\BOUT STREAM CHARSET)))))) + CSET]) +) +(DEFINEQ + +(\CREATE.MCCS.EXTERNALFORMAT + [LAMBDA (NAME EOL) (* ; "Edited 23-Apr-2025 14:19 by rmk") + (* ; "Edited 7-Dec-2023 23:03 by rmk") + (* ; "Edited 30-Jun-2022 18:08 by rmk") + (* ; "Edited 10-Sep-2021 19:49 by rmk:") + +(* ;;; "Create the :MCCS external format. Stream's EOL overrides the (vacuous) default here") + + (MAKE-EXTERNALFORMAT (OR NAME :MCCS) + (FUNCTION \MCCSINCCODE) + (FUNCTION \MCCSPEEKCCODE) + (FUNCTION \MCCSBACKCCODE) + (FUNCTION \MCCSOUTCHAR) + (FUNCTION \MCCSFORMATBYTESTREAM) + (OR EOL 'LF) + T NIL NIL (FUNCTION \MCCSCHARSETFN]) +) +(DEFINEQ + +(\MCCS.24BITENCODING.ERROR + [LAMBDA (STREAM) (* ; "Edited 9-Sep-2025 22:41 by rmk") + (* ; "Edited 23-Apr-2025 14:34 by rmk") + (* bvm%: "12-Mar-86 15:35") + (DECLARE (USEDFREE *SIGNAL-MCCS.24BITENCODING.ERROR*)) + +(* ;;; "Called if we see the sequence shift,shift on STREAM -- means shift to 24-bit character set, which we don't support. Usually this just means we're erroneously reading a binary file as text. If this function returns, its value is taken as a character set to shift to") + + (CL:WHEN *SIGNAL-MCCS.24BITENCODING.ERROR* (* ; + "Only cause error if user/reader cares") + (ERROR "24-bit MCCS encoding not supported" STREAM)) (* ; "Return charset zero") + 0]) +) + +(RPAQ? *SIGNAL-MCCS.24BITENCODING.ERROR* ) +(DECLARE%: EVAL@COMPILE DONTCOPY +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(RPAQQ \NORUNCODE 255) + +(RPAQQ NSCHARSETSHIFT 255) + + +(CONSTANTS (\NORUNCODE 255) + (NSCHARSETSHIFT 255)) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \RUNCODED MACRO (OPENLAMBDA (STREAM) + + (* ;; "returns NIL is the stream is not runcoded, that is, if the stream has 16 bit bytes explicitly represented") + (* ; + "note that neq is ok since charsets are known to be SMALLP's") + (NEQ (fetch CHARSET of STREAM) + \NORUNCODE))) +) + +(* "END EXPORTED DEFINITIONS") + +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(\CREATE.MCCS.EXTERNALFORMAT :MCCS) + +(\CREATE.MCCS.EXTERNALFORMAT :XCCS) +) + + + +(* ;; "") + + + + +(* ;; "Assignment of MCCS characters") + + +(ADDTOVAR CHARACTERNAMES (Lowline "0,254") + (Circumflex "0,255") + (Currency "0,244") + (Leftarrow "0,137") + (Uparrow "0,136") + (Dollar "0,44") + (Underline Lowline)) + + + +(* ;; "Mapping between true XCCS and MCCS codes") + +(DEFINEQ + +(MTOXCODE + [LAMBDA (MCODE) (* ; "Edited 7-Sep-2025 22:36 by rmk") + (* ; "Edited 31-Aug-2025 14:24 by rmk") + (* ; "Edited 1-May-2025 20:05 by rmk") + (* ; "Edited 27-Apr-2025 13:42 by rmk") + + (* ;; "Inverts XTOMCODE. Presumably for the \OUTCHAR function of hardcopy devices (like Interpress) that want XCCS codes.") + + (OR [CDR (ASSOC MCODE (CONSTANT (for X M from 0 to \MAXTHINCHAR when (SETQ M (XTOMCODE X)) + unless (EQ M X) collect (CONS M X] + MCODE]) + +(XTOMCODE + [LAMBDA (XCODE) (* ; "Edited 7-Sep-2025 22:36 by rmk") + (* ; "Edited 4-Sep-2025 00:25 by rmk") + (OR [CDR (ASSOC XCODE (CONSTANT (APPEND (CHARCODE ((Currency . Dollar) + (Dollar . Currency))) + (for X M from 0 to \MAXTHINCHAR + when (SETQ M (X$TOMCODE X)) + unless (EQ X M) collect (CONS X M] + XCODE]) + +(XTOMSTRING + [LAMBDA (XSTRING DESTRUCTIVE) (* ; "Edited 2-Sep-2025 12:14 by rmk") + (* ; "Edited 29-Apr-2025 13:08 by rmk") + + (* ;; "Converts Unicodes to MCCS codes in XSTRING.") + + (for I XCODE (MSTRING _ (CL:IF DESTRUCTIVE + XSTRING + (CONCAT XSTRING))) from 1 while (SETQ XCODE (NTHCHARCODE XSTRING I)) + do (RPLCHARCODE MSTRING I (XTOMCODE XCODE)) finally (RETURN MSTRING]) + +(MTOXSTRING + [LAMBDA (MSTRING DESTRUCTIVE) (* ; "Edited 2-Sep-2025 12:22 by rmk") + (* ; "Edited 29-Apr-2025 13:08 by rmk") + + (* ;; "Converts XCCS to MCCS codes in XSTRING.") + + (for I MCODE (XSTRING _ (CL:IF DESTRUCTIVE + MSTRING + (CONCAT MSTRING))) from 1 while (SETQ MCODE (NTHCHARCODE MSTRING I)) + do (RPLCHARCODE XSTRING I (MTOXCODE MCODE)) finally (RETURN XSTRING]) +) +(DEFINEQ + +(MTOX$CODE + [LAMBDA (MCODE) (* ; "Edited 7-Sep-2025 22:37 by rmk") + (* ; "Edited 31-Aug-2025 14:23 by rmk") + (* ; "Edited 7-Aug-2025 08:13 by rmk") + (* ; "Edited 11-May-2025 16:54 by rmk") + + (* ;; "Inverts X$TOMCODE. Only worries about charset 0") + + (OR [CDR (ASSOC MCODE (CONSTANT (for X M from 0 to \MAXTHINCHAR when (SETQ M (X$TOMCODE X)) + unless (EQ M X) collect (CONS X M] + MCODE]) + +(X$TOMCODE + [LAMBDA (X$CODE) (* ; "Edited 7-Sep-2025 22:37 by rmk") + (* ; "Edited 3-Sep-2025 17:26 by rmk") + (* ; "Edited 31-Aug-2025 11:49 by rmk") + (* ; "Edited 7-Aug-2025 08:14 by rmk") + + (* ;; "Swaps arrows with lowline and cirumflex") + (* ; "Edited 11-May-2025 16:54 by rmk") + (OR [CAR (find PAIR in (CHARCODE ((Uparrow Circumflex) + (Circumflex Uparrow) + (Leftarrow Lowline) + (Lowline Leftarrow))) suchthat (EQ X$CODE (CADR PAIR] + X$CODE]) +) +(DEFINEQ + +(KANJICHARSETP + [LAMBDA (CHARSET) (* ; "Edited 13-Jun-2025 16:33 by rmk") + + (* ;; "Returns CHARSET if it is a charset with MCCS Kanji characters") + + (AND (<= 48 CHARSET 118) + CHARSET]) + +(CHINESECHARSETP + [LAMBDA (CHARSET) (* ; "Edited 18-Jun-2025 23:09 by rmk") + (* ; "Edited 13-Jun-2025 16:33 by rmk") + + (* ;; "Returns CHARSET if it is a charset with MCCS Chinese characters") + + (AND (<= 161 CHARSET 212) + CHARSET]) +) + + + +(* ; " Mapping functions to MCCS") + + + + +(* ;; "Used by \TEDIT.MCCS.TRANSLATE .") + + +(RPAQQ ALTOTEXT2MCCS + ( + (* ;; "From bravo doc") + + (^N "356,055" MINUS) + (^V "357,44" ENDASH) + (^S EMDASH) + (^O EMQUAD) + (^X "356,055" MINUS) + (^Y FIGURESPACE ENQUAD) + + (* ;; "Fom current Helvetica/Timesroman fonts") + + ("0,1" "0,317" HACHEK) + ("0,3" "361,255" DIARESIS) + ("0,4" "0,310" CCEDILLA) + ("0,5" "0,301" GRAVE) + ("0,6" "360,41" ff) + ("0,7" "0,271" LSQ) + ("0,10" "0,241" SPANISHEXCL) + ("0,13" "0,302" ACUTE) + ("0,20" "0,304" TILDE) + ("0,21" "360,42" ffi) + ("0,22" "360,43" ffl) + ("0,24" "360,44" fi) + ("0,25" "360,45" fl) + ("0,26" "357,44" ENDASH) + ("0,27" "0,306" BREVE) + ("0,34" ENQUAD) + ("0,36" "0,304" TILDE) + ("0,140" "0,251") + ("0,200" "361,47" A-umlaut) + ("0,201" "361,124" O-umlaut) + ("0,202" "361,47" A-ring) + ("0,233" "357,44" ENDASH) + ("0,234" EMDASH) + ("0,240" "361,247" a-umlaut) + ("0,241" "361,324" o-umlaut) + ("0,242" "361,250" a-ring) + ("0,243" "361,345" u-umlaut) + ("0,254" Circumflex) + ("0,260" "0,242" CENTS) + ("0,261" "0,243" POUND) + ("0,265" "41,172" STAR) + ("0,266" "0,247" SECTION) + ("0,267" "357,146" BULLET) + ("0,270" "357,60" DAGGER) + ("0,271" "357,061" DOUBLEDAGGER) + ("0,272" "0,266" PARAGRAPH) + ("0,274" "0,261" PLUSMINUS) + ("0,275" "0,241" SPANISHEXCL) + ("0,276" "0,277" SPANISHQUES) + ("0,277" Lowline))) + +(RPAQQ SYMBOLTOMCCS + (("0,1" Null) + ("0,2" "0,264") + ("0,3" "41,142") + ("0,4" Null) + ("0,5" "41,176") + ("0,6" "0,261") + (Bell "357,175") + (Backspace "357,142") + (Tab "357,143") + (Linefeed "357,144") + ("0,13" "357,145") + (Page Null) + (Newline "0,270") + ("0,16" Null) + ("0,17" Null) + ("0,20" "357,160") + ("0,21" "357,162") + ("0,22" "357,131") + ("0,23" "357,130") + ("0,24" "41,145") + ("0,25" "41,146") + ("0,26" Null) + ("0,27" Null) + ("0,30" "356,176") + ("0,31" "357,171") + ("0,32" "357,133") + (Escape "357,132") + ("0,34" "41,142") + ("0,35" "357,163") + ("0,36" Null) + (Tenexeol Null) + (Space Null) + ("0,41" "0,256") + ("0,42" Circumflex) + ("0,43" "0,257") + (Dollar "357,122") + ("0,45" "357,102") + ("0,46" "357,103") + ("0,47" "357,167") + ("0,50" "357,115") + ("0,51" "357,117") + ("0,52" Null) + ("0,53" Null) + ("0,54" "357,116") + ("0,55" Null) + ("0,56" Null) + ("0,57" Null) + (Zero Null) + (One INFINITY) + (Two "357,112") + (Three "357,113") + (Four "357,141") + (Five Null) + (Six "357,154") + (Seven Lowline) + (Eight "357,265") + (Nine "357,264") + ("0,72" "357,152") + ("0,73" "357,247") + ("0,74" Null) + ("0,75" Null) + ("0,76" Null) + ("0,77" "0,57") + ("0,100" Null) + ("0,133" "357,127") + ("0,134" "357,126") + ("0,135" Null) + (Uparrow "357,266") + (Leftarrow "357,267") + ("0,140" "357,66") + ("0,141" "357,67") + ("0,142" "357,262") + ("0,143" "357,263") + ("0,144" "357,260") + ("0,145" "357,261") + ("0,146" "0,173") + ("0,147" "0,175") + ("0,150" "357,62") + ("0,151" "357,63") + ("0,152" "356,174") + ("0,153" "41,102") + ("0,154" "357,73") + ("0,155" "357,72") + ("0,156" "42,44") + ("0,157" "42,46") + ("0,160" "357,174") + ("0,161" "41,142") + ("0,162" Null) + ("0,163" "357,165") + ("0,164" Null) + ("0,165" Null) + ("0,166" Null) + ("0,167" Null) + ("0,170" "0,247") + ("0,171" "357,60") + ("0,172" "357,61") + ("0,173" "0,266") + ("0,174" "0,100") + ("0,175" "0,323") + ("0,176" "0,243") + (Rubout Dollar) + ("0,200" Null) + ("0,201" Null) + ("0,202" Null) + ("0,203" Null) + ("0,204" Null) + ("0,205" Null) + ("0,206" Null) + ("0,207" Null) + ("0,210" Null) + ("0,211" Null) + ("0,212" Null) + ("0,213" Null) + ("0,214" Null) + ("0,215" Null) + ("0,216" Null) + ("0,217" Null) + ("0,220" Null) + ("0,221" Null) + ("0,222" Null) + ("0,223" Null) + ("0,224" Null) + ("0,225" Null) + ("0,226" Null) + ("0,227" Null) + ("0,230" Null) + ("0,231" Null) + ("0,232" Null) + ("0,233" Null) + ("0,234" Null) + ("0,235" Null) + ("0,236" Null) + ("0,237" Null) + ("0,240" Null) + ("0,241" Null) + ("0,242" Null) + ("0,243" Null) + (Currency Null) + ("0,245" Null) + ("0,246" Null) + ("0,247" Null) + ("0,250" Null) + ("0,251" Null) + (LEFT-DOUBLEQUOTE Null) + ("0,253" Null) + (Lowline Null) + (Circumflex Null) + ("0,256" Null) + ("0,257" Null) + ("0,260" Null) + ("0,261" Null) + ("0,262" Null) + ("0,263" Null) + ("0,264" Null) + ("0,265" Null) + ("0,266" Null) + ("0,267" Null) + ("0,270" Null) + ("0,271" Null) + (RIGHT-DOUBLEQUOTE Null) + ("0,273" Null) + ("0,274" Null) + ("0,275" Null) + ("0,276" Null) + ("0,277" Null) + ("0,300" Null) + ("0,301" Null) + ("0,302" Null) + ("0,303" Null) + ("0,304" Null) + ("0,305" Null) + ("0,306" Null) + ("0,307" Null) + ("0,310" Null) + ("0,311" Null) + ("0,312" Null) + ("0,313" Null) + ("0,314" Null) + ("0,315" Null) + ("0,316" Null) + ("0,317" Null) + ("0,320" Null) + ("0,321" Null) + ("0,322" Null) + ("0,323" Null) + ("0,324" Null) + ("0,325" Null) + ("0,326" Null) + ("0,327" Null) + ("0,330" Null) + ("0,331" Null) + ("0,332" Null) + ("0,333" Null) + ("0,334" Null) + ("0,335" Null) + ("0,336" Null) + ("0,337" Null) + ("0,340" Null) + ("0,341" Null) + ("0,342" Null) + ("0,343" Null) + ("0,344" Null) + ("0,345" Null) + ("0,346" Null) + ("0,347" Null) + ("0,350" Null) + ("0,351" Null) + ("0,352" Null) + ("0,353" Null) + ("0,354" Null) + ("0,355" Null) + ("0,356" Null) + ("0,357" Null) + ("0,360" Null) + ("0,361" Null) + ("0,362" Null) + ("0,363" Null) + ("0,364" Null) + ("0,365" Null) + ("0,366" Null) + ("0,367" Null) + ("0,370" Null) + ("0,371" Null) + ("0,372" Null) + ("0,373" Null) + ("0,374" Null) + ("0,375" Null) + ("0,376" Null) + ("0,377" Null))) + +(RPAQQ SIGMATOMCCS + (("0,101" "0,101" low squaredot not in XCCS) + ("0,103" "357,166" contourintegral) + ("0,111" "357,126" intersection) + ("0,114" "357,266" and) + ("0,115" "357,172" Summation) + ("0,120" "357,173" Product) + ("0,122" "357,174" radical) + ("0,123" "357,165" integral) + ("0,125" "357,127" union) + ("0,126" "357,267" or))) + +(RPAQQ HIPPOTOMCCS + (("0,16" "356,55") + ("0,17" EMQUAD) + ("0,23" EMDASH) + ("0,26" "357,44") + ("0,30" "356,55") + ("0,31" ENQUAD) + ("0,101" "Greek,101") + ("0,102" "Greek,102") + ("0,103" "Greek,121") + ("0,104" "Greek,105") + ("0,105" "Greek,106") + ("0,106" "Greek,132") + ("0,107" "Greek,104") + ("0,110" "Greek,112") + ("0,111" "Greek,114") + ("0,113" "Greek,115") + ("0,114" "Greek,116") + ("0,115" "Greek,117") + ("0,116" "Greek,120") + ("0,117" "Greek,122") + ("0,120" "Greek,123") + ("0,121" "Greek,113") + ("0,122" "Greek,125") + ("0,123" "Greek,126") + ("0,124" "Greek,130") + ("0,125" "Greek,131") + ("0,127" "Greek,135") + ("0,130" "Greek,133") + ("0,131" "Greek,134") + ("0,132" "Greek,111") + (Uparrow Circumflex) + (Leftarrow Lowline) + ("0,141" "Greek,141") + ("0,142" "Greek,142") + ("0,143" "Greek,161") + ("0,144" "Greek,145") + ("0,145" "Greek,146") + ("0,146" "Greek,172") + ("0,147" "Greek,144") + ("0,150" "Greek,152") + ("0,151" "Greek,154") + ("0,153" "Greek,155") + ("0,154" "Greek,156") + ("0,155" "Greek,157") + ("0,156" "Greek,160") + ("0,157" "Greek,162") + ("0,160" "Greek,163") + ("0,161" "Greek,153") + ("0,162" "Greek,165") + ("0,163" "Greek,166") + ("0,164" "Greek,170") + ("0,165" "Greek,171") + ("0,167" "Greek,175") + ("0,170" "Greek,173") + ("0,171" "Greek,174") + ("0,172" "Greek,151") + ("0,233" "357,44") + ("0,234" EMDASH) + ("0,267" "357,146"))) + +(RPAQQ CYRILLICTOMCCS + ((Dollar "Cyrillic,47") + ("0,52" "Cyrillic,71") + ("0,55" "41,76") + (Two "Cyrillic,157") + (Four "Cyrillic,127") + (Six "Cyrillic,150") + (Eight "Cyrillic,151") + ("0,74" "0,253") + ("0,76" "0,273") + ("0,100" "Cyrillic,77") + ("0,101" "Cyrillic,41") + ("0,102" "Cyrillic,42") + ("0,103" "Cyrillic,76") + ("0,104" "Cyrillic,45") + ("0,105" "Cyrillic,46") + ("0,106" "Cyrillic,66") + ("0,107" "Cyrillic,44") + ("0,110" "Cyrillic,101") + ("0,111" "Cyrillic,52") + ("0,112" "Cyrillic,53") + ("0,113" "Cyrillic,54") + ("0,114" "Cyrillic,55") + ("0,115" "Cyrillic,56") + ("0,116" "Cyrillic,57") + ("0,117" "Cyrillic,60") + ("0,120" "Cyrillic,61") + ("0,121" "Cyrillic,67") + ("0,122" "Cyrillic,62") + ("0,123" "Cyrillic,63") + ("0,124" "Cyrillic,64") + ("0,125" "Cyrillic,65") + ("0,126" "Cyrillic,43") + ("0,127" "Cyrillic,50") + ("0,130" "Cyrillic,75") + ("0,131" "Cyrillic,100") + ("0,132" "Cyrillic,51") + ("0,133" "Cyrillic,152") + ("0,134" "Cyrillic,0") + ("0,135" "Cyrillic,153") + (Uparrow "Cyrillic,74") + (Leftarrow "Cyrillic,154") + ("0,140" "Cyrillic,0") + ("0,141" "Cyrillic,121") + ("0,142" "Cyrillic,122") + ("0,143" "Cyrillic,176") + ("0,144" "Cyrillic,125") + ("0,145" "Cyrillic,126") + ("0,146" "Cyrillic,146") + ("0,147" "Cyrillic,124") + ("0,150" "Cyrillic,161") + ("0,151" "Cyrillic,132") + ("0,152" "Cyrillic,133") + ("0,153" "Cyrillic,134") + ("0,154" "Cyrillic,135") + ("0,155" "Cyrillic,136") + ("0,156" "Cyrillic,137") + ("0,157" "Cyrillic,140") + ("0,160" "Cyrillic,141") + ("0,161" "Cyrillic,147") + ("0,162" "Cyrillic,142") + ("0,163" "Cyrillic,143") + ("0,164" "Cyrillic,144") + ("0,165" "Cyrillic,145") + ("0,166" "Cyrillic,123") + ("0,167" "Cyrillic,130") + ("0,170" "Cyrillic,155") + ("0,171" "Cyrillic,160") + ("0,172" "Cyrillic,131") + ("0,173" "Cyrillic,72") + ("0,174" "Cyrillic,0") + ("0,175" "Cyrillic,73") + ("0,176" "Cyrillic,70") + (Rubout "Cyrillic,0") + ("0,217" "Cyrillic,156") + ("0,233" "357,44") + ("0,234" EMDASH) + ("0,267" "357,146"))) + +(RPAQQ MATHTOMCCS + (("0,1" "357,173") + ("0,2" "357,62") + ("0,3" "357,63") + ("0,4" Null) + ("0,5" "0,243") + ("0,6" "357,165") + (Bell "357,166") + (Backspace Null) + (Tab Null) + (Linefeed Null) + ("0,13" "0,266") + (Page Null) + (Newline Null) + ("0,16" Null) + ("0,17" "357,146") + ("0,20" Null) + ("0,21" Null) + ("0,22" Null) + ("0,23" "357,172") + ("0,24" Null) + ("0,25" Null) + ("0,26" "357,157") + ("0,27" Null) + ("0,30" Null) + ("0,31" Null) + ("0,32" Null) + (Escape Null) + ("0,34" Null) + ("0,35" Null) + ("0,36" Null) + (Tenexeol Null) + ("0,41" "357,60") + ("0,42" "357,147") + ("0,43" INFINITY) + (Dollar "0,242") + ("0,45" "0,270") + ("0,46" "357,266") + ("0,47" "357,163") + ("0,50" "0,302") + ("0,51" "357,174") + ("0,52" "0,307") + ("0,53" "0,261") + ("0,54" "357,114") + ("0,55" "357,175") + ("0,56" "41,150") + ("0,57" "357,145") + (Zero "357,147") + (One "42,42") + (Two "42,44") + (Three "41,176") + (Four "357,142") + (Five "357,143") + (Six "357,144") + (Seven "357,154") + (Eight "41,172") + (Nine "0,307") + ("0,72" "0,247") + ("0,73" Null) + ("0,74" "41,145") + ("0,75" "41,142") + ("0,76" "41,146") + ("0,77" "0,277") + ("0,100" "357,100") + ("0,101" "357,265") + ("0,102" "357,112") + ("0,103" "357,254") + ("0,104" "357,271") + ("0,105" "357,264") + ("0,106" "357,61") + ("0,107" "357,133") + ("0,110" "357,137") + ("0,111" "357,131") + ("0,112" "357,132") + ("0,113" "357,136") + ("0,114" "357,130") + ("0,115" "360,275") + ("0,116" "357,113") + ("0,117" "357,141") + ("0,120" "357,161") + ("0,121" "357,121") + ("0,122" "357,256") + ("0,123" "357,171") + ("0,124" "357,160") + ("0,125" "357,127") + ("0,126" "357,267") + ("0,127" "357,162") + ("0,130" "0,264") + ("0,131" "360,272") + ("0,132" "357,270") + ("0,133" Null) + ("0,134" Null) + ("0,135" Null) + (Uparrow "0,257") + (Leftarrow "0,256") + ("0,140" Null) + ("0,141" "357,247") + ("0,142" "357,123") + ("0,143" "0,323") + ("0,144" "357,272") + ("0,145" "357,167") + ("0,146" "357,122") + ("0,147" "357,117") + ("0,150" "357,150") + ("0,151" "357,260") + ("0,152" "357,261") + ("0,153" "357,262") + ("0,154" "357,263") + ("0,155" "357,110") + ("0,156" "357,152") + ("0,157" "357,147") + ("0,160" "357,66") + ("0,161" "357,70") + ("0,162" "0,322") + ("0,163" "357,76") + ("0,164" "357,74") + ("0,165" "357,77") + ("0,166" "357,75") + ("0,167" "357,102") + ("0,170" "357,103") + ("0,171" "357,126") + ("0,172" "357,67") + ("0,173" "0,274") + ("0,174" "0,275") + ("0,175" "0,276") + ("0,176" "357,120") + (Rubout Null) + ("0,200" Null) + ("0,201" Null) + ("0,202" Null) + ("0,203" Null) + ("0,204" Null) + ("0,205" Null) + ("0,206" Null) + ("0,207" Null) + ("0,210" Null) + ("0,211" Null) + ("0,212" Null) + ("0,213" Null) + ("0,214" Null) + ("0,215" Null) + ("0,216" Null) + ("0,217" Null) + ("0,220" Null) + ("0,221" Null) + ("0,222" Null) + ("0,223" Null) + ("0,224" Null) + ("0,225" Null) + ("0,226" Null) + ("0,227" Null) + ("0,230" Null) + ("0,231" Null) + ("0,232" Null) + ("0,233" Null) + ("0,234" Null) + ("0,235" Null) + ("0,236" Null) + ("0,237" Null) + ("0,240" Null) + ("0,241" Null) + ("0,242" Null) + ("0,243" Null) + (Currency Null) + ("0,245" Null) + ("0,246" Null) + ("0,247" Null) + ("0,250" Null) + ("0,251" Null) + (LEFT-DOUBLEQUOTE Null) + ("0,253" Null) + (Lowline Null) + (Circumflex Null) + ("0,256" Null) + ("0,257" Null) + ("0,260" Null) + ("0,261" Null) + ("0,262" Null) + ("0,263" Null) + ("0,264" Null) + ("0,265" Null) + ("0,266" Null) + ("0,267" Null) + ("0,270" Null) + ("0,271" Null) + (RIGHT-DOUBLEQUOTE Null) + ("0,273" Null) + ("0,274" Null) + ("0,275" Null) + ("0,276" Null) + ("0,277" Null) + ("0,300" Null) + ("0,301" Null) + ("0,302" Null) + ("0,303" Null) + ("0,304" Null) + ("0,305" Null) + ("0,306" Null) + ("0,307" Null) + ("0,310" Null) + ("0,311" Null) + ("0,312" Null) + ("0,313" Null) + ("0,314" Null) + ("0,315" Null) + ("0,316" Null) + ("0,317" Null) + ("0,320" Null) + ("0,321" Null) + ("0,322" Null) + ("0,323" Null) + ("0,324" Null) + ("0,325" Null) + ("0,326" Null) + ("0,327" Null) + ("0,330" Null) + ("0,331" Null) + ("0,332" Null) + ("0,333" Null) + ("0,334" Null) + ("0,335" Null) + ("0,336" Null) + ("0,337" Null) + ("0,340" Null) + ("0,341" Null) + ("0,342" Null) + ("0,343" Null) + ("0,344" Null) + ("0,345" Null) + ("0,346" Null) + ("0,347" Null) + ("0,350" Null) + ("0,351" Null) + ("0,352" Null) + ("0,353" Null) + ("0,354" Null) + ("0,355" Null) + ("0,356" Null) + ("0,357" Null) + ("0,360" Null) + ("0,361" Null) + ("0,362" Null) + ("0,363" Null) + ("0,364" Null) + ("0,365" Null) + ("0,366" Null) + ("0,367" Null) + ("0,370" Null) + ("0,371" Null) + ("0,372" Null) + ("0,373" Null) + ("0,374" Null) + ("0,375" Null) + ("0,376" Null) + ("0,377" Null))) +(DEFINEQ + +(MCCSCODEMAPARRAY + [LAMBDA (MAP) (* ; "Edited 6-Sep-2025 18:26 by rmk") + (* ; "Edited 31-Aug-2025 16:15 by rmk") + (* ; "Edited 7-Aug-2025 08:55 by rmk") + (* ; "Edited 2-Jun-2025 11:45 by rmk") + (* ; "Edited 1-Jun-2025 07:26 by rmk") + (* ; "Edited 24-May-2025 12:22 by rmk") + (* ; "Edited 21-Dec-2024 18:57 by rmk") + + (* ;; "Atom cases for loadup") + + (SELECTQ MAP + (XCCS (SETQ MAP (APPEND MTOXCODEMAP ALTOTEXT2MCCS))) + (MCCS (SETQ MAP ALTOTEXT2MCCS)) + NIL) + (LET ((TABLE (ARRAY (ADD1 \MAXTHINCHAR) + 'WORD 0 0))) + (for I from 0 to \MAXTHINCHAR do (SETA TABLE I I)) + [for PAIR FROMCODE in MAP when (LISTP PAIR) unless (EQ '* (CAR PAIR)) + when (SETQ FROMCODE (CL:IF (CHARCODEP (CAR PAIR)) + (CAR PAIR) + (CHARCODE.DECODE (CAR PAIR) + T))) do (SETA TABLE FROMCODE (CL:IF (CHARCODEP + (CADR PAIR)) + (CADR PAIR) + (CHARCODE.DECODE + (CADR PAIR)))] + TABLE]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS ALTOTOMCCSARRAY SYMBOLTOMCCSARRAY HIPPOTOMCCSARRAY CYRILLICTOMCCSARRAY MATHTOMCCSARRAY + SIGMATOMCCSARRAY) +) + +(RPAQ? ALTOTOMCCSARRAY (MCCSCODEMAPARRAY 'MCCS)) + +(RPAQ? SYMBOLTOMCCSARRAY (MCCSCODEMAPARRAY SYMBOLTOMCCS)) + +(RPAQ? HIPPOTOMCCSARRAY (MCCSCODEMAPARRAY HIPPOTOMCCS)) + +(RPAQ? CYRILLICTOMCCSARRAY (MCCSCODEMAPARRAY CYRILLICTOMCCS)) + +(RPAQ? MATHTOMCCSARRAY (MCCSCODEMAPARRAY MATHTOMCCS)) + +(RPAQ? SIGMATOMCCSARRAY (MCCSCODEMAPARRAY SIGMATOMCCS)) +(DEFINEQ + +(MCCSMAPFN + [LAMBDA (FROMENCODING) (* ; "Edited 6-Sep-2025 12:40 by rmk") + (* ; "Edited 4-Sep-2025 08:06 by rmk") + (* ; "Edited 24-May-2025 10:55 by rmk") + + (* ;; "Returns the function that maps a FROMENCODING code to the corresponding MCCS code") + + (CL:WHEN (LISTP FROMENCODING) + + (* ;; "Assume it's a FONTSPEC") + + (SETQ FROMENCODING (fetch (FONTSPEC FSFAMILY) of FROMENCODING))) + (if (MEMB FROMENCODING NSFONTFAMILIES) + then (SETQ FROMENCODING 'XCCS$) + elseif (MEMB FROMENCODING ALTOFONTFAMILIES) + then (SETQ FROMENCODING 'ALTOTEXT)) + (SELECTQ FROMENCODING + (XCCS$ (FUNCTION X$TOMCODE)) + (ALTOTEXT (FUNCTION ATOMCODE)) + (SYMBOL (FUNCTION SYMBOLTOMCODE)) + (SIGMA (FUNCTION SIGMATOMCODE)) + (MATH (FUNCTION MATHTOMCODE)) + (HIPPO (FUNCTION HIPPOTOMCODE)) + (CYRILLIC (FUNCTION CYRILLICTOMCODE)) + (XCCS (FUNCTION XTOMCODE)) + (GACHA (FUNCTION GACHATOMCODE)) + (MCCS NIL) + NIL]) + +(MCCSMAPPAIRS + [LAMBDA (FROMENCODING NONIDENTITY) (* ; "Edited 6-Sep-2025 16:43 by rmk") + (* ; "Edited 31-Aug-2025 16:16 by rmk") + + (* ;; "Returns the pairs for MOVEFONTCHARS to use to move charset-0 glyphs into their MCCS positions. For example, the Leftarrow and Lowline glyphs switch positions in an XCCS$ font.") + + (LET (PAIRS) + [SETQ PAIRS (SELECTQ FROMENCODING + (GACHA (* ; "ctrl and upper are slugged") + [APPEND (XCCSUNDEFINEDPAIRS) + '(((Uparrow TERMINAL) + Circumflex) + (^X Lowline]) + (ALTOTEXT (APPEND (XCCSUNDEFINEDPAIRS) + ALTOTEXT2MCCS)) + (XCCS$ '((Uparrow Circumflex) + (Leftarrow Lowline) + (Lowline Leftarrow) + (Circumflex Uparrow))) + (for C M (FN _ (MCCSMAPFN FROMENCODING)) from 0 to \MAXTHINCHAR + when (SETQ M (APPLY* FN C NONIDENTITY)) collect (LIST C M] + + (* ;; "Weed out interspersed comments") + + (for P in PAIRS when (LISTP P) unless (EQ '* (CAR P)) + collect (LIST (if (LISTP (CAR P)) + then + (* ;; + "Allows for the (Uparrow TERMINAL) case above, for MOVEFONTCHARS") + + (CONS (CL:IF (CHARCODEP (CAAR P)) + (CAAR P) + (CHARCODE.DECODE (CAAR P))) + (CDAR P)) + elseif (CHARCODEP (CAR P)) + then (CAR P) + else (CHARCODE.DECODE (CAR P))) + (CL:IF (CHARCODEP (CADR P)) + (CADR P) + (CHARCODE.DECODE (CADR P)))]) + +(XCCSUNDEFINEDPAIRS + [LAMBDA NIL (* ; "Edited 2-Sep-2025 13:14 by rmk") + (APPEND (for I from 0 to (SUB1 (CHARCODE SPACE)) collect (LIST NIL I)) + (for I from 127 to \MAXTHINCHAR collect (LIST NIL I]) +) + + + +(* ; "Mappings into MCCS: needed for hardcopy and Tedit coercion") + +(DEFINEQ + +(GACHATOMCODE + [LAMBDA (GCODE) (* ; "Edited 7-Sep-2025 22:38 by rmk") + (* ; "Edited 3-Sep-2025 23:23 by rmk") + (* ; "Edited 30-Aug-2025 21:58 by rmk") + + (* ;; "Gacha did not have a code for circumflex, so there is nothing to map") + + (CL:IF (EQ GCODE (CHARCODE ^X)) + (CHARCODE Lowline) + GCODE)]) + +(SYMBOLTOMCODE + [LAMBDA (SCODE) (* ; "Edited 7-Sep-2025 22:39 by rmk") + (* ; "Edited 3-Sep-2025 10:21 by rmk") + (* ; "Edited 7-Aug-2025 09:37 by rmk") + (* ; "Edited 1-Jun-2025 07:02 by rmk") + (OR (CL:WHEN (ILEQ SCODE \MAXTHINCHAR) + (LET ((MCODE (ELT SYMBOLTOMCCSARRAY SCODE))) + (CL:UNLESS (EQ MCODE SCODE) + MCODE))) + SCODE]) + +(SIGMATOMCODE + [LAMBDA (SCODE) (* ; "Edited 7-Sep-2025 22:39 by rmk") + (* ; "Edited 3-Sep-2025 10:21 by rmk") + (* ; "Edited 1-Jun-2025 07:02 by rmk") + (* ; "Edited 24-May-2025 10:54 by rmk") + (OR (CL:WHEN (ILEQ SCODE \MAXTHINCHAR) + (LET ((MCODE (ELT SIGMATOMCCSARRAY SCODE))) + (CL:UNLESS (EQ MCODE SCODE) + MCODE))) + SCODE]) + +(ATOMCODE + [LAMBDA (ACODE) (* ; "Edited 7-Sep-2025 22:39 by rmk") + (* ; "Edited 3-Sep-2025 10:21 by rmk") + (* ; "Edited 24-May-2025 09:41 by rmk") + (OR (CL:WHEN (ILEQ ACODE \MAXTHINCHAR) + (LET ((MCODE (ELT ALTOTOMCCSARRAY ACODE))) + (CL:UNLESS (EQ MCODE ACODE) + MCODE))) + ACODE]) + +(MATHTOMCODE + [LAMBDA (MATHCODE) (* ; "Edited 7-Sep-2025 22:39 by rmk") + (* ; "Edited 4-Sep-2025 08:18 by rmk") + (* ; "Edited 1-Jun-2025 07:02 by rmk") + (* ; "Edited 24-May-2025 10:58 by rmk") + (OR (CL:WHEN (ILEQ MATHCODE \MAXTHINCHAR) + (LET ((MCODE (ELT MATHTOMCCSARRAY MATHCODE))) + (CL:UNLESS (EQ MCODE MATHCODE) + MCODE))) + MATHCODE]) + +(HIPPOTOMCODE + [LAMBDA (HCODE) (* ; "Edited 7-Sep-2025 22:40 by rmk") + (* ; "Edited 3-Sep-2025 10:22 by rmk") + (* ; "Edited 24-May-2025 09:40 by rmk") + (OR (CL:WHEN (ILEQ HCODE \MAXTHINCHAR) + (LET ((MCODE (ELT HIPPOTOMCCSARRAY HCODE))) + (CL:UNLESS (EQ MCODE HCODE) + MCODE))) + HCODE]) + +(CYRILLICTOMCODE + [LAMBDA (CCODE) (* ; "Edited 7-Sep-2025 22:40 by rmk") + (* ; "Edited 24-May-2025 09:38 by rmk") + (OR (CL:WHEN (ILEQ CCODE \MAXTHINCHAR) + (LET ((MCODE (ELT CYRILLICTOMCCSARRAY CCODE))) + (CL:UNLESS (EQ MCODE CCODE) + MCODE))) + CCODE]) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (2914 14485 (\MCCSINCCODE 2924 . 6012) (\MCCSPEEKCCODE 6014 . 8901) (\MCCSOUTCHAR 8903 + . 11002) (\MCCSBACKCCODE 11004 . 12548) (\MCCSFORMATBYTESTREAM 12550 . 13280) (\MCCSCHARSETFN 13282 + . 14483)) (14486 15368 (\CREATE.MCCS.EXTERNALFORMAT 14496 . 15366)) (15369 16346 ( +\MCCS.24BITENCODING.ERROR 15379 . 16344)) (17722 20360 (MTOXCODE 17732 . 18529) (XTOMCODE 18531 . +19188) (XTOMSTRING 19190 . 19775) (MTOXSTRING 19777 . 20358)) (20361 22021 (MTOX$CODE 20371 . 21103) ( +X$TOMCODE 21105 . 22019)) (22022 22662 (KANJICHARSETP 22032 . 22288) (CHINESECHARSETP 22290 . 22660)) +(40783 42657 (MCCSCODEMAPARRAY 40793 . 42655)) (43186 47041 (MCCSMAPFN 43196 . 44408) (MCCSMAPPAIRS +44410 . 46733) (XCCSUNDEFINEDPAIRS 46735 . 47039)) (47117 51106 (GACHATOMCODE 47127 . 47639) ( +SYMBOLTOMCODE 47641 . 48289) (SIGMATOMCODE 48291 . 48937) (ATOMCODE 48939 . 49471) (MATHTOMCODE 49473 + . 50129) (HIPPOTOMCODE 50131 . 50668) (CYRILLICTOMCODE 50670 . 51104))))) +STOP diff --git a/sources/MCCS.LCOM b/sources/MCCS.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..c59ae01b85d5ba5ae2377917c6e7de5a1d9ed47d GIT binary patch literal 21214 zcmcIsOKe=%c_t~xNhYyN$&Tv?t#it_DQQFs@4XySk_%_9$f0P2={zwbY9 zJ{-k%6GXiCKmR%Z`*F^>lhK*#Y*DYCm@R766GeTtp`K~x(--n{RW(x7JJnXLXg5dH zGp%Yq)5*`)_JGgk?W#(~$4aG9t}qR>PIX3&sM9Cf-Mc5!@wBYc^vp#0OfoT|Mn{&` z?%ZAJb(huJDv(OQKhwVO2fw?p-tDiyaC`A?Z*ld7+S<}$?}a}2_cSJwKs zS5{v-p&>7MG|I z_37!xOjW-$tJMp^>&bNDY|*LKfl$=XovgN6jh0#gv$G4enhM1_dGaKPEH7?Ann+&F zLYj??{c@#{&-XzIs+=V0X?3PLQ*=(8y`uVeZmToXb9wz-wSA(~P@|>UdRxnTpn&h7 zmN9jv*{WVD8Vl_cGcYb>or-Onof&_B#F!i_MU0%8IaL~Ms#Mh%=FeW~RNJbl5(TkZ zcouY=-iKspAHXcyepVv->uP5%`&o%bHw-TvLmt$%q`yAnJJTKQUK z>o}e2*6tf0hpUJQb}Gxa;4?e7%$s=5u%2~W|M|y9fAnwhLfap!h#@5uNeS(*pcuV$sG+jXFRqxRZSVk@*^U%mm_eE}Nh>SfgBdS25s6>wq*Ike{T9QrkkL0kq+)l8$_na^7nj5%!#=mcxCDw56h!GVDz zj?JTk1Nr?&=7yJ7cE7RHdvJYdZugD1D>>K}8d5MW=g3_xd)O>!SdLpJq7EkRpCY-K@ zQiZrAfBRgBnUn(%O!8A|5PfJR2E&(+#NgN-XG)#n65b6Ctp7$8*3zh-4^pVcO7)^v8ij+7q!TBuuWTr;rMjz2Ys+Zq z)au%XTHm~Tcdd^e3fOAE#12auz0xjg6HqcN#*?y2ZE>UVb&=AsM@N zL=ki?OO8=P9I=OvQqfZuk9Fro55@Yk@6O?z=RA~kpN)L0rbb~gAv^}L ze+O;Fpt$zYql0rt?tl2^u|c}{;14Rr(BSSji~B!c+4}Ffq03u83%q^;UJoYdyxQl* z;UO*NsKdBGk(g>%#C^~RHqj(JEgIAAif3`NL7kZ;y80v~OcLDQ6l0!%g`_nV^_cpD_1Kurrc(#b*4<{MiP~pp!0pasjBxOga3rj~InEMiShDQJB@PPG&?I(9W#L$%ND894xyou>=>yghL*WhQhHUCsFx1K^E zoANjP!Sl<-+kd%JJ9c^bX#Ua0@R9qYjbp=kZ|K6WJ$~)+Z=Y{Ge)IV8f0)1jSpDYl zFZ@u#{YUjr{r%Q22CqGRWP7#o^stiP7 z@%B3YXGTmWz>FczFt4C`?Wvu{llPx!JazNN+AE7aGrdFqQ@Bm4Hi_y`AyNmt)+AC^$rN6X!=SHvlDhgVy zdt*a`YiqCcR#v-&=_lpJ0P~ZSSqJqD`EAs%i>=apfj)LDrtrnf$}Y|RYrmM12-(6E z$Z4$)zzchyxOFsrq?mjA-qYug^&a&8(7cVD*E{gx0yh2Oh5L`yZXW;qo5k(7u5A5# z?NfiZ^^5)Re-=0zFRyLaP({hcr{i<13#`_3c$Bu@)4N~oeK%-?$4YS~@KdGYa_T3s zeH+Bq>*sHL{7YEHwCpH+bCuoi%zgRhu`l10<{H^gRcqY#qu=wZPPe7DNLq-}(fdZq z=D3iOOJbf%Zgugl1d^Bf8$TbYhz6})is*=pt&FFF9?^EvhW^J=8M(Z@!x*WFO7n|H2v z`+jeTllwckBiLBeRd{iAS#r?`g5Div+dZy6HTHYpXwxh&e#d<9PFtYNnR3WtXq2uV zes~bFanOz$<3+vbT*8VteE;QJY2c&ttL3dKE-9*)@>+#j#0jb#%}h6%SJY_raTMRN*yW8*Di!shPE2Z?UfyR+qbdsU((z zk@>~DcX&T-H7AKEju^FDDkvA|T3tTJbC672*UB7%A)nBUEQHek?1m2DbG63Vye1S&dvfjm zViFS5JC_5pOF&lRlmd2jO$y^}FVWGxOsdg~3)nu2jm0_l)i}8RzDXex<0nv)=4wBk z0EIIS5UqsZ+@r!hI@j^5_XH-}9xx{`3<&L2k1Fk_65xmq#Kpmi-UpH?Jn5Eie|tn> z0xvaAx{jMtld;dJ)oyngetBc9uMpPDOKW#ulfde9mvIufwASq}!JX-xq#SiUUel7< z9H)G9?SPe-K&NNEgj&WsghPiX73i}Maj02(=X^%JV6|VK^Gc)n%uJ_&Fpy?ENMNp$ z9U1?0TArW=f?OuRvH)#XBWObKT<@y@!{s*)O_l4Q1vJT-Cg%a5r@7>3lc!b4Mc0?> zgA`krXZve+)b;-2%WG8^vr#Z`FM>c;v=39D235vnCirbg5pcI?#)8jQ>7k!&)7uEF|Dfg0N`$UW6#W{i)h z>1ia-S}oTDz~oZnSn^yezl1aB(GmcYvJ~b4e&dEl1vQMMQvlW47d0%wf&>x|g4K)m zT=nua_8`J08RFvUh{~rII$WH{m_r)bIJoK*H6DBm9BY7o5C#5?8!HBi7Y)T~H*WL{ zlmZDZ9vmu#5g;A}lVnnnWv}r#pasgtfp8W#|AvhWD?00tP0ruXEsjA1o|Y49mUNsT zT3`Z8=O;Gr^cFWatk7Dzg zF$r2oc*{tCZO@>kpO(i*N|+jOFk#&)n}Aw3sdwd^L$n1`X=W2B$aBlQ=HHku^kOimMo*!Nl7U%yQ*mK>L?$xP8a8&4 z%*~_`MNh&Qk*sduNM?1+39pwyRUZFdR9AaF_Bl5#5hH=tTB_8e9hHlC7_9gs_ILq5QP#A zj^hK#+koiAf`zZ33j)1EkkFtY%y3$`vQ_MqbyMa!tytz7 zFD{cy@D>TrR!>+tG!rO}nqorFGt=xzrJyhu0>w9E+TiJ= zTTPc8CS13eE;a;tEGu|AX$4PoX#ra5yd8H$)~8rU40EhJh8r7VlK3GxE(RTz)BQ*e0(waa1jNr_Dt011noaN$YPFEz*sh2UdUr=}$pHpmzuPC-&4 z#m7BGDUVSO$Jb5HC|m~|Yic;xrqFaK-1Wye-i|UFc?&LkB4nwRNCnRE5?3O%@`Zx) zSzRr-toSS@dXt;-NcS^FGc_^e2cl9!nKE^i6i93H`r76OO0*nYXcTFoy!WQ;OT*Vl zA1M-1G#Y6l9rv1`7`Q=*u_INa>|_HD!r_=Q+re-YltXX?8B|Xe7Jr<2Y*EDjWBdNjMJhEDrE24)81v z@QmN|2ZR~lfmda5`zrhL06PxwEDrFDeQSv9B^GsYvlb4=B6DvWj>Zzl0iLl>4Ulbo zTXnHf2!~_BL3==D#sQwi0iM|a*Ev07e240a13Y6F5D;bq5WdC|$MKzUXK0W`U2%M8 zL41>I*7;!Rxb4hX-ow$DFv~het-9iv#;HRzIgaTpuH#t{(_||S>5L&As*9V^fUh{F zvpA-+Af~xAOLs6g2xL)L+-GKSBxfww;bg08f2igTEZrWJ1sjAD{_Wwmd;Rw|7yI31 zd;rOhAo2SWxhK)>0L!;DPYFd_!U-1|a2%|5U+OP%n@biG#;Hc4vvah+-jxdi(^N1v z1wnT0xY4k1s8LUpQ-#etcNTfAU`F*Jl`IqrNBl*olU zeB`^HAt#i227{k{Zm|Jv82b;ZnE`cbrgeQe z2`{uH7ux%s>DT%zz23?a57xD2WXtZrPA)MI_R#upj%Pll5r;*CV75Ny@lbs(BIi3E z2nPbHIn)WjR!+0sO|_}0e!IE#dXwt_Hy0;0#;8&w9o$EbBwi19F3!{&h@oYpAMgUj zi-)kW1ZZ-`Fk^=VT!>22_7hwR zl3u{Won%s~9URTCQ7IF8KtMYnRm7a`MfQhVlGNQo!NH5qaj7affL_aNF50V9JAangd}`CNI40n zIGxM+VKCs_NotB82#QT?4PM$AElO$eQ@lq>b@2nf!-;bhPh{;W*`{w9Tv+*NW`~DQnx&jplxPV^#eXFNb&LmzOUjIDInq-4axX!hEt-P zayqb2{!$J+T=4CQr{~BnlQMsKaN=%o-cvobUyita1!&kUkM;qkYeHOi0_iotIw>5{ z?*VBtY&NuYS@dWsSy4A9!9}93F8(6XEW$fP^XRS*{rW5uB%mkDwV~Y!+k3+R8N`D( zDo|K)LCnfUfd(Mdcp)gaFd`^=!;*d#D&{(nE9!a@UIxkpxePSxiOBv&P&Z8aMo?qu21mD# z`ifU45`8BaDnJqu)o(Sz1myievW{E|S;-~g2*etUsm9zR+j3y81=FDEWEUYi^fxrp zh!SRQEMeC~noz;h+irn@C2bS)8J7TAqGYn`z7yH^>jkat5@|XK^OaJz{6fRmLbjU5 z?)=k5$XQ^S8iU$&5cuobc*mL)Lb)F zdPIH_mHI*^?ICCS2$x%8?{soOY+f1c2VM?iO`ZIF;|Em#?SXtC6|5ZLIkhG-<`^i3WIR>RQBc9)+u_@DnxWp{?!=fs;m>dmoqVI~O z0~3&Q3+cTCYV?^^G0X)Lv!DJ{f~5^Ty%bU2D0Cwv9*@D;WSUYWG` zY7~|-UxmXlVP>gtG$zd46pqG(Wq%tC@9Ay!Ha9V0CZBL_OgLz5L|sfbA$BZs+}Wf| zFaa`iOZXZSwwK0MU2%Jp#+OQm-5P6Wk}vH7O3WnTD+t?;>)qWN2a7RVgs)!Y(tEx& z4%dzK&VI&>idmQv0&J#(@HLh{zF}fPh>&Af|Z?1U;Wb9+MdZV4)84aEJQ{l!ViCGOq=}bx5j}?4|i#7Z1V88#!?Olarry>il>medley>sources>PRETTY.;3 65500 +(FILECREATED "24-Apr-2025 22:19:43" {WMEDLEY}PRETTY.;25 65037 - :EDIT-BY "lmm" + :EDIT-BY rmk - :CHANGES-TO (FNS PRINTDATE1) + :CHANGES-TO (VARS PRETTYCOMS) - :PREVIOUS-DATE "19-Jan-2022 20:35:18" {DSK}larry>il>medley>sources>PRETTY.;1) + :PREVIOUS-DATE " 8-Feb-2023 16:21:26" {WMEDLEY}PRETTY.;24) -(* ; " -Copyright (c) 1984-1990, 1999, 2018, 2023 by Venue & Xerox Corporation. -The following program was created in 1984 but has not been published -within the meaning of the copyright law, is furnished under license, -and may not be used, copied and/or disclosed except in accordance -with the terms of said license. -") - (PRETTYCOMPRINT PRETTYCOMS) (RPAQQ PRETTYCOMS @@ -46,7 +38,7 @@ with the terms of said license. " EXPLAINSTRING "] - no copyright notice now" NOECHOFLG T RETURN NIL] (COPYRIGHTSRESERVED T) (*NEW-INTERLISP-MAKEFILE-ENVIRONMENT* '(:READTABLE "INTERLISP" :PACKAGE - "INTERLISP" :FORMAT :XCCS)) + "INTERLISP" :FORMAT :MCCS)) (*DEFAULT-MAKEFILE-ENVIRONMENT*)) (GLOBALVARS COPYRIGHTOWNERS DEFAULTCOPYRIGHTKEYLST COPYRIGHTPRETTYFLG COMMENTFLG *DEFAULT-MAKEFILE-ENVIRONMENT* *NEW-INTERLISP-MAKEFILE-ENVIRONMENT*)) @@ -640,7 +632,7 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL (RPAQ? COPYRIGHTSRESERVED T) (RPAQ? *NEW-INTERLISP-MAKEFILE-ENVIRONMENT* '(:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :FORMAT - :XCCS)) + :MCCS)) (RPAQ? *DEFAULT-MAKEFILE-ENVIRONMENT* ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -729,17 +721,15 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL (ADDTOVAR LAMA ) ) -(PUTPROPS PRETTY COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990 1999 2018 - 2023)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5917 48569 (PRETTYDEF 5927 . 21600) (PRETTYDEFCOMS 21602 . 22284) (PRETTYDEF0 22286 . -22477) (PRETTYDEF1 22479 . 24242) (PRINTDATE 24244 . 25480) (PRINTDATE1 25482 . 27260) (PRINTFNS 27262 - . 27831) (PRETTYCOM 27833 . 34174) (PRETTYVAR 34176 . 35214) (PRETTYVAR1 35216 . 37434) (PRETTYCOM1 -37436 . 38140) (ENDFILE 38142 . 38238) (MAKEDEFLIST 38240 . 38644) (PP 38646 . 38922) (PP* 38924 . -39237) (PPT 39239 . 39558) (PRETTYPRINT 39560 . 42712) (PRETTYPRINT1 42714 . 44600) (PRETTYPRINT2 -44602 . 45918) (PRETTYPRINT3 45920 . 46875) (PRINTDEF1 46877 . 47813) (SUPERPRINTEQ 47815 . 47909) ( -SUPERPRINTGETPROP 47911 . 48055) (CHANGEFONT 48057 . 48567)) (48570 53916 (READARRAY 48580 . 49506) ( -PRINTARRAY 49508 . 51248) (READARRAY-FROM-LIST 51250 . 52355) (PRINTARRAY-TO-LIST 52357 . 53914)) ( -54043 61561 (PRINTCOPYRIGHT 54053 . 58130) (PRINTCOPYRIGHT1 58132 . 61256) (SAVECOPYRIGHT 61258 . -61559))))) + (FILEMAP (NIL (5565 48217 (PRETTYDEF 5575 . 21248) (PRETTYDEFCOMS 21250 . 21932) (PRETTYDEF0 21934 . +22125) (PRETTYDEF1 22127 . 23890) (PRINTDATE 23892 . 25128) (PRINTDATE1 25130 . 26908) (PRINTFNS 26910 + . 27479) (PRETTYCOM 27481 . 33822) (PRETTYVAR 33824 . 34862) (PRETTYVAR1 34864 . 37082) (PRETTYCOM1 +37084 . 37788) (ENDFILE 37790 . 37886) (MAKEDEFLIST 37888 . 38292) (PP 38294 . 38570) (PP* 38572 . +38885) (PPT 38887 . 39206) (PRETTYPRINT 39208 . 42360) (PRETTYPRINT1 42362 . 44248) (PRETTYPRINT2 +44250 . 45566) (PRETTYPRINT3 45568 . 46523) (PRINTDEF1 46525 . 47461) (SUPERPRINTEQ 47463 . 47557) ( +SUPERPRINTGETPROP 47559 . 47703) (CHANGEFONT 47705 . 48215)) (48218 53564 (READARRAY 48228 . 49154) ( +PRINTARRAY 49156 . 50896) (READARRAY-FROM-LIST 50898 . 52003) (PRINTARRAY-TO-LIST 52005 . 53562)) ( +53691 61209 (PRINTCOPYRIGHT 53701 . 57778) (PRINTCOPYRIGHT1 57780 . 60904) (SAVECOPYRIGHT 60906 . +61207))))) STOP diff --git a/sources/PRETTY.LCOM b/sources/PRETTY.LCOM index 02e7d893ab0d06249d421da162082c2592724834..e71a4c9cc15c1e6eecb4be4ec466771766ef99c1 100644 GIT binary patch delta 391 zcmZ4bj`8ms#t9MiCc2IVMY=`?My3izMplNFRwl+u3K~ku`MCv|IjJcM`FRRT3f1Ah zt}Z^Vk+n9(`K3k4sl|2yL9QVok$TofrkV;|N=8Vg7+P2v7+aYdC@CZrrNWI#&PdEl zPc2rpQpn3M$;ix0SI7h!>=s(@V@;Jbxis87eO#S`TpdGP zT@+C4M)&}qixtdF4UEkdtXy3@Lris@A{B~qvlXnIJskbqU4wN){1r699D{-txFCLX z_V*3eRImba!aV&$gLPei)=t)Cl$6FDCMKJIFq$Vb`ffHzb>!yrb#@Nc)C4*^D8Mn$ TezJk8{N{NDB5W*vo<3XvV+UK~BOz6o%7{i+TcgFS9UoQPP=GprdI-C{V@Hlo4TBVG>E&4k?h>7{dYFn0N+H zzyZ9FaqG&&nT?vb(akr>TYT@I|9!k_&u`k}WJ}D8q%?^|Y``vcZ0ghyRM1Rh%SFoP zAaX!(*BPDPAK!?KdudV>rMF1EjL%bEdMmLhW_;yEvCr7FdPE!pbc7q$|ZO4snyQLR=H%#*bY^h-`^6gQBeSGvK#Z^wR% z`JJZ+?O^-&&^FW^$FhL>oq(CAQ$T5!A<${N-wJ#F$YevPbi)xuaS*bO+<*DPSynE3aGi|bapSSkq<1SD3R+Z?IMe#6F+f~QV z9!AqR==GVr)0pQQ4u>$|g}8;bD3+o~)(ep%VDg~Nnu4QHS7<0S6