github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-27 09:28:48 +00:00
Code Issues Projects Releases Wiki Activity

Rmk51 end game of external format integration (#814)

Browse Source 
* Compile device-creation functions for new default interface

* UNICODE:  minor bug

* LLINTERP: MOVD? APPLY* to SPREADAPPLY*

* External format interface: a few more adjustments

* CLSTREAMS: Recompile, no source change

* PRETTYFILEINDEX: suppress when printing gitmaps to a non-display stream

* UNIXCOMM: Default format comes from device

Also, I seemed to have reverted back to LCOM with FAKE-COMPILE-FILE
This commit is contained in:
rmkaplan
2022-07-03 18:49:04 -07:00
committed by GitHub
parent f86be45834
commit d7ca40ebeb
28 changed files with 1037 additions and 802 deletions
Download Patch File Download Diff File Expand all files Collapse all files

69
library/TEXTOFD
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Jun-2022 21:25:47" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEXTOFD.;20 183270
(FILECREATED " 3-Jul-2022 00:35:48" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEXTOFD.;22 183404
:CHANGES-TO (FNS OPENTEXTSTREAM)
:CHANGES-TO (FNS \TEXTINIT)
:PREVIOUS-DATE " 4-Jun-2022 15:43:05"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEXTOFD.;19)
:PREVIOUS-DATE " 2-Jul-2022 23:48:56"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEXTOFD.;21)
(* ; "
@@ -686,7 +686,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(RETURN PC])
(\TEXTINIT
[LAMBDA NIL (* ; "Edited 5-May-2022 15:12 by rmk")
[LAMBDA NIL (* ; "Edited 3-Jul-2022 00:34 by rmk")
(* ; "Edited 5-May-2022 15:12 by rmk")
(* ; "Edited 7-Oct-2021 08:40 by rmk:")
(* ;
 "Create the FDEV and STREAM prototypes for TEXT streams.")
@@ -724,6 +725,12 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
IMCHARWIDTH _ (FUNCTION \TEXTDSPCHARWIDTH)
IMSTRINGWIDTH _ (FUNCTION \TEXTDSPSTRINGWIDTH)
IMSCALE _ (FUNCTION (LAMBDA NIL 1]
(* ;; "Maybe more functions later?")
(MAKE-EXTERNALFORMAT :TEDIT NIL NIL NIL (FUNCTION \TEDITOUTCCODEFN)
NIL
'CR NIL NIL T)
(SETQ \TEXTFDEV (create FDEV
DEVICENAME _ 'TEXT
RESETABLE _ T
@@ -756,7 +763,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
FDBOUTABLE _ NIL
FDEXTENDABLE _ NIL
TRUNCATEFILE _ (FUNCTION NILL)
WRITEPAGES _ (FUNCTION NILL)))
WRITEPAGES _ (FUNCTION NILL)
DEFAULTEXTERNALFORMAT _ :TEDIT))
(* ;; "The prototypical Text stream")
@@ -778,13 +786,6 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
IMAGEOPS _ \TEXTIMAGEOPS
IMAGEDATA _ (create TEXTIMAGEDATA)))
(* ;; "Maybe more functions later?")
(MAKE-EXTERNALFORMAT :TEDIT NIL NIL NIL (FUNCTION \TEDITOUTCCODEFN)
NIL
'CR)
(\EXTERNALFORMAT \TEXTOFD :TEDIT)
(* ;; "Set up so that FILE NOT OPENs on TEdit streams are caught and fixed.")
(CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
@@ -2732,25 +2733,25 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(PUTPROPS TEXTOFD COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989
1990 1991 1993 1994 1995 1999 2000 2001 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2996 53635 (COPYTEXTSTREAM 3006 . 6128) (OPENTEXTSTREAM 6130 . 21397) (REOPENTEXTSTREAM
21399 . 21821) (TEDIT.STREAMCHANGEDP 21823 . 22121) (TEXTSTREAMP 22123 . 22437) (TXTFILE 22439 .
22884) (\DELETECH 22886 . 34142) (\SETUPGETCH 34144 . 41423) (\TEDIT.REOPEN.STREAM 41425 . 43275) (
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 43277 . 45715) (\TEXTINIT 45717 . 51528) (\TEXTMARK 51530 . 52278) (
\TEXTTTYBOUT 52280 . 53633)) (53636 79068 (\INSERTCH 53646 . 77372) (\INSERTCR 77374 . 79066)) (79134
99450 (\CHTOPC 79144 . 80333) (\CHTOPCNO 80335 . 81597) (\CLEARPCTB 81599 . 82395) (
\CREATEPIECEORSTREAM 82397 . 85371) (\DELETEPIECE 85373 . 86286) (\FINDPIECE 86288 . 86654) (
\INSERTPIECE 86656 . 89666) (\MAKEPCTB 89668 . 91583) (\SPLITPIECE 91585 . 98544) (\INSERT.FIRST.PIECE
98546 . 99448)) (99502 123740 (\TEXTCLOSEF 99512 . 100739) (\TEXTCLOSEF-SUBTREE 100741 . 101447) (
\TEXTDSPFONT 101449 . 102441) (\TEXTEOFP 102443 . 103802) (\TEXTGETEOFPTR 103804 . 104014) (
\TEXTGETFILEPTR 104016 . 106079) (\TEXTOPENF 106081 . 106911) (\TEXTOPENF-SUBTREE 106913 . 107714) (
\TEXTOUTCHARFN 107716 . 108064) (\TEXTBACKFILEPTR 108066 . 113967) (\TEXTBOUT 113969 . 117317) (
\TEDITOUTCCODEFN 117319 . 118585) (\TEXTSETEOF 118587 . 119096) (\TEXTSETFILEPTR 119098 . 120323) (
\TEXTDSPXPOSITION 120325 . 121182) (\TEXTDSPYPOSITION 121184 . 121729) (\TEXTLEFTMARGIN 121731 .
122214) (\TEXTRIGHTMARGIN 122216 . 123152) (\TEXTDSPCHARWIDTH 123154 . 123392) (\TEXTDSPSTRINGWIDTH
123394 . 123634) (\TEXTDSPLINEFEED 123636 . 123738)) (123741 161578 (\TEXTBIN 123751 . 144630) (
\TEDIT.TEXTBIN.STRINGSETUP 144632 . 150345) (\TEDIT.TEXTBIN.FILESETUP 150347 . 156733) (
\TEDIT.TEXTBIN.NEW.PAGE 156735 . 161576)) (161579 177341 (\TEXTPEEKBIN 161589 . 173082) (
\TEDIT.PEEKBIN.NEW.PAGE 173084 . 177339)) (177379 182597 (CGETTEXTPROP 177389 . 177865) (CTEXTPROP
177867 . 180211) (GETTEXTPROP 180213 . 180808) (PUTTEXTPROP 180810 . 182135) (TEXTPROP 182137 . 182595
(FILEMAP (NIL (2991 53769 (COPYTEXTSTREAM 3001 . 6123) (OPENTEXTSTREAM 6125 . 21392) (REOPENTEXTSTREAM
21394 . 21816) (TEDIT.STREAMCHANGEDP 21818 . 22116) (TEXTSTREAMP 22118 . 22432) (TXTFILE 22434 .
22879) (\DELETECH 22881 . 34137) (\SETUPGETCH 34139 . 41418) (\TEDIT.REOPEN.STREAM 41420 . 43270) (
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 43272 . 45710) (\TEXTINIT 45712 . 51662) (\TEXTMARK 51664 . 52412) (
\TEXTTTYBOUT 52414 . 53767)) (53770 79202 (\INSERTCH 53780 . 77506) (\INSERTCR 77508 . 79200)) (79268
99584 (\CHTOPC 79278 . 80467) (\CHTOPCNO 80469 . 81731) (\CLEARPCTB 81733 . 82529) (
\CREATEPIECEORSTREAM 82531 . 85505) (\DELETEPIECE 85507 . 86420) (\FINDPIECE 86422 . 86788) (
\INSERTPIECE 86790 . 89800) (\MAKEPCTB 89802 . 91717) (\SPLITPIECE 91719 . 98678) (\INSERT.FIRST.PIECE
98680 . 99582)) (99636 123874 (\TEXTCLOSEF 99646 . 100873) (\TEXTCLOSEF-SUBTREE 100875 . 101581) (
\TEXTDSPFONT 101583 . 102575) (\TEXTEOFP 102577 . 103936) (\TEXTGETEOFPTR 103938 . 104148) (
\TEXTGETFILEPTR 104150 . 106213) (\TEXTOPENF 106215 . 107045) (\TEXTOPENF-SUBTREE 107047 . 107848) (
\TEXTOUTCHARFN 107850 . 108198) (\TEXTBACKFILEPTR 108200 . 114101) (\TEXTBOUT 114103 . 117451) (
\TEDITOUTCCODEFN 117453 . 118719) (\TEXTSETEOF 118721 . 119230) (\TEXTSETFILEPTR 119232 . 120457) (
\TEXTDSPXPOSITION 120459 . 121316) (\TEXTDSPYPOSITION 121318 . 121863) (\TEXTLEFTMARGIN 121865 .
122348) (\TEXTRIGHTMARGIN 122350 . 123286) (\TEXTDSPCHARWIDTH 123288 . 123526) (\TEXTDSPSTRINGWIDTH
123528 . 123768) (\TEXTDSPLINEFEED 123770 . 123872)) (123875 161712 (\TEXTBIN 123885 . 144764) (
\TEDIT.TEXTBIN.STRINGSETUP 144766 . 150479) (\TEDIT.TEXTBIN.FILESETUP 150481 . 156867) (
\TEDIT.TEXTBIN.NEW.PAGE 156869 . 161710)) (161713 177475 (\TEXTPEEKBIN 161723 . 173216) (
\TEDIT.PEEKBIN.NEW.PAGE 173218 . 177473)) (177513 182731 (CGETTEXTPROP 177523 . 177999) (CTEXTPROP
178001 . 180345) (GETTEXTPROP 180347 . 180942) (PUTTEXTPROP 180944 . 182269) (TEXTPROP 182271 . 182729
)))))
STOP

BIN
library/TEXTOFD.LCOM
View File

Binary file not shown.

70
library/UNICODE
View File

@@ -1,9 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Sep-2021 16:03:18" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;194 64783
previous date%: "21-Aug-2021 13:13:04"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;193)
(FILECREATED "28-Jun-2022 00:02:58" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNICODE.;195 64708
:CHANGES-TO (FNS NUTF8CODEBYTES)
:PREVIOUS-DATE "30-Sep-2021 16:03:18"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNICODE.;194)
(PRETTYCOMPRINT UNICODECOMS)
@@ -469,17 +472,15 @@
(DECLARE%: EVAL@COMPILE
(PUTPROPS UNICODE.TRANSLATE MACRO [OPENLAMBDA (CODE TRANSLATION-TABLE)
(LET [(X (CL:SVREF TRANSLATION-TABLE (LRSH CODE
TRANSLATION-SHIFT
]
(COND
((LISTP X)
(OR (CDR (FASSOC (LOGAND CODE TRANSLATION-SHIFT)
X))
CODE))
[(AND X (CL:SVREF X (LOGAND CODE TRANSLATION-MASK
(LET [(X (CL:SVREF TRANSLATION-TABLE (LRSH CODE TRANSLATION-SHIFT
]
(T (UNICODE.UNMAPPED CODE TRANSLATION-TABLE])
(COND
((LISTP X)
(OR (CDR (FASSOC (LOGAND CODE TRANSLATION-SHIFT)
X))
CODE))
[(AND X (CL:SVREF X (LOGAND CODE TRANSLATION-MASK]
(T (UNICODE.UNMAPPED CODE TRANSLATION-TABLE])
)
)
(DEFINEQ
@@ -832,7 +833,7 @@
(RPAQ? UNICODEDIRECTORIES NIL)
(PUSHNEW UNICODEDIRECTORIES (PACK* (UNIX-GETENV "MEDLEYDIR")
'/unicode/xerox/))
'/unicode/xerox/))
@@ -983,7 +984,7 @@
)
(RPAQ? DEFAULT-XCCS-CHARSETS '(LATIN SYMBOLS1 SYMBOLS2 EXTENDED-LATIN FORMS SYMBOLS3 SYMBOLS4
ACCENTED-LATIN GREEK))
ACCENTED-LATIN GREEK))
(DECLARE%: DONTEVAL@LOAD DOCOPY
(MAKE-UNICODE-TRANSLATION-TABLES (READ-UNICODE-MAPPING DEFAULT-XCCS-CHARSETS T)
@@ -1059,21 +1060,22 @@
ELSE (ERROR "CHARCODE too big for UTF8" CHARCODE])
(NUTF8CODEBYTES
[LAMBDA (N) (* ; "Edited 10-Aug-2020 12:35 by rmk:")
[LAMBDA (N) (* ; "Edited 28-Jun-2022 00:02 by rmk")
(* ; "Edited 10-Aug-2020 12:35 by rmk:")
(* ;; "Returns the number of bytes needed to encode N in UTF8, ")
(IF (ILESSP N 128)
THEN 1
ELSEIF (ILESSP N 2048)
THEN (* ; "x800")
4
THEN (* ; "x800")
2
ELSEIF (ILESSP N 65536)
THEN (* ; "x10000")
3
THEN (* ; "x10000")
3
ELSEIF (ILESSP N 2097152)
THEN (* ; "x200000")
2
THEN (* ; "x200000")
4
ELSE (SHOULDNT])
(NUTF8STRINGBYTES
@@ -1205,15 +1207,15 @@
)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4046 17726 (UTF8.OUTCHARFN 4056 . 6887) (UTF8.INCCODEFN 6889 . 12379) (UTF8.PEEKCCODEFN
12381 . 17155) (\UTF8.BACKCCODEFN 17157 . 17724)) (17727 21053 (UTF16BE.OUTCHARFN 17737 . 18561) (
UTF16BE.INCCODEFN 18563 . 19462) (UTF16BE.PEEKCCODEFN 19464 . 20535) (\UTF16.BACKCCODEFN 20537 . 21051
)) (21083 22891 (MAKE-UNICODE-FORMATS 21093 . 22889)) (22988 24294 (UNICODE.UNMAPPED 22998 . 24292)) (
24295 24831 (XCCS-UTF8-AFTER-OPEN 24305 . 24829)) (25901 26250 (XTOUCODE 25911 . 26079) (UTOXCODE
26081 . 26248)) (26290 42412 (READ-UNICODE-MAPPING-FILENAMES 26300 . 27401) (READ-UNICODE-MAPPING
27403 . 30701) (WRITE-UNICODE-MAPPING 30703 . 34920) (WRITE-UNICODE-INCLUDED 34922 . 39644) (
WRITE-UNICODE-MAPPING-HEADER 39646 . 40878) (WRITE-UNICODE-MAPPING-FILENAME 40880 . 42410)) (45749
54228 (MAKE-UNICODE-TRANSLATION-TABLES 45759 . 54226)) (54649 62553 (HEXSTRING 54659 . 55820) (
UTF8HEXSTRING 55822 . 58027) (NUTF8CODEBYTES 58029 . 58692) (NUTF8STRINGBYTES 58694 . 59175) (
XTOUSTRING 59177 . 62188) (XCCSSTRING 62190 . 62551)) (62554 64023 (SHOWCHARS 62564 . 64021)))))
(FILEMAP (NIL (4094 17774 (UTF8.OUTCHARFN 4104 . 6935) (UTF8.INCCODEFN 6937 . 12427) (UTF8.PEEKCCODEFN
12429 . 17203) (\UTF8.BACKCCODEFN 17205 . 17772)) (17775 21101 (UTF16BE.OUTCHARFN 17785 . 18609) (
UTF16BE.INCCODEFN 18611 . 19510) (UTF16BE.PEEKCCODEFN 19512 . 20583) (\UTF16.BACKCCODEFN 20585 . 21099
)) (21131 22939 (MAKE-UNICODE-FORMATS 21141 . 22937)) (23036 24342 (UNICODE.UNMAPPED 23046 . 24340)) (
24343 24879 (XCCS-UTF8-AFTER-OPEN 24353 . 24877)) (25712 26061 (XTOUCODE 25722 . 25890) (UTOXCODE
25892 . 26059)) (26101 42223 (READ-UNICODE-MAPPING-FILENAMES 26111 . 27212) (READ-UNICODE-MAPPING
27214 . 30512) (WRITE-UNICODE-MAPPING 30514 . 34731) (WRITE-UNICODE-INCLUDED 34733 . 39455) (
WRITE-UNICODE-MAPPING-HEADER 39457 . 40689) (WRITE-UNICODE-MAPPING-FILENAME 40691 . 42221)) (45556
54035 (MAKE-UNICODE-TRANSLATION-TABLES 45566 . 54033)) (54452 62478 (HEXSTRING 54462 . 55623) (
UTF8HEXSTRING 55625 . 57830) (NUTF8CODEBYTES 57832 . 58617) (NUTF8STRINGBYTES 58619 . 59100) (
XTOUSTRING 59102 . 62113) (XCCSSTRING 62115 . 62476)) (62479 63948 (SHOWCHARS 62489 . 63946)))))
STOP

BIN
library/UNICODE.LCOM
View File

Binary file not shown.

141
library/UNIXCOMM
View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Jun-2022 16:45:04" {DSK}<home>larry>medley>library>UNIXCOMM.;42 20362
changes to%: (FNS CREATE-PROCESS-STREAM)
(VARS UNIXCOMMCOMS)
(FILECREATED " 3-Jul-2022 16:16:31" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNIXCOMM.;5 20396
previous date%: "26-Jun-2022 14:27:33" {DSK}<home>larry>medley>library>UNIXCOMM.;41)
:CHANGES-TO (FNS INITIALIZE-SHELL-DEVICE)
:PREVIOUS-DATE " 3-Jul-2022 16:05:06"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNIXCOMM.;3)
(* ; "
@@ -13,39 +15,37 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(PRETTYCOMPRINT UNIXCOMMCOMS)
(RPAQQ UNIXCOMMCOMS (
(* ;; "streams to UNIX processes & pseudo terminals")
(RPAQQ UNIXCOMMCOMS
(
(* ;; "streams to UNIX processes & pseudo terminals")
(* ;;
 "this stuff should really be implemented in terms of {SHELL} and {PTY} devices")
(* ;; "this stuff should really be implemented in terms of {SHELL} and {PTY} devices")
(COMS (* ; "Forking stuff")
(FNS FORK-SHELL FORK-UNIX UNIX-KILL UNIX-WRITE CREATE-SHELL-STREAM
CREATE-PROCESS-STREAM UNIXCOMM-AROUNDEXITFN))
[COMS (* ; "Operations on the shell device")
(FNS INITIALIZE-NEW-SHELL-DEVICE UNIX-GET-NEXT-BUFFER
UNIX-BACKFILEPTR-NEW UNIX-STREAM-EOFP-NEW UNIX-STREAM-OUT
UNIX-STREAM-CLOSE)
(GLOBALVARS *NEW-SHELL-DEVICE*)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-NEW-SHELL-DEVICE))
(ADDVARS (AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN]
(COMS (* ;
 "Stuff for direct manipulation of Unix sockets")
(FNS CREATE-UNIX-SOCKET-STREAM ACCEPT-UNIX-SOCKET-STREAM))
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNIX-CHANNEL)
(P (CHECKIMPORTS '(FILEIO LLSUBRS)
T)))
[COMS
(* ;; "Obsolete stuff. This is for pre-Medley1.2, where there wasn't support for buffered input on the shell device")
(COMS (* ; "Forking stuff")
(FNS FORK-SHELL FORK-UNIX UNIX-KILL UNIX-WRITE CREATE-SHELL-STREAM
CREATE-PROCESS-STREAM UNIXCOMM-AROUNDEXITFN))
[COMS (* ; "Operations on the shell device")
(FNS INITIALIZE-NEW-SHELL-DEVICE UNIX-GET-NEXT-BUFFER UNIX-BACKFILEPTR-NEW
UNIX-STREAM-EOFP-NEW UNIX-STREAM-OUT UNIX-STREAM-CLOSE)
(GLOBALVARS *NEW-SHELL-DEVICE*)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-NEW-SHELL-DEVICE))
(ADDVARS (AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN]
(COMS (* ;
 "Stuff for direct manipulation of Unix sockets")
(FNS CREATE-UNIX-SOCKET-STREAM ACCEPT-UNIX-SOCKET-STREAM))
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNIX-CHANNEL)
(P (CHECKIMPORTS '(FILEIO LLSUBRS)
T)))
[COMS
(* ;; "Obsolete stuff. This is for pre-Medley1.2, where there wasn't support for buffered input on the shell device")
(FNS UNIX-BACKFILEPTR UNIX-READ INITIALIZE-SHELL-DEVICE UNIX-STREAM-IN
UNIX-STREAM-EOFP UNIX-STREAM-PEEK)
(GLOBALVARS *SHELL-DEVICE*)
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNIX-PEEKEDCHAR UNIX-LASTCHAR
))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-SHELL-DEVICE]
(PROP FILETYPE UNIXCOMM)))
(FNS UNIX-BACKFILEPTR UNIX-READ INITIALIZE-SHELL-DEVICE UNIX-STREAM-IN UNIX-STREAM-EOFP
UNIX-STREAM-PEEK)
(GLOBALVARS *SHELL-DEVICE*)
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNIX-PEEKEDCHAR UNIX-LASTCHAR))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-SHELL-DEVICE]
(PROP FILETYPE UNIXCOMM)))
@@ -131,15 +131,21 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
STR])
(CREATE-PROCESS-STREAM
[LAMBDA (COMM) (* ; "Edited 26-Jun-2022 13:52 by larry")
(* ;
 "Edited 26-Jun-2022 13:31 by lmm - set external format of shell stream to utf-8 ??")
(* ; "Edited 21-May-90 15:39 by jrb:")
[LAMBDA (COMM)
(* ;; "Edited 3-Jul-2022 16:04 by rmk: Removed external format here, the device has the environmental defaultg")
(* ;; "Edited 26-Jun-2022 13:52 by larry")
(* ;; "Edited 26-Jun-2022 13:31 by lmm - set external format of shell stream to utf-8 ??")
(* ;; "Edited 21-May-90 15:39 by jrb:")
(LET* ((SHELL-DEV (if (AND (BOUNDP '*NEW-SHELL-DEVICE)
(SUBRCALL UNIX-HANDLECOMM 8))
then (* ;
 "SUBRCALL tests that this is supported")
*NEW-SHELL-DEVICE*
(SUBRCALL UNIX-HANDLECOMM 8))
then (* ;
 "SUBRCALL tests that this is supported")
*NEW-SHELL-DEVICE*
else *SHELL-DEVICE*))
(STR (create STREAM
ACCESS _ 'BOTH
@@ -148,15 +154,13 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(CHAN (FORK-UNIX COMM)))
(if CHAN
then (CL:SETF (UNIX-CHANNEL STR)
CHAN)
(AND (STRPOS ".UTF-8" (UNIX-GETENV "LANG"))
(\EXTERNALFORMAT STR ':UTF-8))
CHAN)
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
STR)
STR
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
STR)
STR
else NIL])
(UNIXCOMM-AROUNDEXITFN
@@ -183,7 +187,8 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(DEFINEQ
(INITIALIZE-NEW-SHELL-DEVICE
[LAMBDA NIL (* ; "Edited 12-Feb-90 17:00 by bvm")
[LAMBDA NIL (* ; "Edited 3-Jul-2022 16:04 by rmk")
(* ; "Edited 12-Feb-90 17:00 by bvm")
(SETQ *NEW-SHELL-DEVICE* (create FDEV
FDBINABLE _ T
NODIRECTORIES _ T
@@ -197,7 +202,10 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
EOFP _ (FUNCTION UNIX-STREAM-EOFP-NEW)
BACKFILEPTR _ (FUNCTION UNIX-BACKFILEPTR-NEW)
GETNEXTBUFFER _ (FUNCTION UNIX-GET-NEXT-BUFFER)
BLOCKIN _ (FUNCTION \BUFFERED.BINS])
BLOCKIN _ (FUNCTION \BUFFERED.BINS)
DEFAULTEXTERNALFORMAT _ (AND (STRPOS ".UTF-8" (UNIX-GETENV "LANG"
))
:UTF-8])
(UNIX-GET-NEXT-BUFFER
[LAMBDA (STREAM WHATFOR NOERRORFLG) (* ;
@@ -329,7 +337,7 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(PUTPROPS UNIX-CHANNEL MACRO ((STR)
(PUTPROPS UNIX-CHANNEL MACRO ((STR)
(fetch (STREAM F1) of STR)))
)
@@ -375,7 +383,8 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
CH])
(INITIALIZE-SHELL-DEVICE
[LAMBDA NIL (* ; "Edited 14-Dec-88 10:45 by bane")
[LAMBDA NIL (* ; "Edited 3-Jul-2022 16:15 by rmk")
(* ; "Edited 14-Dec-88 10:45 by bane")
(SETQ *SHELL-DEVICE* (create FDEV
NODIRECTORIES _ T
DEVICENAME _ 'UNIX-PTY
@@ -386,7 +395,9 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
GETFILEINFO _ 'NILL
SETFILEINFO _ 'NILL
EOFP _ 'UNIX-STREAM-EOFP
BACKFILEPTR _ 'UNIX-BACKFILEPTR])
BACKFILEPTR _ 'UNIX-BACKFILEPTR
DEFAULTEXTERNALFORMAT _ (AND (STRPOS ".UTF-8" (UNIX-GETENV "LANG"))
:UTF-8])
(UNIX-STREAM-IN
[LAMBDA (STREAM) (* ; "Edited 9-May-88 15:05 by ")
@@ -430,10 +441,10 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(PUTPROPS UNIX-PEEKEDCHAR MACRO ((STR)
(PUTPROPS UNIX-PEEKEDCHAR MACRO ((STR)
(FETCH (STREAM F2) OF STR)))
(PUTPROPS UNIX-LASTCHAR MACRO ((STR)
(PUTPROPS UNIX-LASTCHAR MACRO ((STR)
(FETCH (STREAM F3) OF STR)))
)
)
@@ -442,15 +453,15 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
(INITIALIZE-SHELL-DEVICE)
)
(PUTPROPS UNIXCOMM FILETYPE FAKE-COMPILE-FILE)
(PUTPROPS UNIXCOMM FILETYPE FAKE-COMPILE-FILE)
(PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2975 9114 (FORK-SHELL 2985 . 4182) (FORK-UNIX 4184 . 4360) (UNIX-KILL 4362 . 4551) (
UNIX-WRITE 4553 . 5264) (CREATE-SHELL-STREAM 5266 . 6582) (CREATE-PROCESS-STREAM 6584 . 8211) (
UNIXCOMM-AROUNDEXITFN 8213 . 9112)) (9162 14150 (INITIALIZE-NEW-SHELL-DEVICE 9172 . 10265) (
UNIX-GET-NEXT-BUFFER 10267 . 12467) (UNIX-BACKFILEPTR-NEW 12469 . 12948) (UNIX-STREAM-EOFP-NEW 12950
. 13496) (UNIX-STREAM-OUT 13498 . 13754) (UNIX-STREAM-CLOSE 13756 . 14148)) (14406 16271 (
CREATE-UNIX-SOCKET-STREAM 14416 . 15277) (ACCEPT-UNIX-SOCKET-STREAM 15279 . 16269)) (16612 19791 (
UNIX-BACKFILEPTR 16622 . 17120) (UNIX-READ 17122 . 17644) (INITIALIZE-SHELL-DEVICE 17646 . 18385) (
UNIX-STREAM-IN 18387 . 18763) (UNIX-STREAM-EOFP 18765 . 19539) (UNIX-STREAM-PEEK 19541 . 19789)))))
(FILEMAP (NIL (2488 8459 (FORK-SHELL 2498 . 3695) (FORK-UNIX 3697 . 3873) (UNIX-KILL 3875 . 4064) (
UNIX-WRITE 4066 . 4777) (CREATE-SHELL-STREAM 4779 . 6095) (CREATE-PROCESS-STREAM 6097 . 7556) (
UNIXCOMM-AROUNDEXITFN 7558 . 8457)) (8507 13875 (INITIALIZE-NEW-SHELL-DEVICE 8517 . 9990) (
UNIX-GET-NEXT-BUFFER 9992 . 12192) (UNIX-BACKFILEPTR-NEW 12194 . 12673) (UNIX-STREAM-EOFP-NEW 12675 .
13221) (UNIX-STREAM-OUT 13223 . 13479) (UNIX-STREAM-CLOSE 13481 . 13873)) (14131 15996 (
CREATE-UNIX-SOCKET-STREAM 14141 . 15002) (ACCEPT-UNIX-SOCKET-STREAM 15004 . 15994)) (16345 19805 (
UNIX-BACKFILEPTR 16355 . 16853) (UNIX-READ 16855 . 17377) (INITIALIZE-SHELL-DEVICE 17379 . 18399) (
UNIX-STREAM-IN 18401 . 18777) (UNIX-STREAM-EOFP 18779 . 19553) (UNIX-STREAM-PEEK 19555 . 19803)))))
STOP

BIN
library/UNIXCOMM.DFASL
View File

Binary file not shown.

BIN
library/UNIXCOMM.LCOM Normal file
View File

Binary file not shown.

179
lispusers/PRETTYFILEINDEX
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-May-2022 23:33:03" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PRETTYFILEINDEX.;10 96446
(FILECREATED " 3-Jul-2022 15:28:08" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;11 100587
:CHANGES-TO (FNS PFI.PRINT.COMMENTS PFI.MAYBE.NEW.PAGE PFI.MAYBE.PP.DEFINITION
PFI.PRINT.FILECREATED PFI.MAYBE.SEE.PRETTY PRETTYFILEINDEX PFI.PRINT.TO.TAB)
:CHANGES-TO (FNS PFI.PRINT.BITMAP)
:PREVIOUS-DATE "30-Nov-2021 22:12:37"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PRETTYFILEINDEX.;6)
:PREVIOUS-DATE " 5-May-2022 23:33:03"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;10)
(* ; "
@@ -887,8 +886,124 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
(DEFINEQ
(PFI.PRINT.BITMAP
(LAMBDA (BM STREAM) (* ; "Edited 14-Apr-88 12:44 by bvm") (* ;; "DEFPRINT function for bitmaps that displays the actual bitmap when going to an image stream.") (if (OR (NULL *PRINT-ARRAY*) (NULL *PRINT-PRETTY-BITMAPS*)) then (* ; "do the clunky way") (NON.PFI.PRINT.BITMAP BM STREAM) elseif (IMAGESTREAMP STREAM) then (PROG ((CURX (DSPXPOSITION NIL STREAM)) (CURY (DSPYPOSITION NIL STREAM)) (UNITS (DSPSCALE NIL STREAM)) (LINEHEIGHT (DSPLINEFEED NIL STREAM)) HEIGHT WIDTH MINX NLINESDOWN BOTTOM BMARG BELOWBASELINE SCALE RATIO) (if (NOT (AND CURX CURY UNITS LINEHEIGHT)) then (* ; "Stream doesn't really support it") (RETURN (NON.PFI.PRINT.BITMAP BM STREAM))) (SETQ HEIGHT (TIMES UNITS (BITMAPHEIGHT BM))) (SETQ WIDTH (TIMES UNITS (BITMAPWIDTH BM))) (SETQ BMARG (DSPBOTTOMMARGIN NIL STREAM)) (if (AND (NOT (DISPLAYSTREAMP STREAM)) (< (SETQ RATIO (MIN (FQUOTIENT (- (DSPRIGHTMARGIN NIL STREAM) (DSPLEFTMARGIN NIL STREAM)) (TIMES WIDTH 1.5)) (FQUOTIENT (- (DSPTOPMARGIN NIL STREAM) BMARG) (TIMES HEIGHT 1.5)))) 1.0)) then (* ; "It takes up more than 2/3 the page in some dimension. This code is tuned for Interpress.") (SETQ SCALE (if (> RATIO 0.75) then 0.75 elseif (> RATIO 0.5) then 0.5 elseif (> RATIO 0.25) then 0.25 else RATIO)) (SETQ HEIGHT (FIXR (TIMES SCALE HEIGHT))) (SETQ WIDTH (FIXR (TIMES SCALE WIDTH)))) (if (> CURX (SETQ MINX (- (DSPRIGHTMARGIN NIL STREAM) WIDTH))) then (* ; "Won't fit between here and margin, so start nwe line") (TERPRI STREAM) (SETQ CURX (MAX MINX 0)) (SETQ CURY (DSPYPOSITION NIL STREAM))) (SETQ BELOWBASELINE (MAX 0 (- HEIGHT (FONTPROP STREAM (QUOTE ASCENT))))) (if BMARG then (* ; "We know stream's bottom margin, so can be reasonable") (if (< (- CURY BELOWBASELINE) BMARG) then (* ; "Won't fit on page") (DSPNEWPAGE STREAM) (SETQ CURY (DSPYPOSITION NIL STREAM)) (SETQ *PFI-BITMAP-BASELINE* NIL)) else (* ; "Have to use silly terpri method") (SETQ NLINESDOWN (IQUOTIENT HEIGHT (SETQ LINEHEIGHT (- LINEHEIGHT)))) (to NLINESDOWN do (* ; "Do enough cr's so that we have space for bitmap. This might cause scrolling, for example") (TERPRI STREAM) finally (* ; "If this was display, terpri may have scrolled, and Y changed out from under us") (SETQ CURY (+ (DSPYPOSITION NIL STREAM) (TIMES NLINESDOWN LINEHEIGHT))))) (SETQ BOTTOM (- CURY BELOWBASELINE)) (* ; "BOTTOM computed so that bitmap top lines up with font top") (SCALEDBITBLT BM 0 0 STREAM CURX BOTTOM WIDTH HEIGHT (QUOTE INPUT) (QUOTE REPLACE) NIL NIL SCALE) (MOVETO (+ CURX WIDTH) (if (AND (< BOTTOM CURY) (EQ *PRINT-PRETTY-BITMAPS* (QUOTE PRETTYFILEINDEX)) *PFI-FUNNY-CHARS*) then (* ; "Don't move the baseline down, just remember it for when we hit end of line") (if (OR (NULL *PFI-BITMAP-BASELINE*) (< BOTTOM *PFI-BITMAP-BASELINE*)) then (* ; "Lower than before, or first time") (SETQ *PFI-BITMAP-BASELINE* BOTTOM) (if (NEQ (fetch (STREAM OUTCHARFN) of STREAM) (FUNCTION PFI.OUTCHARFN)) then (* ; "Also have to %"advise%" the outcharfn to notice terpri") (replace (STREAM OUTCHARFN) of STREAM with (FUNCTION PFI.OUTCHARFN)))) CURY else (* ; "Move baseline down to bitmap baseline") BOTTOM) STREAM) (RETURN T)) else (LET ((POS (AND (EQ *PRINT-PRETTY-BITMAPS* (QUOTE PRETTYFILEINDEX)) (PNAMESTREAMP STREAM) (STKPOS (QUOTE STRINGWIDTH)))) IMSTREAM) (if (AND POS (IMAGESTREAMP (SETQ IMSTREAM (STKEVAL POS (QUOTE *STANDARD-OUTPUT*) T)))) then (* ;; "Big kludge: This is somebody in the prettyprinter trying to figure out the width of the bitmap--fake them out by printing something about the width of the bitmap. IMSTREAM is the stream to which the real output will go. To be conservative, only do this under PRETTYFILEINDEX.") (RPTQ (CL:CEILING (TIMES (DSPSCALE NIL IMSTREAM) (BITMAPWIDTH BM)) (CHARWIDTH (CHARCODE X) IMSTREAM)) (\OUTCHAR STREAM (CHARCODE X))) T else (NON.PFI.PRINT.BITMAP BM STREAM)))))
)
[LAMBDA (BM STREAM)
(* ;;
 "Edited 3-Jul-2022 15:28 by rmk: Use vertical size in RATIO only if bottom and top margins exists")
(* ;; "Edited 3-Jul-2022 15:24 by rmk")
(* ;; "Edited 14-Apr-88 12:44 by bvm")
(* ;;
 "DEFPRINT function for bitmaps that displays the actual bitmap when going to an image stream.")
(if (OR (NULL *PRINT-ARRAY*)
(NULL *PRINT-PRETTY-BITMAPS*))
then (* ; "do the clunky way")
(NON.PFI.PRINT.BITMAP BM STREAM)
elseif (IMAGESTREAMP STREAM)
then (PROG ((CURX (DSPXPOSITION NIL STREAM))
(CURY (DSPYPOSITION NIL STREAM))
(UNITS (DSPSCALE NIL STREAM))
(LINEHEIGHT (DSPLINEFEED NIL STREAM))
HEIGHT WIDTH MINX NLINESDOWN BOTTOM BMARG BELOWBASELINE SCALE RATIO)
(if (NOT (AND CURX CURY UNITS LINEHEIGHT))
then (* ; "Stream doesn't really support it")
(RETURN (NON.PFI.PRINT.BITMAP BM STREAM)))
(SETQ HEIGHT (TIMES UNITS (BITMAPHEIGHT BM)))
(SETQ WIDTH (TIMES UNITS (BITMAPWIDTH BM)))
(SETQ BMARG (DSPBOTTOMMARGIN NIL STREAM))
[if (AND (NOT (DISPLAYSTREAMP STREAM))
(< (SETQ RATIO (MIN (FQUOTIENT (- (DSPRIGHTMARGIN NIL STREAM)
(DSPLEFTMARGIN NIL STREAM))
(TIMES WIDTH 1.5))
(CL:IF (AND BMARG (DSPTOPMARGIN NIL STREAM))
(FQUOTIENT (- (DSPTOPMARGIN NIL STREAM)
BMARG)
(TIMES HEIGHT 1.5))
MAX.SMALLP)))
1.0))
then (* ;
 "It takes up more than 2/3 the page in some dimension. This code is tuned for Interpress.")
(SETQ SCALE (if (> RATIO 0.75)
then 0.75
elseif (> RATIO 0.5)
then 0.5
elseif (> RATIO 0.25)
then 0.25
else RATIO))
(SETQ HEIGHT (FIXR (TIMES SCALE HEIGHT)))
(SETQ WIDTH (FIXR (TIMES SCALE WIDTH]
(if (> CURX (SETQ MINX (- (DSPRIGHTMARGIN NIL STREAM)
WIDTH)))
then (* ;
 "Won't fit between here and margin, so start nwe line")
(TERPRI STREAM)
(SETQ CURX (MAX MINX 0))
(SETQ CURY (DSPYPOSITION NIL STREAM)))
[SETQ BELOWBASELINE (MAX 0 (- HEIGHT (FONTPROP STREAM 'ASCENT]
[if BMARG
then (* ;
 "We know stream's bottom margin, so can be reasonable")
(if (< (- CURY BELOWBASELINE)
BMARG)
then (* ; "Won't fit on page")
(DSPNEWPAGE STREAM)
(SETQ CURY (DSPYPOSITION NIL STREAM))
(SETQ *PFI-BITMAP-BASELINE* NIL))
else (* ; "Have to use silly terpri method")
[SETQ NLINESDOWN (IQUOTIENT HEIGHT (SETQ LINEHEIGHT (- LINEHEIGHT]
(to NLINESDOWN do (* ;
 "Do enough cr's so that we have space for bitmap. This might cause scrolling, for example")
(TERPRI STREAM) finally
(* ;
 "If this was display, terpri may have scrolled, and Y changed out from under us")
(SETQ CURY (+ (DSPYPOSITION NIL
STREAM)
(TIMES NLINESDOWN
LINEHEIGHT]
(SETQ BOTTOM (- CURY BELOWBASELINE)) (* ;
 "BOTTOM computed so that bitmap top lines up with font top")
(SCALEDBITBLT BM 0 0 STREAM CURX BOTTOM WIDTH HEIGHT 'INPUT 'REPLACE NIL NIL SCALE
)
(MOVETO (+ CURX WIDTH)
(if (AND (< BOTTOM CURY)
(EQ *PRINT-PRETTY-BITMAPS* 'PRETTYFILEINDEX)
*PFI-FUNNY-CHARS*)
then (* ;
 "Don't move the baseline down, just remember it for when we hit end of line")
[if (OR (NULL *PFI-BITMAP-BASELINE*)
(< BOTTOM *PFI-BITMAP-BASELINE*))
then (* ; "Lower than before, or first time")
(SETQ *PFI-BITMAP-BASELINE* BOTTOM)
(if (NEQ (fetch (STREAM OUTCHARFN) of STREAM)
(FUNCTION PFI.OUTCHARFN))
then (* ;
 "Also have to %"advise%" the outcharfn to notice terpri")
(replace (STREAM OUTCHARFN) of STREAM
with (FUNCTION PFI.OUTCHARFN]
CURY
else (* ;
 "Move baseline down to bitmap baseline")
BOTTOM)
STREAM)
(RETURN T))
else (LET ([POS (AND (EQ *PRINT-PRETTY-BITMAPS* 'PRETTYFILEINDEX)
(PNAMESTREAMP STREAM)
(STKPOS 'STRINGWIDTH]
IMSTREAM)
(if [AND POS (IMAGESTREAMP (SETQ IMSTREAM (STKEVAL POS '*STANDARD-OUTPUT* T]
then
(* ;; "Big kludge: This is somebody in the prettyprinter trying to figure out the width of the bitmap--fake them out by printing something about the width of the bitmap. IMSTREAM is the stream to which the real output will go. To be conservative, only do this under PRETTYFILEINDEX.")
(RPTQ (CL:CEILING (TIMES (DSPSCALE NIL IMSTREAM)
(BITMAPWIDTH BM))
(CHARWIDTH (CHARCODE X)
IMSTREAM))
(\OUTCHAR STREAM (CHARCODE X)))
T
else (NON.PFI.PRINT.BITMAP BM STREAM])
)
(RPAQ? *PRINT-PRETTY-BITMAPS* T)
@@ -1071,28 +1186,28 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
)
(PUTPROPS PRETTYFILEINDEX COPYRIGHT ("Xerox Corporation" 1988 1992 1993 1999 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (10203 12438 (PFI.NEW.LISTFILES1 10213 . 10707) (PFI.ENQUEUE 10709 . 11333) (
\PFI.DO.HARDCOPY 11335 . 11921) (MAYBE.PRETTYFILEINDEX 11923 . 12436)) (12439 34954 (PRETTYFILEINDEX
12449 . 26482) (PFI.MAKE.LPT.STREAM 26484 . 29535) (PFI.SETUP.TRANSLATIONS 29537 . 31051) (
PFI.OUTCHARFN 31053 . 33027) (PFI.COLLECT.DEFINERS 33029 . 33841) (PFI.AFTER.NEW.PAGE 33843 . 34952))
(34955 40868 (PFI.PRINT.FILECREATED 34965 . 39055) (PFI.PRINT.TO.TAB 39057 . 39502) (
PFI.PRINT.ENVIRONMENT 39504 . 40866)) (40869 48384 (PFI.PROCESS.FILE 40879 . 42109) (PFI.PASS.COMMENT
42111 . 43081) (PFI.HANDLE.EXPR 43083 . 43750) (PFI.DEFAULT.HANDLER 43752 . 45805) (PFI.PRETTYPRINT
45807 . 46142) (PFI.LINES.REMAINING 46144 . 46471) (PFI.MAYBE.NEW.PAGE 46473 . 47307) (
PFI.ESTIMATE.SIZE 47309 . 47840) (PFI.ESTIMATE.SIZE1 47842 . 48382)) (48421 58630 (PFI.HANDLE.RPAQQ
48431 . 49839) (PFI.HANDLE.DECLARE 49841 . 50780) (PFI.HANDLE.EVAL-WHEN 50782 . 51265) (
PFI.HANDLE.DEFDEFINER 51267 . 52557) (PFI.HANDLE.DEFINEQ 52559 . 52803) (PFI.PRINT.LAMBDA 52805 .
53143) (PFI.PRINT.LAMBDA.BODY 53145 . 53480) (PFI.HANDLE.PUTDEF 53482 . 53979) (PFI.HANDLE.PUTPROPS
53981 . 54596) (PFI.HANDLE./DECLAREDATATYPE 54598 . 55145) (PFI.HANDLE.* 55147 . 56409) (
PFI.PRINT.COMMENTS 56411 . 58033) (PFI.HANDLE.FILEMAP 58035 . 58323) (PFI.HANDLE.PACKAGE 58325 . 58628
)) (58658 59650 (PFI.PREVIEW.DECLARE 58668 . 59330) (PFI.PREVIEW.DEFINEQ 59332 . 59648)) (59686 70674
(PFI.PRINT.INDEX 59696 . 60547) (PFI.CONDENSE.INDEX 60549 . 62356) (PFI.SORT.INDICES 62358 . 63497) (
PFI.COMPUTE.INDEX.SHAPE 63499 . 64963) (PFI.PRINT.INDICES 64965 . 69507) (PFI.CENTER.PRINT 69509 .
70079) (PFI.INDEX.BREAK 70081 . 70539) (PFI.LOOKUP.NAME 70541 . 70672)) (70675 71906 (PFI.ADD.TO.INDEX
70685 . 71195) (PFI.VARNAME 71197 . 71607) (PFI.CONSTANTNAMES 71609 . 71904)) (71941 80254 (
MULTIFILEINDEX 71951 . 72747) (MULTIFILEINDEX1 72749 . 74205) (PFI.PRINT.MULTI.INDEX 74207 . 79310) (
PFI.CHOOSE.BEST 79312 . 79539) (PFI.MERGE.INDICES 79541 . 80252)) (80311 83380 (PFI.MAYBE.SEE.PRETTY
80321 . 82104) (PFI.MAYBE.PP.DEFINITION 82106 . 83378)) (83450 87285 (PFI.PRINT.BITMAP 83460 . 87283))
(90054 93168 (PUTPROPS.PRETTYPRINT 90064 . 91475) (RPAQX.PRETTYPRINT 91477 . 92202) (
COURIERPROGRAM.PRETTYPRINT 92204 . 92904) (MAYBE.PRETTYPRINT.BOLD 92906 . 93166)))))
(FILEMAP (NIL (10069 12304 (PFI.NEW.LISTFILES1 10079 . 10573) (PFI.ENQUEUE 10575 . 11199) (
\PFI.DO.HARDCOPY 11201 . 11787) (MAYBE.PRETTYFILEINDEX 11789 . 12302)) (12305 34820 (PRETTYFILEINDEX
12315 . 26348) (PFI.MAKE.LPT.STREAM 26350 . 29401) (PFI.SETUP.TRANSLATIONS 29403 . 30917) (
PFI.OUTCHARFN 30919 . 32893) (PFI.COLLECT.DEFINERS 32895 . 33707) (PFI.AFTER.NEW.PAGE 33709 . 34818))
(34821 40734 (PFI.PRINT.FILECREATED 34831 . 38921) (PFI.PRINT.TO.TAB 38923 . 39368) (
PFI.PRINT.ENVIRONMENT 39370 . 40732)) (40735 48250 (PFI.PROCESS.FILE 40745 . 41975) (PFI.PASS.COMMENT
41977 . 42947) (PFI.HANDLE.EXPR 42949 . 43616) (PFI.DEFAULT.HANDLER 43618 . 45671) (PFI.PRETTYPRINT
45673 . 46008) (PFI.LINES.REMAINING 46010 . 46337) (PFI.MAYBE.NEW.PAGE 46339 . 47173) (
PFI.ESTIMATE.SIZE 47175 . 47706) (PFI.ESTIMATE.SIZE1 47708 . 48248)) (48287 58496 (PFI.HANDLE.RPAQQ
48297 . 49705) (PFI.HANDLE.DECLARE 49707 . 50646) (PFI.HANDLE.EVAL-WHEN 50648 . 51131) (
PFI.HANDLE.DEFDEFINER 51133 . 52423) (PFI.HANDLE.DEFINEQ 52425 . 52669) (PFI.PRINT.LAMBDA 52671 .
53009) (PFI.PRINT.LAMBDA.BODY 53011 . 53346) (PFI.HANDLE.PUTDEF 53348 . 53845) (PFI.HANDLE.PUTPROPS
53847 . 54462) (PFI.HANDLE./DECLAREDATATYPE 54464 . 55011) (PFI.HANDLE.* 55013 . 56275) (
PFI.PRINT.COMMENTS 56277 . 57899) (PFI.HANDLE.FILEMAP 57901 . 58189) (PFI.HANDLE.PACKAGE 58191 . 58494
)) (58524 59516 (PFI.PREVIEW.DECLARE 58534 . 59196) (PFI.PREVIEW.DEFINEQ 59198 . 59514)) (59552 70540
(PFI.PRINT.INDEX 59562 . 60413) (PFI.CONDENSE.INDEX 60415 . 62222) (PFI.SORT.INDICES 62224 . 63363) (
PFI.COMPUTE.INDEX.SHAPE 63365 . 64829) (PFI.PRINT.INDICES 64831 . 69373) (PFI.CENTER.PRINT 69375 .
69945) (PFI.INDEX.BREAK 69947 . 70405) (PFI.LOOKUP.NAME 70407 . 70538)) (70541 71772 (PFI.ADD.TO.INDEX
70551 . 71061) (PFI.VARNAME 71063 . 71473) (PFI.CONSTANTNAMES 71475 . 71770)) (71807 80120 (
MULTIFILEINDEX 71817 . 72613) (MULTIFILEINDEX1 72615 . 74071) (PFI.PRINT.MULTI.INDEX 74073 . 79176) (
PFI.CHOOSE.BEST 79178 . 79405) (PFI.MERGE.INDICES 79407 . 80118)) (80177 83246 (PFI.MAYBE.SEE.PRETTY
80187 . 81970) (PFI.MAYBE.PP.DEFINITION 81972 . 83244)) (83316 91426 (PFI.PRINT.BITMAP 83326 . 91424))
(94195 97309 (PUTPROPS.PRETTYPRINT 94205 . 95616) (RPAQX.PRETTYPRINT 95618 . 96343) (
COURIERPROGRAM.PRETTYPRINT 96345 . 97045) (MAYBE.PRETTYPRINT.BOLD 97047 . 97307)))))
STOP

BIN
lispusers/PRETTYFILEINDEX.LCOM
View File

Binary file not shown.

BIN
sources/BSP.LCOM
View File

Binary file not shown.

288
sources/CLSTREAMS
View File

File diff suppressed because one or more lines are too long

BIN
sources/CLSTREAMS.LCOM
View File

Binary file not shown.

BIN
sources/COREIO.LCOM
View File

Binary file not shown.

350
sources/EXTERNALFORMAT
View File

@@ -1,30 +1,30 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Jun-2022 14:32:42" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;32 32949
(FILECREATED " 3-Jul-2022 08:55:41" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;56 36413
:CHANGES-TO (VARS EXTERNALFORMATCOMS)
(MACROS \CHECKEOLC)
:PREVIOUS-DATE "22-Jun-2022 11:09:34"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;30)
:PREVIOUS-DATE " 3-Jul-2022 00:35:47"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;55)
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
(RPAQQ EXTERNALFORMATCOMS
[(COMS (* ;
[[COMS (* ;
 "EXTERNALFORMAT declaration and related functions (originally on FILEIO)")
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (RECORDS EXTERNALFORMAT)))
(INITRECORDS EXTERNALFORMAT)
(SYSRECORDS EXTERNALFORMAT)
(FNS \EXTERNALFORMAT MAKE-EXTERNALFORMAT)
(FNS \EXTERNALFORMAT MAKE-EXTERNALFORMAT \EXTERNALFORMAT.DEFPRINT)
(FNS \INSTALL.EXTERNALFORMAT \REMOVE.EXTERNALFORMAT FIND-FORMAT)
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
(GLOBALVARS \DEFAULTINCCODE \DEFAULTOUTCHAR \DEFAULTBACKCCODE \DEFAULTPEEKCCODE)
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
(INITVARS (*EXTERNALFORMATS* NIL)
[*DEFAULT-EXTERNALFORMATS* '((DSK :XCCS]
(*DEFAULT-EXTERNALFORMAT* :XCCS)))
(*DEFAULT-EXTERNALFORMAT* :XCCS))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (DEFPRINT 'EXTERNALFORMAT (FUNCTION
\EXTERNALFORMAT.DEFPRINT
]
(COMS
(* ;; "Generic functions not compiled open (originally on LLREAD)")
@@ -33,6 +33,9 @@
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CHECKEOLC))
(RESOURCES \FORMATBYTESTRING.STREAM))
(INITRESOURCES \FORMATBYTESTRING.STREAM))
[COMS (* ; "NULL device, from FILEIO")
(FNS \NULLDEVICE \NULL.OPENFILE)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\NULLDEVICE]
(COMS
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
@@ -124,6 +127,8 @@
(\EXTERNALFORMAT
[LAMBDA (STREAM NEWFORMAT/NAME)
(* ;; "Edited 2-Jul-2022 19:17 by rmk: Fast case: NEWFORMAT/NAME is an external format")
(* ;; "Edited 22-Jun-2022 09:40 by rmk: NEWFORMAT/NAME can be a stream, picks its externalformat")
(* ;; "Edited 10-Sep-2021 20:44 by rmk:")
@@ -138,31 +143,29 @@
(* ;;; "")
(* ;;; ":DEFAULT means the default external format for STREAM's filedevice")
(* ;;; "The all-device default is in *DEFAULT-EXTERNALFORMAT* or the DEFAULTEXTERNALFORMAT field of the file device. The list currently has priority since that makes it easier for a user without EXPORTS.ALL to systematically override. That may or may not be a useful capability. ")
(* ;;; ":DEFAULT means the default external format for STREAM's filedevice. If a different format is not specified when the device is created, it will default to the value of *DEFAULT-EXTERNALFORMAT*, initialized in FILEIO.")
(\DTEST STREAM 'STREAM)
(CL:WHEN NEWFORMAT/NAME
(CL:WHEN (type? READER-ENVIRONMENT NEWFORMAT/NAME)
(SETQ NEWFORMAT/NAME (fetch (READER-ENVIRONMENT REFORMAT) of NEWFORMAT/NAME)))
[LET (EXTFORMAT)
(if (type? EXTERNALFORMAT NEWFORMAT/NAME)
then (SETQ EXTFORMAT NEWFORMAT/NAME)
elseif (\GETSTREAM NEWFORMAT/NAME NIL T)
then (SETQ EXTFORMAT (ffetch (STREAM EXTERNALFORMAT) of NEWFORMAT/NAME))
else (CL:WHEN (EQ NEWFORMAT/NAME :DEFAULT)
(SETQ NEWFORMAT/NAME (OR (CADR (ASSOC (fetch DEVICENAME
of (fetch DEVICE of STREAM))
*DEFAULT-EXTERNALFORMATS*))
(fetch (FDEV DEFAULTEXTERNALFORMAT)
of (fetch DEVICE of STREAM))
*DEFAULT-EXTERNALFORMAT*)))
(SETQ EXTFORMAT (FIND-FORMAT NEWFORMAT/NAME))
(CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME
"is not a registered external format name")))
[LET ((EXTFORMAT NEWFORMAT/NAME))
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT))
(* ;; "Try for coercions")
(CL:WHEN (type? READER-ENVIRONMENT NEWFORMAT/NAME)
(SETQ NEWFORMAT/NAME (fetch (READER-ENVIRONMENT REFORMAT) of NEWFORMAT/NAME)))
(if (type? EXTERNALFORMAT NEWFORMAT/NAME)
then (SETQ EXTFORMAT NEWFORMAT/NAME)
elseif (\GETSTREAM NEWFORMAT/NAME NIL T)
then (SETQ EXTFORMAT (ffetch (STREAM EXTERNALFORMAT) of NEWFORMAT/NAME))
else (CL:WHEN (EQ NEWFORMAT/NAME :DEFAULT)
(SETQ NEWFORMAT/NAME (fetch (FDEV DEFAULTEXTERNALFORMAT)
of (fetch (STREAM DEVICE) of STREAM))))
(SETQ EXTFORMAT (FIND-FORMAT NEWFORMAT/NAME NIL STREAM))
(CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME
"is not a registered external format name")))
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT)))
(UNINTERRUPTABLY
(freplace (STREAM EXTERNALFORMAT) of STREAM with EXTFORMAT)
(CL:WHEN (ffetch (EXTERNALFORMAT EOLVALID) of EXTFORMAT)
@@ -179,11 +182,28 @@
(ffetch (EXTERNALFORMAT NAME) of (fetch (STREAM EXTERNALFORMAT) of STREAM])
(MAKE-EXTERNALFORMAT
[LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL UNSTABLE)
[LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL UNSTABLE
FORMATBYTESTRINGFN DEFAULT) (* ; "Edited 3-Jul-2022 00:35 by rmk")
(* ; "Edited 10-Sep-2021 19:47 by rmk:")
(* ;; "Compiled creator for EXTERNALFORMAT so that declaration (EXPORTS.ALL) is not needed. If EOL is not specified, then EOLVALID is also NIL")
(* ;; "Compiled creator for EXTERNALFORMAT so that declaration (EXPORTS.ALL) is not needed. If EOL is not specified, then EOLVALID is also NIL. Fills in missing functions from DEFAULT if given. If DEFAULT is T, use *DEFAULT-EXTERNALFORMAT*.")
(CL:WHEN DEFAULT
[LET [(DEF (FIND-FORMAT (CL:IF (EQ DEFAULT T)
*DEFAULT-EXTERNALFORMAT*
DEFAULT)]
(CL:UNLESS INCCODEFN
(SETQ INCCODEFN (FETCH (EXTERNALFORMAT INCCODEFN)
DEF)))
(CL:UNLESS PEEKCCODEFN
(SETQ PEEKCCODEFN (FETCH (EXTERNALFORMAT PEEKCCODEFN)
DEF)))
(CL:UNLESS BACKCCODEFN
(SETQ BACKCCODEFN (FETCH (EXTERNALFORMAT BACKCCODEFN)
DEF)))
(CL:UNLESS OUTCHARFN
(SETQ OUTCHARFN (FETCH (EXTERNALFORMAT OUTCHARFN)
DEF)))])
(SETQ EOL (SELECTC EOL
((LIST 'LF LF.EOLC)
LF.EOLC)
@@ -194,15 +214,25 @@
(NIL)
(SHOULDNT)))
(\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT
NAME _ NAME
INCCODEFN _ INCCODEFN
PEEKCCODEFN _ PEEKCCODEFN
BACKCCODEFN _ BACKCCODEFN
OUTCHARFN _ OUTCHARFN
FORMATBYTESTREAMFN _ FORMATBYTESTREAMFN
EOLVALID _ EOL
EOL _ (OR EOL LF.EOLC)
UNSTABLE _ UNSTABLE])
NAME _ NAME
INCCODEFN _ INCCODEFN
PEEKCCODEFN _ PEEKCCODEFN
BACKCCODEFN _ BACKCCODEFN
OUTCHARFN _ OUTCHARFN
FORMATBYTESTREAMFN _ FORMATBYTESTREAMFN
EOLVALID _ EOL
EOL _ (OR EOL LF.EOLC)
UNSTABLE _ UNSTABLE
FORMATBYTESTRINGFN _ FORMATBYTESTRINGFN])
(\EXTERNALFORMAT.DEFPRINT
[LAMBDA (EXTERNALFORMAT STREAM) (* ; "Edited 2-Jul-2022 11:40 by rmk")
(* ; "Edited 8-May-87 15:55 by bvm")
(* ;; "Print device using its name, for example, #<EXTERNALFORMAT:UTF-8/76,5432>")
(\DEFPRINT.BY.NAME EXTERNALFORMAT STREAM (fetch (EXTERNALFORMAT NAME) of EXTERNALFORMAT)
"EXTERNALFORMAT"])
)
(DEFINEQ
@@ -248,31 +278,28 @@
*EXTERNALFORMATS*])
(FIND-FORMAT
[LAMBDA (NAME NOERROR) (* ; "Edited 7-Aug-2021 09:29 by rmk:")
[LAMBDA (NAME NOERROR) (* ; "Edited 2-Jul-2022 18:55 by rmk")
(* ; "Edited 7-Aug-2021 09:29 by rmk:")
(IF (TYPE? EXTERNALFORMAT NAME)
THEN NAME
ELSE (SETQ NAME (MKATOM NAME)) (* ;
 "The EQMEMB allows for synonyms, the first of which should be canonical. E.g. (:UTF-8 :UTF8)")
(OR (FIND EF IN *EXTERNALFORMATS* SUCHTHAT (EQ NAME (FETCH (
EXTERNALFORMAT
NAME)
OF EF)))
(CL:UNLESS NOERROR (ERROR NAME "is not an external format"])
ELSE (SETQ NAME (MKATOM NAME)) (* ;
 "The EQMEMB allows for synonyms, the first of which should be canonical. E.g. (:UTF-8 :UTF8)")
(OR (FIND EF IN *EXTERNALFORMATS* SUCHTHAT (EQ NAME (FETCH (EXTERNALFORMAT NAME)
OF EF)))
(CL:UNLESS NOERROR (ERROR NAME "is not an external format"])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DEFAULTINCCODE \DEFAULTOUTCHAR \DEFAULTBACKCCODE \DEFAULTPEEKCCODE)
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
)
(RPAQ? *EXTERNALFORMATS* NIL)
(RPAQ? *DEFAULT-EXTERNALFORMATS* '((DSK :XCCS)))
(RPAQ? *DEFAULT-EXTERNALFORMAT* :XCCS)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(DEFPRINT 'EXTERNALFORMAT (FUNCTION \EXTERNALFORMAT.DEFPRINT))
)
@@ -281,7 +308,8 @@
(DEFINEQ
(\OUTCHAR
[LAMBDA (STREAM CODE) (* ; "Edited 10-Aug-2021 10:29 by rmk:")
[LAMBDA (STREAM CODE) (* ; "Edited 30-Jun-2022 10:02 by rmk")
(* ; "Edited 10-Aug-2021 10:29 by rmk:")
(* ;; "We can't do the EOL stuff here because we don't know whether BOUTs are legit.")
@@ -290,18 +318,18 @@
(* ;; "")
(* ;; "This would make CHARPOSITION generic:")
(* (FREPLACE (STREAM CHARPOSITION)
 OF STREAM WITH (CL:IF
 (EQ CODE (CHARCODE EOL)) 0
 (IPLUS16 1 (FFETCH
 (STREAM CHARPOSITION) OF STREAM)))))
(CL:FUNCALL (OR (ffetch (STREAM OUTCHARFN) of STREAM)
\DEFAULTOUTCHAR)
(* (FREPLACE (STREAM CHARPOSITION) OF
 STREAM WITH (CL:IF (EQ CODE
 (CHARCODE EOL)) 0 (IPLUS16 1
 (FFETCH (STREAM CHARPOSITION) OF
 STREAM)))))
(CL:FUNCALL (ffetch (STREAM OUTCHARFN) of STREAM)
STREAM CODE)
CODE])
(\INCCODE
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 7-Aug-2021 00:11 by rmk:")
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 30-Jun-2022 10:04 by rmk")
(* ; "Edited 7-Aug-2021 00:11 by rmk:")
(* ;; "Calling functions pass the name of the BYTECOUNTVAR, or NIL. If non-NIL, implementing functions are required to SETQ *BYTECOUNTER* to the number of bytes read (positive) or backed up (negative).")
@@ -309,37 +337,35 @@
(IF BYTECOUNTVAR
THEN [LET ((*BYTECOUNTER* 0))
(DECLARE (SPECVARS *BYTECOUNTER*))
(PROG1 (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM
'*BYTECOUNTER*)
(SET BYTECOUNTVAR (IDIFFERENCE (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*)))]
ELSE (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM])
(DECLARE (SPECVARS *BYTECOUNTER*))
(PROG1 (CL:FUNCALL (ffetch (STREAM INCCODEFN) of STREAM)
STREAM
'*BYTECOUNTER*)
(SET BYTECOUNTVAR (IDIFFERENCE (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*)))]
ELSE (CL:FUNCALL (ffetch (STREAM INCCODEFN) of STREAM)
STREAM])
(\BACKCCODE
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 14-Aug-2021 00:26 by rmk:")
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 30-Jun-2022 10:00 by rmk")
(* ; "Edited 14-Aug-2021 00:26 by rmk:")
(* ;;
"Format function returns T if the backup succeed, NIL otherwise (e.g at the beginning of the file)")
 "Format function returns T if the backup succeed, NIL otherwise (e.g at the beginning of the file)")
(IF BYTECOUNTVAR
THEN [LET ((*BYTECOUNTER* 0))
(DECLARE (SPECVARS *BYTECOUNTER*))
(PROG1 (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
STREAM T)
(SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*)))]
ELSE (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
STREAM])
(DECLARE (SPECVARS *BYTECOUNTER*))
(PROG1 (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM T)
(SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*)))]
ELSE (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM])
(\BACKCCODE.EOLC
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 18-Jun-2022 18:45 by rmk")
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 30-Jun-2022 10:02 by rmk")
(* ; "Edited 18-Jun-2022 18:45 by rmk")
(* ; "Edited 14-Aug-2021 00:27 by rmk:")
(* ;; "If the EOLCONVENTION is CRLF, and the first backup is over an LF encoding, this looks to see whether the preceding bytes encode a CR and if so, backs up over those.")
@@ -352,32 +378,27 @@
(* ;; "In almost all cases, we just execute the first backup")
(PROG1 (CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
(PROG1 (CL:WHEN (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM)
(SELECTC (OR EOLC (ffetch (STREAM EOLCONVENTION) OF STREAM))
((LIST CRLF.EOLC ANY.EOLC 'CRLF 'ANY)
(CL:WHEN (EQ (CHARCODE LF)
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
\DEFAULTPEEKCCODE)
(CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM)
STREAM))
(* ;;
 "We just backed over an LF with EOLC= CRLF or ANY. If we go one more, do we get a CR?")
(CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
(CL:WHEN (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM)
(CL:UNLESS (EQ (CHARCODE CR)
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN)
of STREAM)
\DEFAULTPEEKCCODE)
(CL:FUNCALL (ffetch (STREAM PEEKCCODEFN)
of STREAM)
STREAM))
(* ;; "Not a preceding CR, reread it.")
(CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
(CL:FUNCALL (ffetch (STREAM INCCODEFN) of STREAM)
STREAM)))))
NIL)
T)
@@ -386,58 +407,54 @@
(IDIFFERENCE STARTPOS (\GETFILEPTR STREAM]))])
(\PEEKCCODE
[LAMBDA (STREAM NOERROR EOL) (* ; "Edited 14-Jun-2021 12:40 by rmk:")
(\CHECKEOLC (CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
\DEFAULTPEEKCCODE)
[LAMBDA (STREAM NOERROR EOL) (* ; "Edited 30-Jun-2022 10:03 by rmk")
(* ; "Edited 14-Jun-2021 12:40 by rmk:")
(\CHECKEOLC (CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM)
STREAM NOERROR)
EOL STREAM T])
(\PEEKCCODE.NOEOLC
[LAMBDA (STREAM NOERROR) (* ; "Edited 27-Jun-2021 23:26 by rmk:")
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
\DEFAULTPEEKCCODE)
[LAMBDA (STREAM NOERROR) (* ; "Edited 30-Jun-2022 10:03 by rmk")
(* ; "Edited 27-Jun-2021 23:26 by rmk:")
(CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM)
STREAM NOERROR])
(\INCCODE.EOLC
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 8-Aug-2021 14:52 by rmk:")
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 30-Jun-2022 10:12 by rmk")
(* ; "Edited 8-Aug-2021 14:52 by rmk:")
(* ;;
 "EOL conversion around essentially a copy of \INCCODE but avoids the extra function call.")
(* ;; "EOL conversion around essentially a copy of \INCCODE but avoids the extra function call.")
(* ;; " EOLC of NIL means all patterns go to EOL")
(* ;; " EOLC of ANY means all patterns go to EOL")
(IF BYTECOUNTVAR
THEN [LET (*BYTECOUNTER* CODE)
(DECLARE (SPECVARS *BYTECOUNTER*))
(DECLARE (SPECVARS *BYTECOUNTER*))
(* ;; "The INCCODEFN first sets *BYTECOUNTER*")
(* ;; "The INCCODEFN first sets *BYTECOUNTER*")
(CL:UNLESS BYTECOUNTVAL
(SETQ BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)))
(SETQ CODE (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM T))
(CL:UNLESS BYTECOUNTVAL
(SETQ BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)))
(SETQ CODE (CL:FUNCALL (ffetch (STREAM INCCODEFN) of STREAM)
STREAM T))
(* ;; "Update according to the number of first-char (CR or LF) bytes")
(* ;; "Update according to the number of first-char (CR or LF) bytes")
(SETQ BYTECOUNTVAL (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*))
(SETQ *BYTECOUNTER* 0)
(SETQ BYTECOUNTVAL (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*))
(SETQ *BYTECOUNTER* 0)
(* ;;
 "*BYTECOUNTER* will now be reset to the number of LF-after-CR bytes, if any")
(* ;; "*BYTECOUNTER* will now be reset to the number of LF-after-CR bytes, if any")
(PROG1 (\CHECKEOLC CODE (OR EOLC (FFETCH (STREAM EOLCONVENTION)
OF STREAM))
STREAM NIL T)
(PROG1 (\CHECKEOLC CODE (OR EOLC (FFETCH (STREAM EOLCONVENTION) OF STREAM))
STREAM NIL T)
(* ;; "Post the results")
(* ;; "Post the results")
(SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*)))]
ELSE (\CHECKEOLC (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM)
(OR EOLC (FFETCH (STREAM EOLCONVENTION) OF STREAM))
STREAM])
(SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*)))]
ELSE (\CHECKEOLC (CL:FUNCALL (ffetch (STREAM INCCODEFN) of STREAM)
STREAM)
(OR EOLC (FFETCH (STREAM EOLCONVENTION) OF STREAM))
STREAM])
(\FORMATBYTESTREAM
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 22-Jun-2022 11:09 by rmk")
@@ -574,6 +591,59 @@
(* ; "NULL device, from FILEIO")
(DEFINEQ
(\NULLDEVICE
[LAMBDA NIL (* bvm%: "30-Jan-85 22:06")
(* ;; "Defines the NULL device, an infinite source or sink")
(\DEFINEDEVICE 'NULL (create FDEV
DEVICENAME _ 'NULL
RANDOMACCESSP _ T
NODIRECTORIES _ T
CLOSEFILE _ (FUNCTION NILL)
DELETEFILE _ (FUNCTION NILL)
OPENFILE _ (FUNCTION \NULL.OPENFILE)
REOPENFILE _ (FUNCTION \NULL.OPENFILE)
BIN _ (FUNCTION \EOF.ACTION)
BOUT _ (FUNCTION NILL)
PEEKBIN _ [FUNCTION (LAMBDA (STREAM NOERRORFLG)
(AND (NULL NOERRORFLG)
(BIN STREAM]
READP _ (FUNCTION NILL)
BACKFILEPTR _ (FUNCTION NILL)
EOFP _ (FUNCTION TRUE)
RENAMEFILE _ (FUNCTION NILL)
GETFILENAME _ (FUNCTION NILL)
EVENTFN _ (FUNCTION NILL)
BLOCKIN _ (FUNCTION \EOF.ACTION)
BLOCKOUT _ (FUNCTION NILL)
GENERATEFILES _ (FUNCTION \NULLFILEGENERATOR)
GETFILEPTR _ (FUNCTION ZERO)
GETEOFPTR _ (FUNCTION ZERO)
SETFILEPTR _ (FUNCTION NILL)
GETFILEINFO _ (FUNCTION NILL)
SETFILEINFO _ (FUNCTION NILL)
SETEOFPTR _ (FUNCTION NILL])
(\NULL.OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE OLDSTREAM) (* bvm%: "30-Jan-85 22:05")
(OR OLDSTREAM (create STREAM
USERCLOSEABLE _ T
ACCESS _ ACCESS
FULLFILENAME _ NIL
DEVICE _ DEVICE])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\NULLDEVICE)
)
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
(DEFINEQ
@@ -625,11 +695,13 @@
(\CREATE.THROUGH.EXTERNALFORMAT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6252 11542 (\EXTERNALFORMAT 6262 . 10227) (MAKE-EXTERNALFORMAT 10229 . 11540)) (11543
14656 (\INSTALL.EXTERNALFORMAT 11553 . 13002) (\REMOVE.EXTERNALFORMAT 13004 . 13835) (FIND-FORMAT
13837 . 14654)) (15105 29364 (\OUTCHAR 15115 . 16251) (\INCCODE 16253 . 17439) (\BACKCCODE 17441 .
18335) (\BACKCCODE.EOLC 18337 . 21214) (\PEEKCCODE 21216 . 21532) (\PEEKCCODE.NOEOLC 21534 . 21796) (
\INCCODE.EOLC 21798 . 23657) (\FORMATBYTESTREAM 23659 . 25292) (\FORMATBYTESTRING 25294 . 26796) (
\CHECKEOLC.CRLF 26798 . 29362)) (31010 32853 (\CREATE.THROUGH.EXTERNALFORMAT 31020 . 31822) (
\THROUGHIN 31824 . 32244) (\THROUGHBACKCCODE 32246 . 32513) (\THROUGHOUTCHARFN 32515 . 32851)))))
(FILEMAP (NIL (6535 13170 (\EXTERNALFORMAT 6545 . 10323) (MAKE-EXTERNALFORMAT 10325 . 12697) (
\EXTERNALFORMAT.DEFPRINT 12699 . 13168)) (13171 16212 (\INSTALL.EXTERNALFORMAT 13181 . 14630) (
\REMOVE.EXTERNALFORMAT 14632 . 15463) (FIND-FORMAT 15465 . 16210)) (16561 30496 (\OUTCHAR 16571 .
17788) (\INCCODE 17790 . 18943) (\BACKCCODE 18945 . 19808) (\BACKCCODE.EOLC 19810 . 22397) (\PEEKCCODE
22399 . 22773) (\PEEKCCODE.NOEOLC 22775 . 23107) (\INCCODE.EOLC 23109 . 24789) (\FORMATBYTESTREAM
24791 . 26424) (\FORMATBYTESTRING 26426 . 27928) (\CHECKEOLC.CRLF 27930 . 30494)) (32098 34334 (
\NULLDEVICE 32108 . 34010) (\NULL.OPENFILE 34012 . 34332)) (34474 36317 (
\CREATE.THROUGH.EXTERNALFORMAT 34484 . 35286) (\THROUGHIN 35288 . 35708) (\THROUGHBACKCCODE 35710 .
35977) (\THROUGHOUTCHARFN 35979 . 36315)))))
STOP

BIN
sources/EXTERNALFORMAT.LCOM
View File

Binary file not shown.

147
sources/FILEIO
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Mar-2022 08:52:23" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEIO.;107 160995
(FILECREATED " 3-Jul-2022 08:55:45" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEIO.;111 159022
:CHANGES-TO (FNS \GENERATEFILES)
:CHANGES-TO (VARS FILEIOCOMS)
:PREVIOUS-DATE " 7-Mar-2022 21:22:44"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEIO.;106)
:PREVIOUS-DATE " 2-Jul-2022 18:55:29"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEIO.;110)
(* ; "
@@ -119,9 +120,6 @@ Copyright (c) 1981-1993, 1999, 2020-2022 by Venue & Xerox Corporation.
(COMS (* ; "Buffered IO")
(FNS \BUFFERED.BIN \BUFFERED.PEEKBIN \BUFFERED.BOUT \BUFFERED.BINS \BUFFERED.BOUTS
\BUFFERED.COPYBYTES))
[COMS (* ; "NULL device")
(FNS \NULLDEVICE \NULL.OPENFILE)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\NULLDEVICE]
(LOCALVARS . T)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
@@ -393,7 +391,13 @@ Copyright (c) 1981-1993, 1999, 2020-2022 by Venue & Xerox Corporation.
ENDOFSTREAMOP _ (FUNCTION \EOSERROR)
IMAGEOPS _ \NOIMAGEOPS EOLCONVENTION _ LF.EOLC STRMBINFN _ (FUNCTION \STREAM.NOT.OPEN)
STRMBOUTFN _ (FUNCTION \STREAM.NOT.OPEN)
LASTCCODE _ 65535)
LASTCCODE _ 65535 (CREATE (PROGN (\EXTERNALFORMAT DATUM (OR (FETCH (FDEV
DEFAULTEXTERNALFORMAT
)
OF (FFETCH (STREAM DEVICE)
OF DATUM))
:DEFAULT))
DATUM)))
)
(/DECLAREDATATYPE 'STREAM
@@ -933,7 +937,8 @@ Copyright (c) 1981-1993, 1999, 2020-2022 by Venue & Xerox Corporation.
OPENP _ (FUNCTION NILL)
UNREGISTERFILE _ (FUNCTION NILL)
CHARSETFN _ (FUNCTION \GENERIC.CHARSET)
BREAKCONNECTION _ (FUNCTION NILL))
BREAKCONNECTION _ (FUNCTION NILL)
DEFAULTEXTERNALFORMAT _ *DEFAULT-EXTERNALFORMAT*)
(RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE))
)
@@ -3029,59 +3034,6 @@ update the map")
(T (SETQ NBYTES (IDIFFERENCE NBYTES NB]
repeatwhile (FDEVOP 'GETNEXTBUFFER DEV SRC 'READ NOERRORFLG])
)
(* ; "NULL device")
(DEFINEQ
(\NULLDEVICE
[LAMBDA NIL (* bvm%: "30-Jan-85 22:06")
(* ;; "Defines the NULL device, an infinite source or sink")
(\DEFINEDEVICE 'NULL (create FDEV
DEVICENAME _ 'NULL
RANDOMACCESSP _ T
NODIRECTORIES _ T
CLOSEFILE _ (FUNCTION NILL)
DELETEFILE _ (FUNCTION NILL)
OPENFILE _ (FUNCTION \NULL.OPENFILE)
REOPENFILE _ (FUNCTION \NULL.OPENFILE)
BIN _ (FUNCTION \EOF.ACTION)
BOUT _ (FUNCTION NILL)
PEEKBIN _ [FUNCTION (LAMBDA (STREAM NOERRORFLG)
(AND (NULL NOERRORFLG)
(BIN STREAM]
READP _ (FUNCTION NILL)
BACKFILEPTR _ (FUNCTION NILL)
EOFP _ (FUNCTION TRUE)
RENAMEFILE _ (FUNCTION NILL)
GETFILENAME _ (FUNCTION NILL)
EVENTFN _ (FUNCTION NILL)
BLOCKIN _ (FUNCTION \EOF.ACTION)
BLOCKOUT _ (FUNCTION NILL)
GENERATEFILES _ (FUNCTION \NULLFILEGENERATOR)
GETFILEPTR _ (FUNCTION ZERO)
GETEOFPTR _ (FUNCTION ZERO)
SETFILEPTR _ (FUNCTION NILL)
GETFILEINFO _ (FUNCTION NILL)
SETFILEINFO _ (FUNCTION NILL)
SETEOFPTR _ (FUNCTION NILL])
(\NULL.OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE OLDSTREAM)(* bvm%: "30-Jan-85 22:05")
(OR OLDSTREAM (create STREAM
USERCLOSEABLE _ T
ACCESS _ ACCESS
FULLFILENAME _ NIL
DEVICE _ DEVICE])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\NULLDEVICE)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
@@ -3097,40 +3049,39 @@ update the map")
(PUTPROPS FILEIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989
1990 1991 1992 1993 1999 2020 2021 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (26860 30338 (STREAMPROP 26870 . 27304) (GETSTREAMPROP 27306 . 27775) (PUTSTREAMPROP
27777 . 30186) (STREAMP 30188 . 30336)) (30381 32900 (\DEFPRINT.BY.NAME 30391 . 31543) (
\STREAM.DEFPRINT 31545 . 32593) (\FDEV.DEFPRINT 32595 . 32898)) (33158 38199 (\GETACCESS 33168 . 33622
) (\SETACCESS 33624 . 38197)) (58361 64330 (\DEFINEDEVICE 58371 . 60687) (\GETDEVICEFROMNAME 60689 .
61162) (\GETDEVICEFROMHOSTNAME 61164 . 62208) (\REMOVEDEVICE 62210 . 63333) (\REMOVEDEVICE.NAMES 63335
. 64328)) (64370 89116 (\CLOSEFILE 64380 . 65205) (\DELETEFILE 65207 . 65501) (\DEVICEEVENT 65503 .
67273) (\GENERATEFILES 67275 . 68222) (\GENERATENEXTFILE 68224 . 68875) (\GENERATEFILEINFO 68877 .
69338) (\GETFILENAME 69340 . 69729) (\GENERIC.OUTFILEP 69731 . 70201) (\OPENFILE 70203 . 72781) (
\DO.PARAMS.AT.OPEN 72783 . 74953) (\RENAMEFILE 74955 . 75379) (\REVALIDATEFILE 75381 . 77983) (
\PAGED.REVALIDATEFILELST 77985 . 79543) (\PAGED.REVALIDATEFILES 79545 . 81264) (\PAGED.REVALIDATEFILE
81266 . 83549) (\BUFFERED.REVALIDATEFILE 83551 . 85837) (\BUFFERED.REVALIDATEFILELST 85839 . 87023) (
\PRINT-REVALIDATION-RESULT 87025 . 87440) (\TRUNCATEFILE 87442 . 87833) (\FILE-CONFLICT 87835 . 89114)
) (89152 93815 (\GENERATENOFILES 89162 . 91258) (\NULLFILEGENERATOR 91260 . 91504) (\NOFILESNEXTFILEFN
91506 . 93497) (\NOFILESINFOFN 93499 . 93813)) (93934 95842 (\FILE.NOT.OPEN 93944 . 94457) (
\FILE.WONT.OPEN 94459 . 94787) (\ILLEGAL.DEVICEOP 94789 . 95071) (\IS.NOT.RANDACCESSP 95073 . 95519) (
\STREAM.NOT.OPEN 95521 . 95840)) (95977 98275 (\FDEVINSTANCE 95987 . 98273)) (99477 106851 (CNDIR
99487 . 100792) (DIRECTORYNAME 100794 . 104977) (DIRECTORYNAMEP 104979 . 105595) (HOSTNAMEP 105597 .
106404) (\ADD.CONNECTED.DIR 106406 . 106849)) (106896 134776 (\BACKFILEPTR 106906 . 107094) (
\BACKPEEKBIN 107096 . 107457) (\BACKBIN 107459 . 107810) (BIN 107812 . 108029) (\BIN 108031 . 108308)
(\BINS 108310 . 108596) (BOUT 108598 . 108960) (\BOUT 108962 . 109277) (\BOUTS 109279 . 109590) (
COPYBYTES 109592 . 112924) (COPYCHARS 112926 . 116592) (COPYFILE 116594 . 117391) (\COPYOPENFILE
117393 . 120466) (\INFER.FILE.TYPE 120468 . 121422) (EOFP 121424 . 121721) (FORCEOUTPUT 121723 .
121970) (\FLUSH.OPEN.STREAMS 121972 . 122328) (CHARSET 122330 . 123994) (ACCESS-CHARSET 123996 .
124213) (GETEOFPTR 124215 . 124465) (GETFILEINFO 124467 . 127660) (\TYPE.FROM.FILETYPE 127662 . 128132
) (\FILETYPE.FROM.TYPE 128134 . 128313) (GETFILEPTR 128315 . 128567) (SETFILEINFO 128569 . 132675) (
SETFILEPTR 132677 . 134396) (BOUT16 134398 . 134583) (BIN16 134585 . 134774)) (134879 140084 (
\GENERIC.BINS 134889 . 135169) (\GENERIC.BOUTS 135171 . 135436) (\GENERIC.RENAMEFILE 135438 . 137269)
(\GENERIC.OPENP 137271 . 138586) (\GENERIC.READP 138588 . 139629) (\GENERIC.CHARSET 139631 . 140082))
(140085 140424 (\MAP-OPEN-STREAMS 140095 . 140422)) (142208 144288 (\EOF.ACTION 142218 . 142469) (
\EOSERROR 142471 . 142664) (\GETEOFPTR 142666 . 142848) (\INCFILEPTR 142850 . 143200) (\PEEKBIN 143202
. 143393) (\SETCLOSEDFILELENGTH 143395 . 143729) (\SETEOFPTR 143731 . 143919) (\SETFILEPTR 143921 .
144286)) (144289 144831 (\FIXPOUT 144299 . 144599) (\FIXPIN 144601 . 144829)) (144832 145398 (\BOUTEOL
144842 . 145396)) (148294 158158 (\BUFFERED.BIN 148304 . 149156) (\BUFFERED.PEEKBIN 149158 . 149940)
(\BUFFERED.BOUT 149942 . 150802) (\BUFFERED.BINS 150804 . 154489) (\BUFFERED.BOUTS 154491 . 156292) (
\BUFFERED.COPYBYTES 156294 . 158156)) (158187 160539 (\NULLDEVICE 158197 . 160215) (\NULL.OPENFILE
160217 . 160537)))))
(FILEMAP (NIL (27258 30736 (STREAMPROP 27268 . 27702) (GETSTREAMPROP 27704 . 28173) (PUTSTREAMPROP
28175 . 30584) (STREAMP 30586 . 30734)) (30779 33298 (\DEFPRINT.BY.NAME 30789 . 31941) (
\STREAM.DEFPRINT 31943 . 32991) (\FDEV.DEFPRINT 32993 . 33296)) (33556 38597 (\GETACCESS 33566 . 34020
) (\SETACCESS 34022 . 38595)) (58823 64792 (\DEFINEDEVICE 58833 . 61149) (\GETDEVICEFROMNAME 61151 .
61624) (\GETDEVICEFROMHOSTNAME 61626 . 62670) (\REMOVEDEVICE 62672 . 63795) (\REMOVEDEVICE.NAMES 63797
. 64790)) (64832 89578 (\CLOSEFILE 64842 . 65667) (\DELETEFILE 65669 . 65963) (\DEVICEEVENT 65965 .
67735) (\GENERATEFILES 67737 . 68684) (\GENERATENEXTFILE 68686 . 69337) (\GENERATEFILEINFO 69339 .
69800) (\GETFILENAME 69802 . 70191) (\GENERIC.OUTFILEP 70193 . 70663) (\OPENFILE 70665 . 73243) (
\DO.PARAMS.AT.OPEN 73245 . 75415) (\RENAMEFILE 75417 . 75841) (\REVALIDATEFILE 75843 . 78445) (
\PAGED.REVALIDATEFILELST 78447 . 80005) (\PAGED.REVALIDATEFILES 80007 . 81726) (\PAGED.REVALIDATEFILE
81728 . 84011) (\BUFFERED.REVALIDATEFILE 84013 . 86299) (\BUFFERED.REVALIDATEFILELST 86301 . 87485) (
\PRINT-REVALIDATION-RESULT 87487 . 87902) (\TRUNCATEFILE 87904 . 88295) (\FILE-CONFLICT 88297 . 89576)
) (89614 94277 (\GENERATENOFILES 89624 . 91720) (\NULLFILEGENERATOR 91722 . 91966) (\NOFILESNEXTFILEFN
91968 . 93959) (\NOFILESINFOFN 93961 . 94275)) (94396 96304 (\FILE.NOT.OPEN 94406 . 94919) (
\FILE.WONT.OPEN 94921 . 95249) (\ILLEGAL.DEVICEOP 95251 . 95533) (\IS.NOT.RANDACCESSP 95535 . 95981) (
\STREAM.NOT.OPEN 95983 . 96302)) (96439 98737 (\FDEVINSTANCE 96449 . 98735)) (99939 107313 (CNDIR
99949 . 101254) (DIRECTORYNAME 101256 . 105439) (DIRECTORYNAMEP 105441 . 106057) (HOSTNAMEP 106059 .
106866) (\ADD.CONNECTED.DIR 106868 . 107311)) (107358 135238 (\BACKFILEPTR 107368 . 107556) (
\BACKPEEKBIN 107558 . 107919) (\BACKBIN 107921 . 108272) (BIN 108274 . 108491) (\BIN 108493 . 108770)
(\BINS 108772 . 109058) (BOUT 109060 . 109422) (\BOUT 109424 . 109739) (\BOUTS 109741 . 110052) (
COPYBYTES 110054 . 113386) (COPYCHARS 113388 . 117054) (COPYFILE 117056 . 117853) (\COPYOPENFILE
117855 . 120928) (\INFER.FILE.TYPE 120930 . 121884) (EOFP 121886 . 122183) (FORCEOUTPUT 122185 .
122432) (\FLUSH.OPEN.STREAMS 122434 . 122790) (CHARSET 122792 . 124456) (ACCESS-CHARSET 124458 .
124675) (GETEOFPTR 124677 . 124927) (GETFILEINFO 124929 . 128122) (\TYPE.FROM.FILETYPE 128124 . 128594
) (\FILETYPE.FROM.TYPE 128596 . 128775) (GETFILEPTR 128777 . 129029) (SETFILEINFO 129031 . 133137) (
SETFILEPTR 133139 . 134858) (BOUT16 134860 . 135045) (BIN16 135047 . 135236)) (135341 140546 (
\GENERIC.BINS 135351 . 135631) (\GENERIC.BOUTS 135633 . 135898) (\GENERIC.RENAMEFILE 135900 . 137731)
(\GENERIC.OPENP 137733 . 139048) (\GENERIC.READP 139050 . 140091) (\GENERIC.CHARSET 140093 . 140544))
(140547 140886 (\MAP-OPEN-STREAMS 140557 . 140884)) (142670 144750 (\EOF.ACTION 142680 . 142931) (
\EOSERROR 142933 . 143126) (\GETEOFPTR 143128 . 143310) (\INCFILEPTR 143312 . 143662) (\PEEKBIN 143664
. 143855) (\SETCLOSEDFILELENGTH 143857 . 144191) (\SETEOFPTR 144193 . 144381) (\SETFILEPTR 144383 .
144748)) (144751 145293 (\FIXPOUT 144761 . 145061) (\FIXPIN 145063 . 145291)) (145294 145860 (\BOUTEOL
145304 . 145858)) (148756 158620 (\BUFFERED.BIN 148766 . 149618) (\BUFFERED.PEEKBIN 149620 . 150402)
(\BUFFERED.BOUT 150404 . 151264) (\BUFFERED.BINS 151266 . 154951) (\BUFFERED.BOUTS 154953 . 156754) (
\BUFFERED.COPYBYTES 156756 . 158618)))))
STOP

BIN
sources/FILEIO.LCOM
View File

Binary file not shown.

BIN
sources/LEAF.LCOM
View File

Binary file not shown.

295
sources/LLINTERP
View File

@@ -1,10 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Oct-2021 21:03:21" {DSK}<home>larry>medley>sources>LLINTERP.;2 127414
(FILECREATED "30-Jun-2022 22:42:02" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLINTERP.;4 120990
changes to%: (FNS \STKSCAN)
previous date%: " 2-Feb-95 17:31:23" {DSK}<home>larry>medley>sources>LLINTERP.;1)
:PREVIOUS-DATE "30-Jun-2022 18:04:04"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLINTERP.;3)
(* ; "
@@ -22,19 +22,19 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
LLBASIC LLSTK LLCODE LLPARAMS ACODE)))
[E (* ;
 "Don't fontify these common functions")
 "Don't fontify these common functions")
(SETQ FNSLST
(LDIFFERENCE FNSLST
'(EVALV PROG SET SETQ RETURN GO QUOTE AND OR PROGN COND PROG1 FUNCTION EVAL
APPLY]
(COMS (* ;
 "For calling interpreted functions")
(COMS (* ; "For calling interpreted functions")
(FNS \INTERPRETER \INTERPRETER1 \SETUP-COMPILED-CLOSURE-CALL \STKNAME))
(COMS (* ; "EVCALL ufn.")
(FNS \ENVCALL.UFN \SETUP-ENVIRONMENT-CALL))
(COMS (* ; "recursive interpreter")
(FNS EVAL \EVAL \EVALFORM \EVALFORMASLAMBDA \EVALOTHER APPLY APPLY* \CHECKAPPLY*
\CKAPPLYARGS DEFEVAL)
(P (MOVD? 'APPLY* 'SPREADAPPLY*))
(DECLARE%: DONTCOPY (MACROS .APPLY.))
(COMS (* ; "Free variable manipulation")
(FNS EVALV \EVALV1 \EVALVAR BOUNDP SET \SETVAR SETQ \STKSCAN \SETFVARSLOT))
@@ -42,7 +42,7 @@ with the terms of said license.
(FNS PROG \PROG0 \EVPROG1 RETURN GO EVALA \EVALA ERRORSET
SI::ERRORSET-PRINT-FUNCTION))
(COMS (* ;
 "LET and friends -- need these in the init")
 "LET and friends -- need these in the init")
(FNS LET LET* \LET0 \LET*))
(FNS QUOTE AND OR PROGN COND \EVPROGN PROG1)
(COMS (VARS (\DEFEVALFNS NIL)
@@ -54,11 +54,11 @@ with the terms of said license.
(P (MOVD? 'SETQ 'SETN NIL T)))
(GLOBALVARS CLISPARRAY))
[COMS (* ;
 "Evaluating in different stack environment")
 "Evaluating in different stack environment")
(FNS ENVEVAL ENVAPPLY FUNCTION \FUNCT1 \MAKEFUNARGFRAME STKEVAL STKAPPLY RETEVAL
RETAPPLY)
(DECLARE%: DONTEVAL@LOAD DOCOPY (* ;
 "For bootstrapping, IL:FUNCTION is as good as CL:FUNCTION")
 "For bootstrapping, IL:FUNCTION is as good as CL:FUNCTION")
(P (MOVD? 'FUNCTION 'CL:FUNCTION NIL T]
(COMS (* ; "Blip and other stack funniness")
(FNS BLIPVAL SETBLIPVAL BLIPSCAN)
@@ -75,7 +75,7 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE DONTCOPY (COMS * RAIDCOMS)))
(COMS (FNS CCODEP EXPRP SUBRP FNTYP ARGTYPE NARGS ARGLIST \CCODEARGLIST \CCODEIVARSCAN)
(COMS (* ;
 "Translation machinery for new LAMBDA words")
 "Translation machinery for new LAMBDA words")
(PROP VARTYPE LAMBDATRANFNS)
(ALISTS (LAMBDATRANFNS)))
(DECLARE%: DONTCOPY (MACROS \CCODENARGS \CCODEFNTYP \CCODEARGTYPE)))
@@ -366,39 +366,40 @@ with the terms of said license.
(LAMBDA (TYPE FN) (* edited%: "13-DEC-78 23:18") (PROG ((F (FASSOC TYPE \DEFEVALFNS))) (COND (F (SETQ \DEFEVALFNS (DREMOVE F \DEFEVALFNS)))) (COND (FN (SETQ \DEFEVALFNS (CONS (CONS TYPE FN) \DEFEVALFNS)))) (RETURN (CDR F))))
)
)
(MOVD? 'APPLY* 'SPREADAPPLY*)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(PUTPROPS .APPLY. MACRO [(U V) (* body for APPLY, used by RETAPPLY
 too)
(PROG ((DEF U))
LP [COND
((LITATOM DEF)
(COND
((NOT (fetch (LITATOM CCODEP) of DEF))
(PUTPROPS .APPLY. MACRO [(U V) (* body for APPLY, used by RETAPPLY
 too)
(PROG ((DEF U))
LP [COND
((LITATOM DEF)
(COND
((NOT (fetch (LITATOM CCODEP) of DEF))
(* EXPR)
(SETQ DEF (fetch (LITATOM DEFPOINTER) of
DEF)))
((EQ (fetch (LITATOM ARGTYPE) of DEF)
3)
(GO NLSTAR))
(T (GO NORMAL]
[COND
((LISTP DEF)
(SELECTQ (CAR DEF)
(NLAMBDA (AND (NLISTP (CADR DEF))
(CADR DEF)
(GO NLSTAR)))
(FUNARG (SETQ DEF (CADR DEF))
(GO LP))
NIL))
((NULL DEF)
(RETURN (FAULTAPPLY U V]
NORMAL
(RETURN (SPREADAPPLY U V))
NLSTAR
(SETQ DEF (fetch (LITATOM DEFPOINTER) of DEF)))
((EQ (fetch (LITATOM ARGTYPE) of DEF)
3)
(GO NLSTAR))
(T (GO NORMAL]
[COND
((LISTP DEF)
(SELECTQ (CAR DEF)
(NLAMBDA (AND (NLISTP (CADR DEF))
(CADR DEF)
(GO NLSTAR)))
(FUNARG (SETQ DEF (CADR DEF))
(GO LP))
NIL))
((NULL DEF)
(RETURN (FAULTAPPLY U V]
NORMAL
(RETURN (SPREADAPPLY U V))
NLSTAR
(* NLAMBDA*)
(RETURN (SPREADAPPLY* U V])
(RETURN (SPREADAPPLY* U V])
)
)
@@ -1220,8 +1221,8 @@ with the terms of said license.
)
)
(RPAQ? OPENFNS '(APPLY* SETQ AND OR COND SELECTQ PROG PROGN PROG1 ARG SETARG ERSETQ NLSETQ
RESETFORM RESETLST RESETVARS RPTQ SAVESETQ SETN UNDONLSETQ XNLSETQ))
(RPAQ? OPENFNS '(APPLY* SETQ AND OR COND SELECTQ PROG PROGN PROG1 ARG SETARG ERSETQ NLSETQ RESETFORM
RESETLST RESETVARS RPTQ SAVESETQ SETN UNDONLSETQ XNLSETQ))
(RPAQQ \BLIPNAMES (*TAIL* *FORM* *FN* *ARGVALS*))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -1449,41 +1450,39 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE
(PUTPROPS PSTKFLD MACRO [(FLD STR TEST FMT STR2)
(PROG ((FLD (fetch (FX FLD) of FRAME)))
(DECLARE (LOCALVARS FLD))
(COND
(TEST (PRIN1 'STR)
(SELECTQ (CONSTANT (NTHCHAR 'STR -1))
(= (printout NIL %, FLD STR2))
NIL)
T])
(PROG ((FLD (fetch (FX FLD) of FRAME)))
(DECLARE (LOCALVARS FLD))
(COND
(TEST (PRIN1 'STR)
(SELECTQ (CONSTANT (NTHCHAR 'STR -1))
(= (printout NIL %, FLD STR2))
NIL)
T])
(PUTPROPS PRINTSTKFIELDS MACRO [FIELDS (CONS 'PROGN (MAPCAR FIELDS (FUNCTION (LAMBDA (X)
(CONS
'PSTKFLD X])
(CONS 'PSTKFLD X])
(PUTPROPS PSTK MACRO ((N . FIELDS)
(\PRINTSTK (IPLUS FRAME N))
(PRINTSTKFIELDS . FIELDS)
(TERPRI)))
(\PRINTSTK (IPLUS FRAME N))
(PRINTSTKFIELDS . FIELDS)
(TERPRI)))
(PUTPROPS PRINTVA MACRO [LAMBDA (X)
(printout NIL "{" (HILOC X)
","
(LOLOC X)
"}"])
(printout NIL "{" (HILOC X)
","
(LOLOC X)
"}"])
)
(ADDTOVAR RDCOMS (FNS RAIDCOMMAND RAIDSHOWFRAME RAIDSTACKCMD RAIDROOTFRAME PRINTADDRS PRINTVA
READVA READOCT READATOM SHOWSTACKBLOCKS SHOWSTACKBLOCK1 PRINCOPY NOSUCHATOM
)
(FNS \BACKTRACE \STKNAME \PRINTBF \PRINTFRAME \SCANFORNTENTRY \PRINTSTK))
(ADDTOVAR RDCOMS (FNS RAIDCOMMAND RAIDSHOWFRAME RAIDSTACKCMD RAIDROOTFRAME PRINTADDRS PRINTVA READVA
READOCT READATOM SHOWSTACKBLOCKS SHOWSTACKBLOCK1 PRINCOPY NOSUCHATOM)
(FNS \BACKTRACE \STKNAME \PRINTBF \PRINTFRAME \SCANFORNTENTRY \PRINTSTK))
(ADDTOVAR EXPANDMACROFNS PSTKFLD PRINTSTKFIELDS PSTK PRINTVA)
(ADDTOVAR DONTCOMPILEFNS RAIDCOMMAND RAIDSHOWFRAME RAIDSTACKCMD RAIDROOTFRAME PRINTADDRS PRINTVA
READVA READATOM READOCT SHOWSTACKBLOCKS SHOWSTACKBLOCK1 PRINCOPY
NOSUCHATOM)
(ADDTOVAR DONTCOMPILEFNS RAIDCOMMAND RAIDSHOWFRAME RAIDSTACKCMD RAIDROOTFRAME PRINTADDRS PRINTVA
READVA READATOM READOCT SHOWSTACKBLOCKS SHOWSTACKBLOCK1 PRINCOPY
NOSUCHATOM)
)
(DEFINEQ
@@ -1639,22 +1638,22 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE
(PUTPROPS \CCODENARGS MACRO ((FNH)
([LAMBDA (N)
(COND
((ILESSP N 0)
1)
(T N]
(fetch (FNHEADER NA) of FNH))))
([LAMBDA (N)
(COND
((ILESSP N 0)
1)
(T N]
(fetch (FNHEADER NA) of FNH))))
(PUTPROPS \CCODEFNTYP MACRO ((FNH)
(SELECTQ (\CCODEARGTYPE FNH)
(0 'CEXPR)
(1 'CFEXPR)
(2 'CEXPR*)
'CFEXPR*)))
(SELECTQ (\CCODEARGTYPE FNH)
(0 'CEXPR)
(1 'CFEXPR)
(2 'CEXPR*)
'CFEXPR*)))
(PUTPROPS \CCODEARGTYPE MACRO ((FNH)
(fetch (FNHEADER ARGTYPE) of FNH)))
(fetch (FNHEADER ARGTYPE) of FNH)))
)
)
@@ -1718,8 +1717,8 @@ with the terms of said license.
)
(ADDTOVAR CONSTANTFOLDFNS PLUS IPLUS TIMES ITIMES DIFFERENCE IDIFFERENCE QUOTIENT IQUOTIENT IMIN
IMAX IABS LLSH LRSH LOGOR LOGXOR LOGAND OR AND)
(ADDTOVAR CONSTANTFOLDFNS PLUS IPLUS TIMES ITIMES DIFFERENCE IDIFFERENCE QUOTIENT IQUOTIENT IMIN IMAX
IABS LLSH LRSH LOGOR LOGXOR LOGAND OR AND)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS COMPVARMACROHASH CONSTANTFOLDFNS)
@@ -1746,119 +1745,33 @@ with the terms of said license.
(ADDTOVAR LAMA APPLY* \INTERPRETER)
)
(PRETTYCOMPRINT LLINTERPCOMS)
(RPAQQ LLINTERPCOMS
[(COMS (* ; "Compilation pre-requisites")
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
LLBASIC LLSTK LLCODE LLPARAMS ACODE)))
[E (* ;
 "Don't fontify these common functions")
(SETQ FNSLST
(LDIFFERENCE FNSLST
'(EVALV PROG SET SETQ RETURN GO QUOTE AND OR PROGN COND PROG1 FUNCTION EVAL
APPLY]
(COMS (* ;
 "For calling interpreted functions")
(FNS \INTERPRETER \INTERPRETER1 \SETUP-COMPILED-CLOSURE-CALL \STKNAME))
(COMS (* ; "EVCALL ufn.")
(FNS \ENVCALL.UFN \SETUP-ENVIRONMENT-CALL))
(COMS (* ; "recursive interpreter")
(FNS EVAL \EVAL \EVALFORM \EVALFORMASLAMBDA \EVALOTHER APPLY APPLY* \CHECKAPPLY*
\CKAPPLYARGS DEFEVAL)
(DECLARE%: DONTCOPY (MACROS .APPLY.))
(COMS (* ; "Free variable manipulation")
(FNS EVALV \EVALV1 \EVALVAR BOUNDP SET \SETVAR SETQ \STKSCAN \SETFVARSLOT))
(COMS (* ; "PROG and friends")
(FNS PROG \PROG0 \EVPROG1 RETURN GO EVALA \EVALA ERRORSET
SI::ERRORSET-PRINT-FUNCTION))
(COMS (* ;
 "LET and friends -- need these in the init")
(FNS LET LET* \LET0 \LET*))
(FNS QUOTE AND OR PROGN COND \EVPROGN PROG1)
(COMS (VARS (\DEFEVALFNS NIL)
(\EVALHOOK))
(SPECVARS *EVALHOOK*)
(ADDVARS (LAMBDASPLST LAMBDA NLAMBDA CL:LAMBDA OPENLAMBDA))
(GLOBALVARS \DEFEVALFNS \EVALHOOK LAMBDASPLST CLISPARRAY)
(DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (CLISPARRAY))
(P (MOVD? 'SETQ 'SETN NIL T)))
(GLOBALVARS CLISPARRAY))
[COMS (* ;
 "Evaluating in different stack environment")
(FNS ENVEVAL ENVAPPLY FUNCTION \FUNCT1 \MAKEFUNARGFRAME STKEVAL STKAPPLY RETEVAL
RETAPPLY)
(DECLARE%: DONTEVAL@LOAD DOCOPY (* ;
 "For bootstrapping, IL:FUNCTION is as good as CL:FUNCTION")
(P (MOVD? 'FUNCTION 'CL:FUNCTION NIL T]
(COMS (* ; "Blip and other stack funniness")
(FNS BLIPVAL SETBLIPVAL BLIPSCAN)
(FNS \REALFRAMEP)
[INITVARS (OPENFNS '(APPLY* SETQ AND OR COND SELECTQ PROG PROGN PROG1 ARG SETARG
ERSETQ NLSETQ RESETFORM RESETLST RESETVARS RPTQ
SAVESETQ SETN UNDONLSETQ XNLSETQ]
(VARS \BLIPNAMES)
(GLOBALVARS BRKINFOLST)
(GLOBALVARS \BLIPNAMES OPENFNS)))
(COMS (FNS RAIDCOMMAND RAIDSHOWFRAME RAIDSTACKCMD RAIDROOTFRAME PRINTADDRS PRINTVA READVA
READATOM READOCT SHOWSTACKBLOCKS SHOWSTACKBLOCK1 PRINCOPY NOSUCHATOM)
(FNS BACKTRACE \BACKTRACE \SCANFORNTENTRY \PRINTSTK \PRINTFRAME \PRINTBF)
(DECLARE%: EVAL@COMPILE DONTCOPY (COMS * RAIDCOMS)))
(COMS (FNS CCODEP EXPRP SUBRP FNTYP ARGTYPE NARGS ARGLIST \CCODEARGLIST \CCODEIVARSCAN)
(COMS (* ;
 "Translation machinery for new LAMBDA words")
(PROP VARTYPE LAMBDATRANFNS)
(ALISTS (LAMBDATRANFNS)))
(DECLARE%: DONTCOPY (MACROS \CCODENARGS \CCODEFNTYP \CCODEARGTYPE)))
(COMS (* ; "CONSTANTS mechanism")
(FNS CONSTANTS CONSTANTEXPRESSIONP)
(INITVARS (COMPVARMACROHASH (HASHARRAY 100)))
(* ; "We need this initialized for the INIT, so don't put it off. (It used to start out NIL and get set later)")
(ADDVARS (CONSTANTFOLDFNS PLUS IPLUS TIMES ITIMES DIFFERENCE IDIFFERENCE QUOTIENT
IQUOTIENT IMIN IMAX IABS LLSH LRSH LOGOR LOGXOR LOGAND OR AND))
(GLOBALVARS COMPVARMACROHASH CONSTANTFOLDFNS))
(DECLARE%: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD (LOCALVARS . T))
(SPECVARS *TAIL* *FN* *FORM* *ARGVAL*)
(DECLARE%: EVAL@COMPILE DONTCOPY (ADDVARS (LAMS FAULTEVAL FAULTAPPLY)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA CONSTANTS PROG1 COND PROGN OR AND QUOTE LET* LET GO PROG SETQ)
(NLAML FUNCTION RETURN)
(LAMA BOUNDP APPLY* \INTERPRETER])
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA CONSTANTS PROG1 COND PROGN OR AND QUOTE LET* LET GO PROG SETQ)
(ADDTOVAR NLAML FUNCTION RETURN)
(ADDTOVAR LAMA BOUNDP APPLY* \INTERPRETER)
)
(PUTPROPS LLINTERP COPYRIGHT ("Venue & Xerox Corporation" T 1981 1982 1983 1984 1985 1986 1987 1988
1990 1991 1992 1994 1995))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6396 23657 (\INTERPRETER 6406 . 11002) (\INTERPRETER1 11004 . 17572) (
\SETUP-COMPILED-CLOSURE-CALL 17574 . 22721) (\STKNAME 22723 . 23655)) (23686 29098 (\ENVCALL.UFN 23696
. 23828) (\SETUP-ENVIRONMENT-CALL 23830 . 29096)) (29137 34014 (EVAL 29147 . 29247) (\EVAL 29249 .
29459) (\EVALFORM 29461 . 30692) (\EVALFORMASLAMBDA 30694 . 30884) (\EVALOTHER 30886 . 31093) (APPLY
31095 . 31202) (APPLY* 31204 . 32319) (\CHECKAPPLY* 32321 . 33426) (\CKAPPLYARGS 33428 . 33771) (
DEFEVAL 33773 . 34012)) (36106 43695 (EVALV 36116 . 36325) (\EVALV1 36327 . 36482) (\EVALVAR 36484 .
36847) (BOUNDP 36849 . 37065) (SET 37067 . 37433) (\SETVAR 37435 . 37805) (SETQ 37807 . 38479) (
\STKSCAN 38481 . 42145) (\SETFVARSLOT 42147 . 43693)) (43729 56736 (PROG 43739 . 46255) (\PROG0 46257
. 49887) (\EVPROG1 49889 . 50092) (RETURN 50094 . 50635) (GO 50637 . 51452) (EVALA 51454 . 53383) (
\EVALA 53385 . 55978) (ERRORSET 55980 . 56585) (SI::ERRORSET-PRINT-FUNCTION 56587 . 56734)) (56795
69447 (LET 56805 . 58948) (LET* 58950 . 61098) (\LET0 61100 . 64760) (\LET* 64762 . 69445)) (69448
71024 (QUOTE 69458 . 69489) (AND 69491 . 69699) (OR 69701 . 69949) (PROGN 69951 . 70230) (COND 70232
. 70566) (\EVPROGN 70568 . 70781) (PROG1 70783 . 71022)) (71512 78403 (ENVEVAL 71522 . 71772) (
ENVAPPLY 71774 . 72031) (FUNCTION 72033 . 72263) (\FUNCT1 72265 . 74714) (\MAKEFUNARGFRAME 74716 .
76913) (STKEVAL 76915 . 77063) (STKAPPLY 77065 . 77234) (RETEVAL 77236 . 77840) (RETAPPLY 77842 .
78401)) (78524 86032 (BLIPVAL 78534 . 82435) (SETBLIPVAL 82437 . 85179) (BLIPSCAN 85181 . 86030)) (
86033 86728 (\REALFRAMEP 86043 . 86726)) (87109 96504 (RAIDCOMMAND 87119 . 90725) (RAIDSHOWFRAME 90727
. 91110) (RAIDSTACKCMD 91112 . 92293) (RAIDROOTFRAME 92295 . 92557) (PRINTADDRS 92559 . 93085) (
PRINTVA 93087 . 93232) (READVA 93234 . 93312) (READATOM 93314 . 93896) (READOCT 93898 . 94529) (
SHOWSTACKBLOCKS 94531 . 95777) (SHOWSTACKBLOCK1 95779 . 95930) (PRINCOPY 95932 . 96064) (NOSUCHATOM
96066 . 96502)) (96505 105133 (BACKTRACE 96515 . 96872) (\BACKTRACE 96874 . 97980) (\SCANFORNTENTRY
97982 . 99612) (\PRINTSTK 99614 . 99801) (\PRINTFRAME 99803 . 103786) (\PRINTBF 103788 . 105131)) (
107892 117236 (CCODEP 107902 . 108177) (EXPRP 108179 . 108438) (SUBRP 108440 . 108495) (FNTYP 108497
. 109257) (ARGTYPE 109259 . 109873) (NARGS 109875 . 110362) (ARGLIST 110364 . 111613) (\CCODEARGLIST
111615 . 116011) (\CCODEIVARSCAN 116013 . 117234)) (118282 120513 (CONSTANTS 118292 . 118583) (
CONSTANTEXPRESSIONP 118585 . 120511)))))
(FILEMAP (NIL (6409 23670 (\INTERPRETER 6419 . 11015) (\INTERPRETER1 11017 . 17585) (
\SETUP-COMPILED-CLOSURE-CALL 17587 . 22734) (\STKNAME 22736 . 23668)) (23699 29111 (\ENVCALL.UFN 23709
. 23841) (\SETUP-ENVIRONMENT-CALL 23843 . 29109)) (29150 34027 (EVAL 29160 . 29260) (\EVAL 29262 .
29472) (\EVALFORM 29474 . 30705) (\EVALFORMASLAMBDA 30707 . 30897) (\EVALOTHER 30899 . 31106) (APPLY
31108 . 31215) (APPLY* 31217 . 32332) (\CHECKAPPLY* 32334 . 33439) (\CKAPPLYARGS 33441 . 33784) (
DEFEVAL 33786 . 34025)) (35871 43460 (EVALV 35881 . 36090) (\EVALV1 36092 . 36247) (\EVALVAR 36249 .
36612) (BOUNDP 36614 . 36830) (SET 36832 . 37198) (\SETVAR 37200 . 37570) (SETQ 37572 . 38244) (
\STKSCAN 38246 . 41910) (\SETFVARSLOT 41912 . 43458)) (43494 56501 (PROG 43504 . 46020) (\PROG0 46022
. 49652) (\EVPROG1 49654 . 49857) (RETURN 49859 . 50400) (GO 50402 . 51217) (EVALA 51219 . 53148) (
\EVALA 53150 . 55743) (ERRORSET 55745 . 56350) (SI::ERRORSET-PRINT-FUNCTION 56352 . 56499)) (56560
69212 (LET 56570 . 58713) (LET* 58715 . 60863) (\LET0 60865 . 64525) (\LET* 64527 . 69210)) (69213
70789 (QUOTE 69223 . 69254) (AND 69256 . 69464) (OR 69466 . 69714) (PROGN 69716 . 69995) (COND 69997
. 70331) (\EVPROGN 70333 . 70546) (PROG1 70548 . 70787)) (71277 78168 (ENVEVAL 71287 . 71537) (
ENVAPPLY 71539 . 71796) (FUNCTION 71798 . 72028) (\FUNCT1 72030 . 74479) (\MAKEFUNARGFRAME 74481 .
76678) (STKEVAL 76680 . 76828) (STKAPPLY 76830 . 76999) (RETEVAL 77001 . 77605) (RETAPPLY 77607 .
78166)) (78289 85797 (BLIPVAL 78299 . 82200) (SETBLIPVAL 82202 . 84944) (BLIPSCAN 84946 . 85795)) (
85798 86493 (\REALFRAMEP 85808 . 86491)) (86869 96264 (RAIDCOMMAND 86879 . 90485) (RAIDSHOWFRAME 90487
. 90870) (RAIDSTACKCMD 90872 . 92053) (RAIDROOTFRAME 92055 . 92317) (PRINTADDRS 92319 . 92845) (
PRINTVA 92847 . 92992) (READVA 92994 . 93072) (READATOM 93074 . 93656) (READOCT 93658 . 94289) (
SHOWSTACKBLOCKS 94291 . 95537) (SHOWSTACKBLOCK1 95539 . 95690) (PRINCOPY 95692 . 95824) (NOSUCHATOM
95826 . 96262)) (96265 104893 (BACKTRACE 96275 . 96632) (\BACKTRACE 96634 . 97740) (\SCANFORNTENTRY
97742 . 99372) (\PRINTSTK 99374 . 99561) (\PRINTFRAME 99563 . 103546) (\PRINTBF 103548 . 104891)) (
107393 116737 (CCODEP 107403 . 107678) (EXPRP 107680 . 107939) (SUBRP 107941 . 107996) (FNTYP 107998
. 108758) (ARGTYPE 108760 . 109374) (NARGS 109376 . 109863) (ARGLIST 109865 . 111114) (\CCODEARGLIST
111116 . 115512) (\CCODEIVARSCAN 115514 . 116735)) (117687 119918 (CONSTANTS 117697 . 117988) (
CONSTANTEXPRESSIONP 117990 . 119916)))))
STOP

BIN
sources/LLINTERP.LCOM
View File

Binary file not shown.

BIN
sources/LLKEY.LCOM
View File

Binary file not shown.

BIN
sources/NSFILING.LCOM
View File

Binary file not shown.

BIN
sources/SPP.LCOM
View File

Binary file not shown.

267
sources/TTYIN
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Aug-2021 17:02:43" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>TTYIN.;19 329093
changes to%: (VARS TTYINCOMS)
(FILECREATED " 2-Jul-2022 00:09:00" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>TTYIN.;16 328841
previous date%: "27-Aug-2021 16:49:59"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>TTYIN.;18)
:CHANGES-TO (FNS TTYINBUFFERSTREAM)
:PREVIOUS-DATE "27-Aug-2021 17:02:43"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>TTYIN.;14)
(* ; "
@@ -15,7 +16,7 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
(PRETTYCOMPRINT TTYINCOMS)
(RPAQQ TTYINCOMS
[(COMS (* ; "Main TTYIN editor")
[(COMS (* ; "Main TTYIN editor")
(FNS TTYIN TTYIN.SETUP TTYIN.CLEANUP TTYIN1 TTYIN1RESTART TTYIN.FINISH TTYIN.BALANCE
ADDCHAR TTMAKECOMPLEXCHAR ADDNAKEDCHAR TTADDTAB ADJUSTLINE ADJUSTLINE.AND.RESTORE
AT.END.OF.SCREEN AT.END.OF.TEXT AUTOCR? BACKSKREAD BACKWARD.DELETE.TO BREAKLINE
@@ -35,37 +36,37 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
TTLOADBUF TTNEXTLINE TTNEXTNODE TTNLEFT TTNTH TTNTHLINE TTPRIN1 TTPRINSPACE
TTPRIN1COMMENT TTPRIN2 TTPROMPTCHAR TTRUBOUT TTUNREADBUF TTWAITFORINPUT
TTYINSTRING TYPE.BUFFER U-CASECODE U/L-CASE))
(COMS (* ; "Internal reading. These functions all expect caller to have bound *READTABLE* correctly (not bound in TTYIN for who-line transparency)")
(COMS (* ; "Internal reading. These functions all expect caller to have bound *READTABLE* correctly (not bound in TTYIN for who-line transparency)")
(FNS TTRATOM TTREADLIST TTSKIPSEPR TTSKREAD TTYIN.READ))
(COMS (* ; "Escape completion and friends")
(COMS (* ; "Escape completion and friends")
(FNS FIND.MATCHING.WORD TTCOMPLETEWORD WORD.MATCHES.BUFFER TTYIN.SHOW.?ALTERNATIVES))
(COMS (* ; "? and ?= handler")
(COMS (* ; "? and ?= handler")
(FNS DO?CMD TTYIN.PRINTARGS TTYIN.READ?=ARGS DO?CMD.ERRORHANDLER))
(COMS (* ; "Display handling")
(COMS (* ; "Display handling")
(FNS BEEP BITBLT.DELETE BITBLT.ERASE BITBLT.INSERT DO.CRLF DO.DELETE.LINES
DO.INSERT.LINE DO.LF ERASE.TO.END.OF.LINE ERASE.TO.END.OF.PAGE INSERT.TEXT
TTDELSECTION TTADJUSTWIDTH TTINSERTSECTION TTSETCURSOR))
[COMS (* ; "TTYINBUFFERSTREAM")
[COMS (* ; "TTYINBUFFERSTREAM")
(FNS TTYINBUFFERDEVICE TTYINBUFFERSTREAM TTYINBUFFERBIN TTYINBUFFERPEEK
TTYINBUFFERREADP TTYINBUFFEREOFP TTYINBUFFERBACKPTR TTYINWORDRDTBL)
(DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TTYINBUFFERDEVICE (TTYINBUFFERDEVICE))
(TTYINWORDRDTBL (TTYINWORDRDTBL]
(COMS (* ; "Mouse handling")
(COMS (* ; "Mouse handling")
(FNS DO.MOUSE DO.SHIFTED.SELECTION COPY.SEGMENT DELETE.LONG.SEGMENT
DELETE.LONG.SEGMENT1 INVERT.LONG.SEGMENT INVERT.SEGMENT BRACKET.CURRENT.WORD
TTBEFOREPOS TTNEXTPOS TTRACKMOUSE))
(COMS
(* ;; "Auxiliary fns. These are outside the TTYIN block, and are provided to aid the outside world in special interfaces to TTYIN")
(* ;; "Auxiliary fns. These are outside the TTYIN block, and are provided to aid the outside world in special interfaces to TTYIN")
(FNS SETREADFN TTYINENTRYFN TTYINREADP TTYINREAD TTYINFIX CHARMACRO? TTYINMETA
TTYIN.LASTINPUT)
(FNS TTYINEDIT SIMPLETEXTEDIT SET.TTYINEDIT.WINDOW TTYIN.PPTOFILE)
(COMS (* ;
 "New, correct way of getting scratch file")
(COMS (* ;
 "New, correct way of getting scratch file")
(FNS MAKE-TTSCRATCHFILE)
(RESOURCES TTSCRATCHFILE))
(COMS (* ;
 "Obsolete, but maybe someone calls it")
(COMS (* ;
 "Obsolete, but maybe someone calls it")
(FNS TTYIN.SCRATCHFILE \TTYIN.RPEOF)
(INITVARS (TTYINEDIT.SCRATCH)))
(INITVARS (TTYINEDITWINDOW)
@@ -73,15 +74,15 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
(TTYINAUTOCLOSEFLG)
(TTYINPRINTFN)
(TTYIN?=FN)))
[COMS (* ; "Kludge of the week")
[COMS (* ; "Kludge of the week")
(FNS TTYINPROMPTFORWORD)
(INITVARS (TTYIN.USE.EXACT.CHARS))
(DECLARE%: DONTEVAL@LOAD DOCOPY (* ;
 "This is so that you can (MOVD 'TTYINPROMPTFORWORD 'PROMPTFORWORD) and not die")
(DECLARE%: DONTEVAL@LOAD DOCOPY (* ;
 "This is so that you can (MOVD 'TTYINPROMPTFORWORD 'PROMPTFORWORD) and not die")
(P (MOVD? 'PROMPTFORWORD 'NON-TTYIN-PROMPTFORWORD NIL T]
(DECLARE%: DOEVAL@COMPILE DONTCOPY (COMS * TTCOMPILETIME))
(* ;; " The DORADO branch is deprecated (DORADO.RESTORE.BUF.CODES (CHARCODE (%"#B%")))")
(* ;; " The DORADO branch is deprecated (DORADO.RESTORE.BUF.CODES (CHARCODE (%"#B%")))")
(INITVARS (TTYIN.RESTORE.BUF.CODES (CHARCODE ("Function,^D" "Function,^R")))
(TTYINBUFFER)
@@ -4799,7 +4800,8 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
SETEOFPTR _ (FUNCTION NILL])
(TTYINBUFFERSTREAM
[LAMBDA (BUF END EOFACTION) (* ; "Edited 24-May-91 11:19 by jds")
[LAMBDA (BUF END EOFACTION) (* ; "Edited 2-Jul-2022 00:08 by rmk")
(* ; "Edited 24-May-91 11:19 by jds")
(LET [(STRM (OR \TTYINBUFFERSTREAM (SETQ \TTYINBUFFERSTREAM (create STREAM
DEVICE _ TTYINBUFFERDEVICE
ACCESS _ 'INPUT]
@@ -4807,6 +4809,7 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
(replace (TTYINBUFFERSTREAM TTYEOF) of STRM with (OR END \ENDBUFFER))
(replace (TTYINBUFFERSTREAM TTYEOFACTION) of STRM with EOFACTION)
(replace (TTYINBUFFERSTREAM TTYORIGINPUT) of STRM with BUF)
(\EXTERNALFORMAT STRM :DEFAULT)
STRM])
(TTYINBUFFERBIN
@@ -5785,10 +5788,9 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
)
(RPAQQ TTYINMACROS (TYPEAHEAD? AT.END.OF.BUF AT.END.OF.LINE AT.START.OF.BUF AT.START.OF.LINE
BEFOREBUF BREAK.OR.SEPRP DISPLAYTERMP EMPTY.BUFFER EMPTY.LINE EQPOS
NEQPOS INPART ON.FIRST.LINE ON.LAST.LINE METACHARP NONMETACHARBITS
METACHAR COMPLEXCHARP SPACEP TTBOUT TTNEXTCHAR WORDSEPRP FCHARWIDTH
FIRSTCHAR))
BEFOREBUF BREAK.OR.SEPRP DISPLAYTERMP EMPTY.BUFFER EMPTY.LINE EQPOS NEQPOS
INPART ON.FIRST.LINE ON.LAST.LINE METACHARP NONMETACHARBITS METACHAR
COMPLEXCHARP SPACEP TTBOUT TTNEXTCHAR WORDSEPRP FCHARWIDTH FIRSTCHAR))
(DECLARE%: EVAL@COMPILE
(PUTPROPS TYPEAHEAD? MACRO (NIL (\SYSBUFP)))
@@ -5796,68 +5798,67 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
(PUTPROPS AT.END.OF.BUF MACRO (NIL (EQ \CURSOR \ENDBUFFER)))
(PUTPROPS AT.END.OF.LINE MACRO (NIL (EQ (fetch END of \ARROW)
\CURSOR)))
\CURSOR)))
(PUTPROPS AT.START.OF.BUF MACRO (NIL (EQ \CURSOR \BUFFER)))
(PUTPROPS AT.START.OF.LINE MACRO (NIL (EQ (fetch (LINE START) of \ARROW)
\CURSOR)))
\CURSOR)))
(PUTPROPS BEFOREBUF MACRO ((THIS THAT END)
(BUFTAILP THAT THIS END)))
(BUFTAILP THAT THIS END)))
(PUTPROPS BREAK.OR.SEPRP MACRO ((C)
(fetch STOPATOM of (\SYNCODE \RDTBLSA C))))
(fetch STOPATOM of (\SYNCODE \RDTBLSA C))))
(PUTPROPS DISPLAYTERMP ALTOMACRO (NIL T))
(PUTPROPS EMPTY.BUFFER MACRO (NIL (EQ \BUFFER \ENDBUFFER)))
(PUTPROPS EMPTY.LINE MACRO [X (SUBST (OR (CAR X)
'\ARROW)
'\ARROW
'(EQ (fetch (LINE START) of \ARROW)
(fetch (LINE END) of \ARROW])
'\ARROW)
'\ARROW
'(EQ (fetch (LINE START) of \ARROW)
(fetch (LINE END) of \ARROW])
(PUTPROPS EQPOS MACRO [(X Y)
(AND (EQ (fetch COLPOS of X)
(fetch COLPOS of Y))
(EQ (fetch ROWPOS of X)
(fetch ROWPOS of Y])
(AND (EQ (fetch COLPOS of X)
(fetch COLPOS of Y))
(EQ (fetch ROWPOS of X)
(fetch ROWPOS of Y])
(PUTPROPS NEQPOS MACRO ((X Y)
(NOT (EQPOS X Y))))
(NOT (EQPOS X Y))))
(PUTPROPS INPART MACRO (OPENLAMBDA (X)
(COND
((LISTP X)
(CAR X))
(T X))))
(COND
((LISTP X)
(CAR X))
(T X))))
(PUTPROPS ON.FIRST.LINE MACRO (NIL (EQ \FIRSTLINE \ARROW)))
(PUTPROPS ON.LAST.LINE MACRO (NIL (EQ (fetch END of \ARROW)
\ENDBUFFER)))
\ENDBUFFER)))
(PUTPROPS METACHARP MACRO ((C)
(EQ (LRSH C 8)
(LRSH (CHARCODE Meta,0)
8))))
(EQ (LRSH C 8)
(LRSH (CHARCODE Meta,0)
8))))
(PUTPROPS NONMETACHARBITS MACRO ((C)
(LOGAND C 255)))
(LOGAND C 255)))
(PUTPROPS METACHAR MACRO ((C)
(LOGOR C (CHARCODE Meta,0))))
(LOGOR C (CHARCODE Meta,0))))
(PUTPROPS COMPLEXCHARP MACRO (= . LISTP))
(PUTPROPS SPACEP MACRO [(CHAR)
(FMEMB CHAR (CHARCODE (SPACE TAB CR])
(FMEMB CHAR (CHARCODE (SPACE TAB CR])
(PUTPROPS TTBOUT MACRO [X (CONS 'PROGN (for ARG in X
collect
(LIST 'BLTCHAR (OR (FIXP ARG)
collect (LIST 'BLTCHAR (OR (FIXP ARG)
(CDR (ASSOC ARG DMCHARCODES))
(AND (EQ (NCHARS ARG)
1)
@@ -5868,20 +5869,20 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
(PUTPROPS TTNEXTCHAR MACRO (= . CDR))
(PUTPROPS WORDSEPRP DMACRO [OPENLAMBDA (X)
(OR (EQ (\SYNCODE \PRIMTERMSA X)
WORDSEPR.TC)
(fetch STOPATOM of (\SYNCODE \RDTBLSA X])
(OR (EQ (\SYNCODE \PRIMTERMSA X)
WORDSEPR.TC)
(fetch STOPATOM of (\SYNCODE \RDTBLSA X])
(PUTPROPS FCHARWIDTH MACRO (= . CHARWIDTH))
(PUTPROPS FIRSTCHAR MACRO ((BUF)
([LAMBDA (CH)
(DECLARE (LOCALVARS CH))
(COND
((COMPLEXCHARP CH)
(fetch CPXREALCHAR of CH))
(T CH]
(CAR BUF))))
([LAMBDA (CH)
(DECLARE (LOCALVARS CH))
(COND
((COMPLEXCHARP CH)
(fetch CPXREALCHAR of CH))
(T CH]
(CAR BUF))))
)
(DECLARE%: EVAL@COMPILE
@@ -5889,8 +5890,8 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
(RECORD TTYINBUFFER (FIRSTLINE OLDTAIL LASTSKIP LASTSKIPCHAR STORAGECOUNTER TTYINWINDOW
. TTYINWINDOWSTATE)
(SUBRECORD TTYINWINDOWSTATE)
STORAGECOUNTER _ 0)
(SUBRECORD TTYINWINDOWSTATE)
STORAGECOUNTER _ 0)
(RECORD TTYINWINDOWSTATE (TTOLDBUTTONFN TTOLDRIGHTFN TTOLDENTRYFN))
@@ -5899,13 +5900,13 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
(RECORD COMPLEXCHAR (CPXREALCHAR CPXWIDTH CPXNCHARS . CPXPRINTCHARS))
(ACCESSFNS TTYINBUFFERSTREAM ((TTYINPUT (fetch (STREAM F1) of DATUM)
(replace (STREAM F1) of DATUM with NEWVALUE))
(TTYEOF (fetch (STREAM F2) of DATUM)
(replace (STREAM F2) of DATUM with NEWVALUE))
(TTYEOFACTION (fetch (STREAM F3) of DATUM)
(replace (STREAM F3) of DATUM with NEWVALUE))
(TTYORIGINPUT (fetch (STREAM F4) of DATUM)
(replace (STREAM F4) of DATUM with NEWVALUE))))
(replace (STREAM F1) of DATUM with NEWVALUE))
(TTYEOF (fetch (STREAM F2) of DATUM)
(replace (STREAM F2) of DATUM with NEWVALUE))
(TTYEOFACTION (fetch (STREAM F3) of DATUM)
(replace (STREAM F3) of DATUM with NEWVALUE))
(TTYORIGINPUT (fetch (STREAM F4) of DATUM)
(replace (STREAM F4) of DATUM with NEWVALUE))))
)
(RPAQQ DMCHARCODES
@@ -5969,16 +5970,16 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
(DECLARE%: DONTEVAL@COMPILE
[SETTEMPLATE 'TTBOUT '(CALL |..| (IF [OR (LISTP EXPR)
(AND (NTHCHAR EXPR 2)
(NOT (ASSOC EXPR DMCHARCODES]
EVAL NIL]
(AND (NTHCHAR EXPR 2)
(NOT (ASSOC EXPR DMCHARCODES]
EVAL NIL]
[SETTEMPLATE 'TTBOUTN '(MACRO (X . Y)
(FRPTQ X (TTBOUT . Y]
DONTEVAL@LOAD EVAL@COMPILE
(RPAQ DONTCOMPILEFNS (UNION (UNION TTYINMACROS TTSUPPORTFNS)
DONTCOMPILEFNS))
DONTCOMPILEFNS))
)
)
@@ -6076,62 +6077,62 @@ DONTEVAL@LOAD EVAL@COMPILE
(PUTPROPS TTYIN COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7796 207831 (TTYIN 7806 . 21039) (TTYIN.SETUP 21041 . 24117) (TTYIN.CLEANUP 24119 .
24947) (TTYIN1 24949 . 51833) (TTYIN1RESTART 51835 . 53099) (TTYIN.FINISH 53101 . 62518) (
TTYIN.BALANCE 62520 . 63646) (ADDCHAR 63648 . 65834) (TTMAKECOMPLEXCHAR 65836 . 66310) (ADDNAKEDCHAR
66312 . 67822) (TTADDTAB 67824 . 68759) (ADJUSTLINE 68761 . 82672) (ADJUSTLINE.AND.RESTORE 82674 .
83112) (AT.END.OF.SCREEN 83114 . 83402) (AT.END.OF.TEXT 83404 . 83859) (AUTOCR? 83861 . 84335) (
BACKSKREAD 84337 . 88922) (BACKWARD.DELETE.TO 88924 . 89106) (BREAKLINE 89108 . 91375) (BUFTAILP 91377
. 91695) (CHECK.MARGIN 91697 . 92320) (CLEAR.LINE? 92322 . 92615) (CURRENT.WORD 92617 . 95017) (
DELETE.TO.END 95019 . 95738) (DELETELINE 95740 . 98697) (DELETETO 98699 . 100521) (DELETETO1 100523 .
101866) (DO.EDIT.COMMAND 101868 . 119187) (DO.EDIT.PP 119189 . 121851) (TTDOTABS 121853 . 123223) (
EDITCOLUMN 123225 . 123681) (EDITNUMBERP 123683 . 123914) (END.DELETE.MODE 123916 . 124433) (ENDREAD?
124435 . 126870) (FIND.LINE 126872 . 128408) (FIND.LINE.BREAK 128410 . 129080) (FIND.MATCHING.QUOTE
129082 . 129927) (FIND.NEXT.WORD 129929 . 131308) (FIND.NON.SPACE 131310 . 131583) (FIND.START.OF.WORD
131585 . 131948) (FORWARD.DELETE.TO 131950 . 134172) (GO.TO.ADDRESSING 134174 . 135130) (
GO.TO.FREELINE 135132 . 135713) (GO.TO.RELATIVE 135715 . 136495) (INIT.CURSOR 136497 . 137394) (
INSERT.NODE 137396 . 137918) (INSERTLINE 137920 . 139424) (KILL.LINES 139426 . 139964) (KILLSEGMENT
139966 . 141089) (L-CASECODE 141091 . 141252) (MOVE.BACK.TO 141254 . 141483) (MOVE.FORWARD.TO 141485
. 141906) (MOVE.TO.LINE 141908 . 142823) (MOVE.TO.NEXT.LINE 142825 . 143095) (MOVE.TO.START.OF.WORD
143097 . 143861) (MOVE.TO.WHEREVER 143863 . 144086) (NTH.COLUMN.OF 144088 . 144419) (
NTH.RELATIVE.COLUMN.OF 144421 . 145721) (OVERFLOW? 145723 . 146671) (OVERFLOWLINE? 146673 . 146999) (
PREVLINE 147001 . 148181) (PREVWORD 148183 . 150324) (PROPERTAILP 150326 . 150533) (READFROMBUF 150535
. 153124) (RENUMBER.LINES 153126 . 153519) (RESTORE.CURSOR 153521 . 153675) (RESTOREBUF 153677 .
155861) (RETYPE.BUFFER 155863 . 158126) (SAVE.CURSOR 158128 . 158300) (SCANBACK 158302 . 159660) (
SCANFORWARD 159662 . 160530) (SCRATCHCONS 160532 . 161134) (SEGMENT.LENGTH 161136 . 161672) (
SEGMENT.BIT.LENGTH 161674 . 162281) (SETLASTC 162283 . 162580) (SETTAIL? 162582 . 163398) (
SHOW.MATCHING.PAREN 163400 . 165900) (SKIP/ZAP 165902 . 168381) (START.NEW.LINE 168383 . 168715) (
START.OF.PARAGRAPH? 168717 . 169098) (TTADJUSTWORD 169100 . 170274) (TTBIN 170276 . 171482) (
TTBITWIDTH 171484 . 171633) (TTCRLF 171635 . 171842) (TTCRLF.ACCOUNT 171844 . 172484) (TTDELETECHAR
172486 . 173630) (TTDELETELINE 173632 . 175580) (TTDELETEWORD 175582 . 176250) (TTECHO.TO.FILE 176252
. 179811) (TTGIVEHELP 179813 . 181078) (TTGIVEHELP1 181080 . 181662) (TTGIVEHELP2 181664 . 182359) (
TTLASTLINE 182361 . 182729) (TTLOADBUF 182731 . 186225) (TTNEXTLINE 186227 . 186547) (TTNEXTNODE
186549 . 186788) (TTNLEFT 186790 . 188017) (TTNTH 188019 . 188478) (TTNTHLINE 188480 . 189012) (
TTPRIN1 189014 . 192827) (TTPRINSPACE 192829 . 193222) (TTPRIN1COMMENT 193224 . 193548) (TTPRIN2
193550 . 195869) (TTPROMPTCHAR 195871 . 196767) (TTRUBOUT 196769 . 197732) (TTUNREADBUF 197734 .
198143) (TTWAITFORINPUT 198145 . 202353) (TTYINSTRING 202355 . 203314) (TYPE.BUFFER 203316 . 205068) (
U-CASECODE 205070 . 205229) (U/L-CASE 205231 . 207829)) (207986 217345 (TTRATOM 207996 . 208440) (
TTREADLIST 208442 . 208809) (TTSKIPSEPR 208811 . 209185) (TTSKREAD 209187 . 213827) (TTYIN.READ 213829
. 217343)) (217392 237436 (FIND.MATCHING.WORD 217402 . 217930) (TTCOMPLETEWORD 217932 . 232360) (
WORD.MATCHES.BUFFER 232362 . 233922) (TTYIN.SHOW.?ALTERNATIVES 233924 . 237434)) (237470 255780 (
DO?CMD 237480 . 243382) (TTYIN.PRINTARGS 243384 . 254242) (TTYIN.READ?=ARGS 254244 . 255025) (
DO?CMD.ERRORHANDLER 255027 . 255778)) (255814 263887 (BEEP 255824 . 255999) (BITBLT.DELETE 256001 .
256648) (BITBLT.ERASE 256650 . 256835) (BITBLT.INSERT 256837 . 257148) (DO.CRLF 257150 . 257469) (
DO.DELETE.LINES 257471 . 258515) (DO.INSERT.LINE 258517 . 260451) (DO.LF 260453 . 260619) (
ERASE.TO.END.OF.LINE 260621 . 260946) (ERASE.TO.END.OF.PAGE 260948 . 261553) (INSERT.TEXT 261555 .
262059) (TTDELSECTION 262061 . 262359) (TTADJUSTWIDTH 262361 . 263225) (TTINSERTSECTION 263227 .
263566) (TTSETCURSOR 263568 . 263885)) (263922 268899 (TTYINBUFFERDEVICE 263932 . 265248) (
TTYINBUFFERSTREAM 265250 . 266012) (TTYINBUFFERBIN 266014 . 266550) (TTYINBUFFERPEEK 266552 . 267030)
(TTYINBUFFERREADP 267032 . 267287) (TTYINBUFFEREOFP 267289 . 267541) (TTYINBUFFERBACKPTR 267543 .
268095) (TTYINWORDRDTBL 268097 . 268897)) (269060 294617 (DO.MOUSE 269070 . 271827) (
DO.SHIFTED.SELECTION 271829 . 282268) (COPY.SEGMENT 282270 . 282474) (DELETE.LONG.SEGMENT 282476 .
282835) (DELETE.LONG.SEGMENT1 282837 . 285313) (INVERT.LONG.SEGMENT 285315 . 286344) (INVERT.SEGMENT
286346 . 287861) (BRACKET.CURRENT.WORD 287863 . 289397) (TTBEFOREPOS 289399 . 290129) (TTNEXTPOS
290131 . 290839) (TTRACKMOUSE 290841 . 294615)) (294761 300016 (SETREADFN 294771 . 295249) (
TTYINENTRYFN 295251 . 295676) (TTYINREADP 295678 . 296142) (TTYINREAD 296144 . 297538) (TTYINFIX
297540 . 298739) (CHARMACRO? 298741 . 299308) (TTYINMETA 299310 . 299438) (TTYIN.LASTINPUT 299440 .
300014)) (300017 308286 (TTYINEDIT 300027 . 302144) (SIMPLETEXTEDIT 302146 . 305190) (
SET.TTYINEDIT.WINDOW 305192 . 306343) (TTYIN.PPTOFILE 306345 . 308284)) (308344 308521 (
MAKE-TTSCRATCHFILE 308354 . 308519)) (308668 309801 (TTYIN.SCRATCHFILE 308678 . 309124) (\TTYIN.RPEOF
309126 . 309799)) (310013 313646 (TTYINPROMPTFORWORD 310023 . 313644)))))
(FILEMAP (NIL (7815 207850 (TTYIN 7825 . 21058) (TTYIN.SETUP 21060 . 24136) (TTYIN.CLEANUP 24138 .
24966) (TTYIN1 24968 . 51852) (TTYIN1RESTART 51854 . 53118) (TTYIN.FINISH 53120 . 62537) (
TTYIN.BALANCE 62539 . 63665) (ADDCHAR 63667 . 65853) (TTMAKECOMPLEXCHAR 65855 . 66329) (ADDNAKEDCHAR
66331 . 67841) (TTADDTAB 67843 . 68778) (ADJUSTLINE 68780 . 82691) (ADJUSTLINE.AND.RESTORE 82693 .
83131) (AT.END.OF.SCREEN 83133 . 83421) (AT.END.OF.TEXT 83423 . 83878) (AUTOCR? 83880 . 84354) (
BACKSKREAD 84356 . 88941) (BACKWARD.DELETE.TO 88943 . 89125) (BREAKLINE 89127 . 91394) (BUFTAILP 91396
. 91714) (CHECK.MARGIN 91716 . 92339) (CLEAR.LINE? 92341 . 92634) (CURRENT.WORD 92636 . 95036) (
DELETE.TO.END 95038 . 95757) (DELETELINE 95759 . 98716) (DELETETO 98718 . 100540) (DELETETO1 100542 .
101885) (DO.EDIT.COMMAND 101887 . 119206) (DO.EDIT.PP 119208 . 121870) (TTDOTABS 121872 . 123242) (
EDITCOLUMN 123244 . 123700) (EDITNUMBERP 123702 . 123933) (END.DELETE.MODE 123935 . 124452) (ENDREAD?
124454 . 126889) (FIND.LINE 126891 . 128427) (FIND.LINE.BREAK 128429 . 129099) (FIND.MATCHING.QUOTE
129101 . 129946) (FIND.NEXT.WORD 129948 . 131327) (FIND.NON.SPACE 131329 . 131602) (FIND.START.OF.WORD
131604 . 131967) (FORWARD.DELETE.TO 131969 . 134191) (GO.TO.ADDRESSING 134193 . 135149) (
GO.TO.FREELINE 135151 . 135732) (GO.TO.RELATIVE 135734 . 136514) (INIT.CURSOR 136516 . 137413) (
INSERT.NODE 137415 . 137937) (INSERTLINE 137939 . 139443) (KILL.LINES 139445 . 139983) (KILLSEGMENT
139985 . 141108) (L-CASECODE 141110 . 141271) (MOVE.BACK.TO 141273 . 141502) (MOVE.FORWARD.TO 141504
. 141925) (MOVE.TO.LINE 141927 . 142842) (MOVE.TO.NEXT.LINE 142844 . 143114) (MOVE.TO.START.OF.WORD
143116 . 143880) (MOVE.TO.WHEREVER 143882 . 144105) (NTH.COLUMN.OF 144107 . 144438) (
NTH.RELATIVE.COLUMN.OF 144440 . 145740) (OVERFLOW? 145742 . 146690) (OVERFLOWLINE? 146692 . 147018) (
PREVLINE 147020 . 148200) (PREVWORD 148202 . 150343) (PROPERTAILP 150345 . 150552) (READFROMBUF 150554
. 153143) (RENUMBER.LINES 153145 . 153538) (RESTORE.CURSOR 153540 . 153694) (RESTOREBUF 153696 .
155880) (RETYPE.BUFFER 155882 . 158145) (SAVE.CURSOR 158147 . 158319) (SCANBACK 158321 . 159679) (
SCANFORWARD 159681 . 160549) (SCRATCHCONS 160551 . 161153) (SEGMENT.LENGTH 161155 . 161691) (
SEGMENT.BIT.LENGTH 161693 . 162300) (SETLASTC 162302 . 162599) (SETTAIL? 162601 . 163417) (
SHOW.MATCHING.PAREN 163419 . 165919) (SKIP/ZAP 165921 . 168400) (START.NEW.LINE 168402 . 168734) (
START.OF.PARAGRAPH? 168736 . 169117) (TTADJUSTWORD 169119 . 170293) (TTBIN 170295 . 171501) (
TTBITWIDTH 171503 . 171652) (TTCRLF 171654 . 171861) (TTCRLF.ACCOUNT 171863 . 172503) (TTDELETECHAR
172505 . 173649) (TTDELETELINE 173651 . 175599) (TTDELETEWORD 175601 . 176269) (TTECHO.TO.FILE 176271
. 179830) (TTGIVEHELP 179832 . 181097) (TTGIVEHELP1 181099 . 181681) (TTGIVEHELP2 181683 . 182378) (
TTLASTLINE 182380 . 182748) (TTLOADBUF 182750 . 186244) (TTNEXTLINE 186246 . 186566) (TTNEXTNODE
186568 . 186807) (TTNLEFT 186809 . 188036) (TTNTH 188038 . 188497) (TTNTHLINE 188499 . 189031) (
TTPRIN1 189033 . 192846) (TTPRINSPACE 192848 . 193241) (TTPRIN1COMMENT 193243 . 193567) (TTPRIN2
193569 . 195888) (TTPROMPTCHAR 195890 . 196786) (TTRUBOUT 196788 . 197751) (TTUNREADBUF 197753 .
198162) (TTWAITFORINPUT 198164 . 202372) (TTYINSTRING 202374 . 203333) (TYPE.BUFFER 203335 . 205087) (
U-CASECODE 205089 . 205248) (U/L-CASE 205250 . 207848)) (208005 217364 (TTRATOM 208015 . 208459) (
TTREADLIST 208461 . 208828) (TTSKIPSEPR 208830 . 209204) (TTSKREAD 209206 . 213846) (TTYIN.READ 213848
. 217362)) (217411 237455 (FIND.MATCHING.WORD 217421 . 217949) (TTCOMPLETEWORD 217951 . 232379) (
WORD.MATCHES.BUFFER 232381 . 233941) (TTYIN.SHOW.?ALTERNATIVES 233943 . 237453)) (237489 255799 (
DO?CMD 237499 . 243401) (TTYIN.PRINTARGS 243403 . 254261) (TTYIN.READ?=ARGS 254263 . 255044) (
DO?CMD.ERRORHANDLER 255046 . 255797)) (255833 263906 (BEEP 255843 . 256018) (BITBLT.DELETE 256020 .
256667) (BITBLT.ERASE 256669 . 256854) (BITBLT.INSERT 256856 . 257167) (DO.CRLF 257169 . 257488) (
DO.DELETE.LINES 257490 . 258534) (DO.INSERT.LINE 258536 . 260470) (DO.LF 260472 . 260638) (
ERASE.TO.END.OF.LINE 260640 . 260965) (ERASE.TO.END.OF.PAGE 260967 . 261572) (INSERT.TEXT 261574 .
262078) (TTDELSECTION 262080 . 262378) (TTADJUSTWIDTH 262380 . 263244) (TTINSERTSECTION 263246 .
263585) (TTSETCURSOR 263587 . 263904)) (263941 269072 (TTYINBUFFERDEVICE 263951 . 265267) (
TTYINBUFFERSTREAM 265269 . 266185) (TTYINBUFFERBIN 266187 . 266723) (TTYINBUFFERPEEK 266725 . 267203)
(TTYINBUFFERREADP 267205 . 267460) (TTYINBUFFEREOFP 267462 . 267714) (TTYINBUFFERBACKPTR 267716 .
268268) (TTYINWORDRDTBL 268270 . 269070)) (269233 294790 (DO.MOUSE 269243 . 272000) (
DO.SHIFTED.SELECTION 272002 . 282441) (COPY.SEGMENT 282443 . 282647) (DELETE.LONG.SEGMENT 282649 .
283008) (DELETE.LONG.SEGMENT1 283010 . 285486) (INVERT.LONG.SEGMENT 285488 . 286517) (INVERT.SEGMENT
286519 . 288034) (BRACKET.CURRENT.WORD 288036 . 289570) (TTBEFOREPOS 289572 . 290302) (TTNEXTPOS
290304 . 291012) (TTRACKMOUSE 291014 . 294788)) (294934 300189 (SETREADFN 294944 . 295422) (
TTYINENTRYFN 295424 . 295849) (TTYINREADP 295851 . 296315) (TTYINREAD 296317 . 297711) (TTYINFIX
297713 . 298912) (CHARMACRO? 298914 . 299481) (TTYINMETA 299483 . 299611) (TTYIN.LASTINPUT 299613 .
300187)) (300190 308459 (TTYINEDIT 300200 . 302317) (SIMPLETEXTEDIT 302319 . 305363) (
SET.TTYINEDIT.WINDOW 305365 . 306516) (TTYIN.PPTOFILE 306518 . 308457)) (308517 308694 (
MAKE-TTSCRATCHFILE 308527 . 308692)) (308841 309974 (TTYIN.SCRATCHFILE 308851 . 309297) (\TTYIN.RPEOF
309299 . 309972)) (310186 313819 (TTYINPROMPTFORWORD 310196 . 313817)))))
STOP

BIN
sources/TTYIN.LCOM
View File

Binary file not shown.

BIN
sources/UFS.LCOM
View File

Binary file not shown.

33
sources/XCCS
View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Jun-2022 14:33:06" {DSK}<users>kaplan>local>medley3.5>working-medley>sources>XCCS.;48 13142
(FILECREATED "30-Jun-2022 18:08:18" {DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>XCCS.;51 12897
:CHANGES-TO (VARS XCCSCOMS)
:CHANGES-TO (FNS \CREATE.XCCS.EXTERNALFORMAT)
:PREVIOUS-DATE "10-Sep-2021 19:49:22"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>XCCS.;47)
:PREVIOUS-DATE "30-Jun-2022 10:02:25"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>XCCS.;50)
(PRETTYCOMPRINT XCCSCOMS)
@@ -16,10 +16,6 @@
(FNS \CREATE.XCCS.EXTERNALFORMAT)
(FNS \NSIN.24BITENCODING.ERROR)
(INITVARS (*SIGNAL-24BIT-NSENCODING-ERROR*))
(INITVARS (\DEFAULTINCCODE '\XCCSINCCODE)
(\DEFAULTOUTCHAR '\XCCSOUTCHAR)
(\DEFAULTPEEKCCODE '\XCCSPEEKCCODE)
(\DEFAULTBACKCCODE '\XCCSBACKCCODE))
(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS (\NORUNCODE 255)
(NSCHARSETSHIFT 255))
(MACROS \RUNCODED)
@@ -210,7 +206,8 @@
(DEFINEQ
(\CREATE.XCCS.EXTERNALFORMAT
[LAMBDA (NAME EOL) (* ; "Edited 10-Sep-2021 19:49 by rmk:")
[LAMBDA (NAME EOL) (* ; "Edited 30-Jun-2022 18:08 by rmk")
(* ; "Edited 10-Sep-2021 19:49 by rmk:")
(* ;;; "Create the :XCCS external format. Stream's EOL overrides the (vacuous) default here")
@@ -222,7 +219,7 @@
(FUNCTION \XCCSBACKCCODE)
(FUNCTION \XCCSOUTCHAR)
(FUNCTION \XCCSFORMATBYTESTREAM)
EOL T])
EOL T NIL])
)
(DEFINEQ
@@ -241,14 +238,6 @@
)
(RPAQ? *SIGNAL-24BIT-NSENCODING-ERROR* )
(RPAQ? \DEFAULTINCCODE '\XCCSINCCODE)
(RPAQ? \DEFAULTOUTCHAR '\XCCSOUTCHAR)
(RPAQ? \DEFAULTPEEKCCODE '\XCCSPEEKCCODE)
(RPAQ? \DEFAULTBACKCCODE '\XCCSBACKCCODE)
(DECLARE%: EVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
@@ -286,8 +275,8 @@
(\CREATE.XCCS.EXTERNALFORMAT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1218 1447 (ACCESS-CHARSET 1228 . 1445)) (1448 10316 (\XCCSINCCODE 1458 . 4230) (
\XCCSPEEKCCODE 4232 . 6768) (\XCCSOUTCHAR 6770 . 8990) (\XCCSBACKCCODE 8992 . 9987) (
\XCCSFORMATBYTESTREAM 9989 . 10314)) (10317 10875 (\CREATE.XCCS.EXTERNALFORMAT 10327 . 10873)) (10876
11707 (\NSIN.24BITENCODING.ERROR 10886 . 11705)))))
(FILEMAP (NIL (1036 1265 (ACCESS-CHARSET 1046 . 1263)) (1266 10134 (\XCCSINCCODE 1276 . 4048) (
\XCCSPEEKCCODE 4050 . 6586) (\XCCSOUTCHAR 6588 . 8808) (\XCCSBACKCCODE 8810 . 9805) (
\XCCSFORMATBYTESTREAM 9807 . 10132)) (10135 10810 (\CREATE.XCCS.EXTERNALFORMAT 10145 . 10808)) (10811
11642 (\NSIN.24BITENCODING.ERROR 10821 . 11640)))))
STOP

BIN
sources/XCCS.LCOM
View File

Binary file not shown.