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

Rmk158 Remake files to convert the 247Q package-delimiter in DEFINE-FILE-INFO to 30Q (#2506)

Browse Source 
* Remake files to convert the 247Q package-delimiter in DEFINE-FILE-INFO expressions to 30Q

* Remake TRANSOR after removing HIST command

* Remake TRANSOR-LOADTRAN after changing the filecoms variable
This commit is contained in:
rmkaplan
2026-02-23 12:04:11 -08:00
committed by GitHub
parent cc0a819cd5
commit 93a04227d8
29 changed files with 889 additions and 879 deletions
Download Patch File Download Diff File Expand all files Collapse all files

127
library/lafite/LAFITE-INDENT
View File

@@ -1,13 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "15-Feb-2025 14:11:54" {WMEDLEY}<library>lafite>LAFITE-INDENT.;4 26926
(FILECREATED "18-Feb-2026 15:47:08" {WMEDLEY}<library>LAFITE>LAFITE-INDENT.;2 26210
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT-INDENT-BREAK-LONG-LINES TEDIT-INDENT-SELECTION TEDIT-OPEN-LINE
TEDIT-MAKE-LINES-EXPLICIT TEDIT-INDENT-SET-INDENT)
:PREVIOUS-DATE "15-Feb-2025 09:21:58" {WMEDLEY}<library>lafite>LAFITE-INDENT.;3)
:PREVIOUS-DATE "22-Jan-87 01:34:36" {WMEDLEY}<library>LAFITE>LAFITE-INDENT.;1)
(PRETTYCOMPRINT LAFITE-INDENTCOMS)
@@ -133,10 +130,14 @@
max-length max-length])
(TEDIT-INDENT-BREAK-LONG-LINES
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
(* smL "21-Jan-87 16:03")
(* ;;; "Break the current selection into explicit lines, each having no more than *TEDIT-INDENT-LINE-LENGTH* characters. --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed. --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:03")
(* * Break the current selection into explicit lines, each having no more than
 *TEDIT-INDENT-LINE-LENGTH* characters. -
 If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in
 the current selection are removed. -
 This is intended to be used in Lafite, where one wants to indent a piece of a
 forwarded document, but can be used in any TEdit document)
(LET ((selection (TEDIT.GETSEL text-stream)))
(TEDIT-INDENT-REPLACE-SELECTION
@@ -144,13 +145,11 @@
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
text-stream selection)
explicit-paragraph-breaks?)
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
LCHAR1)
(TEDIT.SELPROP selection 'CH#]
(DIFFERENCE (TEDIT.SELPROP selection
'CH#)
(GETLD (CAR (GETSEL selection L1))
LCHAR1]
bind [hanging-indent _
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
(fetch CH# of selection)))
(DIFFERENCE (fetch CH# of selection)
(fetch CHAR1 of (CAR (fetch L1 of selection]
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
"" *TEDIT-INDENT-LINE-LENGTH* hanging-indent)
*eol-string*)
@@ -185,10 +184,15 @@
'RIGHT])
(TEDIT-INDENT-SELECTION
[LAMBDA (text-stream explicit-paragraph-breaks?) (* ; "Edited 15-Feb-2025 14:07 by rmk")
(* smL "21-Jan-87 16:00")
(* ;;; "Indent the current selection by prefacing each line with the value of *TEDIT-INDENT-STRING*, and inserting line breaks after each *TEDIT-INDENT-LINE-LENGTH* characters. --- If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are removed. --- This is intended to be used in Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit document")
[LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:00")
(* * Indent the current selection by prefacing each line with the value of
 *TEDIT-INDENT-STRING*, and inserting line breaks after each
 *TEDIT-INDENT-LINE-LENGTH* characters. -
 If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in
 the current selection are removed. -
 This is intended to be used in Lafite, where one wants to indent a piece of a
 forwarded document, but can be used in any TEdit document)
(LET ((selection (TEDIT.GETSEL text-stream)))
(TEDIT-INDENT-REPLACE-SELECTION
@@ -196,13 +200,11 @@
(CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
text-stream selection)
explicit-paragraph-breaks?)
bind [hanging-indent _ (AND [NOT (EQP (GETLD (CAR (GETSEL selection L1))
LCHAR1)
(TEDIT.SELPROP selection 'CH#]
(DIFFERENCE (TEDIT.SELPROP selection
'CH#)
(GETLD (CAR (GETSEL selection L1))
LCHAR1]
bind [hanging-indent _
(AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of selection)))
(fetch CH# of selection)))
(DIFFERENCE (fetch CH# of selection)
(fetch CHAR1 of (CAR (fetch L1 of selection]
join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string)
*TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*
hanging-indent)
@@ -232,19 +234,18 @@
else (\TEDIT-INDENT-SEPERATE-PARAGRAPHS string NIL])
(TEDIT-INDENT-SET-INDENT
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:21 by rmk")
(* smL "12-Sep-86 17:09")
[LAMBDA (text-stream) (* smL "12-Sep-86 17:09")
(* * Prompt the user for a new indentation string)
(* ;;; "Prompt the user for a new indentation string")
(LET* ((window (\TEDIT.PRIMARYPANE text-stream))
(LET* ((window (fetch \WINDOW of (TEXTOBJ text-stream)))
(pwindow (if window
then (GETPROMPTWINDOW (if (LISTP window)
then (CAR window)
else window))
else PROMPTWINDOW)))
(CLEARW pwindow)
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING* NIL
pwindow NIL NIL (LIST (CHARCODE EOL])
(TEDIT-INDENT-STRIP-INDENTATION
@@ -269,34 +270,36 @@
else string])
(TEDIT-MAKE-LINES-EXPLICIT
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 09:20 by rmk")
(* smL " 8-Sep-86 18:20")
(* ;;; "Take the current selection and replace all TEdit end-of-lines with explicit line breaks. --- This is intended to be used in Lafite, where it is sometimes nice to know that anyone receiving the msg will see the same line breaks that you see. see, but can be used in any TEdit document")
[LAMBDA (text-stream) (* smL " 8-Sep-86 18:20")
(* * Take the current selection and replace all TEdit end-of-lines with
 explicit line breaks. -
 This is intended to be used in Lafite, where it is sometimes nice to know that
 anyone receiving the msg will see the same line breaks that you see.
 see, but can be used in any TEdit document)
(LET ((selection (TEDIT.GETSEL text-stream)))
[for i in (bind (this-line _ (CAR (GETSEL selection L1)))
[last-line _ (CAR (LAST (GETSEL selection LN]
repeatuntil (PROGN (SETQ this-line (GETLD this-line NEXTLINE))
(EQ this-line last-line)) collect (GETLD this-line LCHARLIM)
) do (TEDIT.SETSEL text-stream i 1 'LEFT T)
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
[for i in (bind (this-line _ (CAR (fetch L1 of selection)))
[last-line _ (CAR (LAST (fetch LN of selection]
repeatuntil (PROGN (SETQ this-line (fetch NEXTLINE of this-line))
(EQ this-line last-line)) collect (fetch CHARLIM
of this-line))
do (TEDIT.SETSEL text-stream i 1 'LEFT T)
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
(TEDIT.SETSEL text-stream selection NIL 'RIGHT])
(TEDIT-OPEN-LINE
[LAMBDA (text-stream) (* ; "Edited 15-Feb-2025 14:09 by rmk")
(* smL "17-Sep-86 11:13")
(* ;;; "Open a new line at the current position.")
[LAMBDA (text-stream) (* smL "17-Sep-86 11:13")
(* * Open a new line at the current position.)
(LET ((selection (TEDIT.GETSEL text-stream)))
(TEDIT.INSERT text-stream (CONCAT *eol-string* (ALLOCSTRING
(DIFFERENCE (TEDIT.SELPROP selection
'CH#)
(GETLD (CAR (GETSEL selection L1))
LCHAR1))
" ")))
(if (ZEROP (TEDIT.SELPROP selection 'LENGTH))
(TEDIT.INSERT text-stream (CONCAT *eol-string*
(ALLOCSTRING [DIFFERENCE (fetch CH# of selection)
(fetch CHAR1
of (CAR (fetch L1 of selection]
" ")))
(if (ZEROP (fetch DCH of selection))
then (TEDIT.SETSEL text-stream selection])
(TEDIT-REMOVE-INDENT
@@ -433,12 +436,12 @@
"Break long lines by inserting explicit <RETURN>'s"
]
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4363 24314 (TEDIT-INDENT-ADD-INDENTATION 4373 . 6941) (TEDIT-INDENT-BREAK-LINE 6943 .
8876) (TEDIT-INDENT-BREAK-LONG-LINES 8878 . 10828) (TEDIT-INDENT-FIND-BREAKPOINT 10830 . 11653) (
TEDIT-INDENT-REPLACE-SELECTION 11655 . 12212) (TEDIT-INDENT-SELECTION 12214 . 14283) (
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 14285 . 14564) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14566 .
15295) (TEDIT-INDENT-SET-INDENT 15297 . 16143) (TEDIT-INDENT-STRIP-INDENTATION 16145 . 17365) (
TEDIT-MAKE-LINES-EXPLICIT 17367 . 18517) (TEDIT-OPEN-LINE 18519 . 19453) (TEDIT-REMOVE-INDENT 19455 .
20225) (\TEDIT-INDENT-COUNT-SPACES 20227 . 20828) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20830 . 21801) (
\TEDIT-INDENT-SEPERATE-LINES 21803 . 22601) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 22603 . 24312)))))
(FILEMAP (NIL (4193 23598 (TEDIT-INDENT-ADD-INDENTATION 4203 . 6771) (TEDIT-INDENT-BREAK-LINE 6773 .
8706) (TEDIT-INDENT-BREAK-LONG-LINES 8708 . 10475) (TEDIT-INDENT-FIND-BREAKPOINT 10477 . 11300) (
TEDIT-INDENT-REPLACE-SELECTION 11302 . 11859) (TEDIT-INDENT-SELECTION 11861 . 13762) (
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 13764 . 14043) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14045 .
14774) (TEDIT-INDENT-SET-INDENT 14776 . 15550) (TEDIT-INDENT-STRIP-INDENTATION 15552 . 16772) (
TEDIT-MAKE-LINES-EXPLICIT 16774 . 17979) (TEDIT-OPEN-LINE 17981 . 18737) (TEDIT-REMOVE-INDENT 18739 .
19509) (\TEDIT-INDENT-COUNT-SPACES 19511 . 20112) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20114 . 21085) (
\TEDIT-INDENT-SEPERATE-LINES 21087 . 21885) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 21887 . 23596)))))
STOP

BIN
library/lafite/LAFITE-INDENT.LCOM
View File

Binary file not shown.

71
library/lafite/LAFITE-PRIVATEDL
View File

@@ -1,30 +1,28 @@
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED "19-Jan-87 23:56:51" {ERIS}<LISPUSERS>LISPCORE>LAFITEPRIVATEDL.;1 10080
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
previous date%: "19-Jan-87 23:47:54" {PHYLUM}<LISPUSERS>KOTO>LAFITEPRIVATEDL.;2)
(FILECREATED "18-Feb-2026 15:50:14" {WMEDLEY}<library>lafite>LAFITE-PRIVATEDL.;2 9719
:EDIT-BY rmk
:CHANGES-TO (FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST))
(* "
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITE-PRIVATEDLCOMS)
(PRETTYCOMPRINT LAFITEPRIVATEDLCOMS)
(RPAQQ LAFITEPRIVATEDLCOMS ((* * LAFITEDL.EXT is the default extension for dl files when no extension
is specified)
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after
the connected directory and the LAFITEDEFAULTHOST&DIR in order to
locate a dl file when no host or directory is specified)
(INITVARS (LAFITEDL.EXT 'DL)
(LAFITEDLDIRECTORIES NIL))
(* * no functions are user callable)
(FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST)
(* Lafite's readtable for parsing addresses needs to have CR as a
SEPRCHAR so that lines from a text file can all be parsed at once.
This has no effect on normal operation since before private dls no CR
was ever passed to the parser)
(P (SETSYNTAX (CHARCODE CR)
'SEPRCHAR ADDRESSPARSERRDTBL))))
(RPAQQ LAFITE-PRIVATEDLCOMS
((* * LAFITEDL.EXT is the default extension for dl files when no extension is specified)
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after the connected
directory and the LAFITEDEFAULTHOST&DIR in order to locate a dl file when no host or
directory is specified)
(INITVARS (LAFITEDL.EXT 'DL)
(LAFITEDLDIRECTORIES NIL))
(* * no functions are user callable)
(FNS \GV.PARSERECIPIENTS1 \GV.PARSE.PRIVATE.DISTRIBUTION.LIST)
(* Lafite's readtable for parsing addresses needs to have CR as a SEPRCHAR so that lines from
a text file can all be parsed at once. This has no effect on normal operation since before
private dls no CR was ever passed to the parser)
(P (SETSYNTAX (CHARCODE CR)
'SEPRCHAR ADDRESSPARSERRDTBL))))
(* * LAFITEDL.EXT is the default extension for dl files when no extension is specified)
(* * LAFITEDLDIRECTORIES is a list of directories to be searched after the connected directory and the
@@ -39,7 +37,7 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
(DEFINEQ
(\GV.PARSERECIPIENTS1
[LAMBDA (FIELD REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:44")
[LAMBDA (FIELD REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:44")
(* ;;; "INTERNALFLG = T means produce addresses to give Grapevine; NIL means give human-readable addresses")
@@ -73,8 +71,8 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
(CHARCODE %"))
(HELP]
(OR REGISTRY (SETQ REGISTRY DEFAULTREGISTRY))
(* ;; "first just collect all the atoms using a special readtable ")
(* ;; "first just collect all the atoms using a special readtable ")
(SETQ ADDRESSES (when (SETQ ADDR (until (OR (EOFP FIELDSTREAM)
(EQ (SETQ TOKEN (READ FIELDSTREAM
@@ -107,14 +105,13 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
(EQ (CADDR ADDRESS)
';))
then
(* ;; "it's a private dl --- foo:;")
(* ;; "it's a private dl --- foo:;")
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST ADDRESS REGISTRY INTERNALFLG
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST ADDRESS REGISTRY INTERNALFLG
EDITWINDOW)
else
(* ;; "ADDRESS will only get rebound if there is an address with <>'s in it ")
(* ;;
 "ADDRESS will only get rebound if there is an address with <>'s in it ")
(SETQ VALIDRECIPIENT (\GV.PARSE.SINGLE.ADDRESS
(COND
@@ -128,8 +125,8 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
((OR T INTERNALFLG (NULL REALADDRESS))
VALIDRECIPIENT)
(T
(* ;; "Need to figure out how to make GETREGISTRY of this work, and remove duplicates in MAKEANSWERFORM before we can enable this")
(* ;; "Need to figure out how to make GETREGISTRY of this work, and remove duplicates in MAKEANSWERFORM before we can enable this")
(\GV.REPACKADDRESS (APPEND (LDIFF ADDRESS OPEN)
(LIST '< VALIDRECIPIENT
@@ -137,7 +134,7 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
(CDR CLOSE])
(\GV.PARSE.PRIVATE.DISTRIBUTION.LIST
[LAMBDA (DL REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:45")
[LAMBDA (DL REGISTRY INTERNALFLG EDITWINDOW) (* N.H.Briggs "19-Jan-87 23:45")
(LET* [(FILENAME (FINDFILE (PACKFILENAME.STRING 'BODY (CAR DL)
'EXTENSION LAFITEDL.EXT)
T
@@ -162,10 +159,10 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
file can all be parsed at once. This has no effect on normal operation since before private dls no CR
was ever passed to the parser)
(SETSYNTAX (CHARCODE CR)
'SEPRCHAR ADDRESSPARSERRDTBL)
(PUTPROPS LAFITEPRIVATEDL COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1965 9682 (\GV.PARSERECIPIENTS1 1975 . 8562) (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST 8564
. 9680)))))
(FILEMAP (NIL (1617 9389 (\GV.PARSERECIPIENTS1 1627 . 8273) (\GV.PARSE.PRIVATE.DISTRIBUTION.LIST 8275
. 9387)))))
STOP

BIN
library/lafite/LAFITE-PRIVATEDL.LCOM Normal file
View File

Binary file not shown.

24
lispusers/BACKGROUNDMENU
View File

@@ -1,18 +1,17 @@
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED "31-Jan-87 18:09:00" {ERIS}<LISPUSERS>LYRIC>BACKGROUNDMENU.;1 7367
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
previous date%: "31-Jan-86 11:36:13" {ERIS}<LISP>KOTO>LISPUSERS>BACKGROUNDMENU.;1)
(FILECREATED "18-Feb-2026 16:20:10" {WMEDLEY}<lispusers>BACKGROUNDMENU.;2 7230
:EDIT-BY rmk
:PREVIOUS-DATE "31-Jan-87 18:09:00" {WMEDLEY}<lispusers>BACKGROUNDMENU.;1)
(* "
Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT BACKGROUNDMENUCOMS)
(RPAQQ BACKGROUNDMENUCOMS ((INITVARS BackgroundMenuFixupMode BackgroundMenuSuperItem
BackgroundMenuTopLevelItems)
(FNS BkgMenu.add.item BkgMenu.fixup BkgMenu.move.item BkgMenu.remove.item
(FNS BkgMenu.add.item BkgMenu.fixup BkgMenu.move.item BkgMenu.remove.item
BkgMenu.rename.item BkgMenu.reorder.items BkgMenu.subitems
\BkgMenu.locate \BkgMenu.locater \BkgMenu.remove.item
\BkgMenu.scan.item.list \BkgMenu.unremove.item)))
@@ -153,11 +152,10 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
else (SETQ BackgroundMenuCommands (CONS (CAR item)
BackgroundMenuCommands])
)
(PUTPROPS BACKGROUNDMENU COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1008 7271 (BkgMenu.add.item 1018 . 1910) (BkgMenu.fixup 1912 . 3131) (BkgMenu.move.item
3133 . 3557) (BkgMenu.remove.item 3559 . 3834) (BkgMenu.rename.item 3836 . 4128) (
BkgMenu.reorder.items 4130 . 4505) (BkgMenu.subitems 4507 . 4907) (\BkgMenu.locate 4909 . 5520) (
\BkgMenu.locater 5522 . 6089) (\BkgMenu.remove.item 6091 . 6378) (\BkgMenu.scan.item.list 6380 . 6877)
(\BkgMenu.unremove.item 6879 . 7269)))))
(FILEMAP (NIL (944 7207 (BkgMenu.add.item 954 . 1846) (BkgMenu.fixup 1848 . 3067) (BkgMenu.move.item
3069 . 3493) (BkgMenu.remove.item 3495 . 3770) (BkgMenu.rename.item 3772 . 4064) (
BkgMenu.reorder.items 4066 . 4441) (BkgMenu.subitems 4443 . 4843) (\BkgMenu.locate 4845 . 5456) (
\BkgMenu.locater 5458 . 6025) (\BkgMenu.remove.item 6027 . 6314) (\BkgMenu.scan.item.list 6316 . 6813)
(\BkgMenu.unremove.item 6815 . 7205)))))
STOP

BIN
lispusers/BACKGROUNDMENU.LCOM
View File

Binary file not shown.

139
lispusers/COMMWINDOW
View File

@@ -1,95 +1,88 @@
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "INTERLISP" §BASE 10)
(FILECREATED " 2-Apr-87 17:06:05" {ERIS}<LISPUSERS>LYRIC>COMMWINDOW.;3 49786
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (VARS REMOTE-CURSOR COMMWINDOWCOMS)
(COURIERPROGRAMS COMMWINDOW)
(FNS CLOSE-FRAME START-GET-BITS SEND-BITS FRAME-EVENT MAKE-FRAME)
(FUNCTIONS \PILOTBITBLT)
(FILECREATED "18-Feb-2026 16:21:29" {WMEDLEY}<lispusers>COMMWINDOW.;2 48680
previous date%: " 2-Apr-87 16:54:24" {ERIS}<LISPUSERS>LYRIC>COMMWINDOW.;2)
:EDIT-BY rmk
:PREVIOUS-DATE " 2-Apr-87 17:06:05" {WMEDLEY}<lispusers>COMMWINDOW.;1)
(* "
Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT COMMWINDOWCOMS)
(RPAQQ COMMWINDOWCOMS (
(RPAQQ COMMWINDOWCOMS
(
(* ;;; "Viewer end")
(FNS CLOSE-FRAME GET-BITS START-GET-BITS)
(FILES COURIERSERVE)
(FNS CLOSE-FRAME GET-BITS START-GET-BITS)
(FILES COURIERSERVE)
(* ;;; "Sender end")
(FNS SEND-BITS SEND-TILE LISTEN-TO-VIEWER MAPTILES SHUT-DOWN-VIEWER
CHANGE-SENDER-UPDATE-MODE)
(FUNCTIONS INCR \PILOTBITBLT)
(* ;; "Controling update schemes")
(FNS SEND-BITS SEND-TILE LISTEN-TO-VIEWER MAPTILES SHUT-DOWN-VIEWER CHANGE-SENDER-UPDATE-MODE
)
(FUNCTIONS INCR \PILOTBITBLT)
(* ;; "Controling update schemes")
(INITVARS (COMM.DEFAULT.TRANSMIT.TYPE 'SQUARE)
(COMM.SEND.UNCHANGED.TILES T)
(COMM.UPDATE.MOUSE.POSITION 'Sender))
(GLOBALVARS COMM.DEFAULT.TRANSMIT.TYPE COMM.UPDATE.MOUSE.POSITION
COMM.SEND.UNCHANGED.TILES)
(INITVARS (COMM.DEFAULT.TRANSMIT.TYPE 'SQUARE)
(COMM.SEND.UNCHANGED.TILES T)
(COMM.UPDATE.MOUSE.POSITION 'Sender))
(GLOBALVARS COMM.DEFAULT.TRANSMIT.TYPE COMM.UPDATE.MOUSE.POSITION COMM.SEND.UNCHANGED.TILES)
(* ;;; "Pruning out unchanged screen tiles")
(FNS PACKET-EQUAL GET-CACHED-PACKET PUT-CACHED-PACKET)
(FNS PACKET-EQUAL GET-CACHED-PACKET PUT-CACHED-PACKET)
(* ;;; "Low level packet exchange code")
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE
COMM.CURSOR.CLOSE.PACKET.TYPE COMM.SHUT.DOWN.PACKET.TYPE)
(VARIABLES MAX-PACKET-BITS)
(RECORDS COMM.XFER.PACKET)
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE COMM.CURSOR.CLOSE.PACKET.TYPE
COMM.SHUT.DOWN.PACKET.TYPE)
(VARIABLES MAX-PACKET-BITS)
(RECORDS COMM.XFER.PACKET)
(* ;;; "Packing and unpacking bitmaps into etherpackets")
(FNS BMTOPACKET PACKETTOBM)
(FNS BMTOPACKET PACKETTOBM)
(* ;;; "Displaying the viewing machine's cursor")
(VARS REMOTE-CURSOR)
(INITVARS (CURSORICON NIL))
(VARS REMOTE-CURSOR)
(INITVARS (CURSORICON NIL))
(* ;;; "Manipulating the frame that outlines the region being viewed")
(INITVARS (*FRAME-SHADE* GRAYSHADE))
(FNS FRAME-EVENT MAKE-FRAME MOVE-FRAME SHAPE-FRAME SET-FRAME-TITLE)
(INITVARS (*FRAME-SHADE* GRAYSHADE))
(FNS FRAME-EVENT MAKE-FRAME MOVE-FRAME SHAPE-FRAME SET-FRAME-TITLE)
(* ;;; "Changing the system parameters")
(FNS MAKE-MENUS-WINDOW MODE-MENU)
(VARS COMM-MODES)
(FNS MAKE-MENUS-WINDOW MODE-MENU)
(VARS COMM-MODES)
(* ;;; "Initialization")
(P (COURIER.START.SERVER))
(P (COURIER.START.SERVER))
(* ;;; "Unused stuff, as far as I can tell")
(FNS FASTBITBLT)
(FNS FASTBITBLT)
(* ;;; "System file dependencies")
(DECLARE%: DONTCOPY DOEVAL@COMPILE (FILES (LOADCOMP)
LLDISPLAY LLETHER LLNS))
(COURIERPROGRAMS COMMWINDOW)))
(DECLARE%: DONTCOPY DOEVAL@COMPILE (FILES (LOADCOMP)
LLDISPLAY LLETHER LLNS))
(COURIERPROGRAMS COMMWINDOW)))
@@ -236,6 +229,7 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
(LIST 'RETURN (LIST (NSOCKETNUMBER NS)
(USERNAME])
)
(FILESLOAD COURIERSERVE)
@@ -446,19 +440,18 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
(SETQ COMM.DEFAULT.TRANSMIT.TYPE NEW-MODE)))
)
(DEFMACRO INCR (VAR START HEIGHT REPEATS UNTIL &REST FORMS)
(DEFMACRO INCR (VAR START HEIGHT REPEATS UNTIL &REST FORMS)
`(CL:DO ((REPEAT-COUNT 0 (+ REPEAT-COUNT 1)))
((>= REPEAT-COUNT ,REPEATS))
(CL:DO [(,VAR (+ ,START (CL:* REPEAT-COUNT ,HEIGHT))
(+ ,VAR (CL:* ,REPEATS ,HEIGHT]
(,UNTIL)
,@FORMS)))
(DEFMACRO \PILOTBITBLT (XCL-USER::TABLE &OPTIONAL (XCL-USER::N 0)) (CL:ASSERT (EQL XCL-USER::N 0))
`((OPCODES PILOTBITBLT)
,XCL-USER::TABLE 0))
(CL:DO [(,VAR (+ ,START (CL:* REPEAT-COUNT ,HEIGHT))
(+ ,VAR (CL:* ,REPEATS ,HEIGHT]
(,UNTIL)
,@FORMS)))
(DEFMACRO \PILOTBITBLT (XCL-USER::TABLE &OPTIONAL (XCL-USER::N 0))
(CL:ASSERT (EQL XCL-USER::N 0))
`((OPCODES PILOTBITBLT)
,XCL-USER::TABLE 0))
@@ -525,12 +518,12 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
(RPAQQ COMM.SHUT.DOWN.PACKET.TYPE 4246)
(CONSTANTS COMM.BAND.PACKET.TYPE COMM.CURSOR.PACKET.TYPE COMM.CURSOR.CLOSE.PACKET.TYPE
COMM.SHUT.DOWN.PACKET.TYPE)
)
(CL:DEFCONSTANT MAX-PACKET-BITS (CL:* 400 8) )
(CL:DEFCONSTANT MAX-PACKET-BITS (CL:* 400 8))
(DECLARE%: EVAL@COMPILE
(ACCESSFNS COMM.XFER.PACKET ((COMMPACKET (fetch (XIP XIPCONTENTS) of DATUM)))
@@ -807,6 +800,7 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
(* ;;; "Initialization")
(COURIER.START.SERVER)
@@ -862,6 +856,7 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
(* ;;; "System file dependencies")
(DECLARE%: DONTCOPY DOEVAL@COMPILE
(FILESLOAD (LOADCOMP)
LLDISPLAY LLETHER LLNS)
)
@@ -885,14 +880,14 @@ Copyright (c) 1986, 1900, 1987 by Xerox Corporation. All rights reserved.
ERRORS
((ERROR 1 (STRING))
(USE.COURIER 2 NIL)))
(PUTPROPS COMMWINDOW COPYRIGHT ("Xerox Corporation" 1986 1900 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3203 13134 (CLOSE-FRAME 3213 . 3364) (GET-BITS 3366 . 11655) (START-GET-BITS 11657 .
13132)) (13189 26236 (SEND-BITS 13199 . 16020) (SEND-TILE 16022 . 19145) (LISTEN-TO-VIEWER 19147 .
20450) (MAPTILES 20452 . 25175) (SHUT-DOWN-VIEWER 25177 . 26046) (CHANGE-SENDER-UPDATE-MODE 26048 .
26234)) (27219 29090 (PACKET-EQUAL 27229 . 28632) (GET-CACHED-PACKET 28634 . 28949) (PUT-CACHED-PACKET
28951 . 29088)) (30529 34252 (BMTOPACKET 30539 . 32500) (PACKETTOBM 32502 . 34250)) (34556 38865 (
FRAME-EVENT 34566 . 35224) (MAKE-FRAME 35226 . 37008) (MOVE-FRAME 37010 . 37280) (SHAPE-FRAME 37282 .
38672) (SET-FRAME-TITLE 38674 . 38863)) (38915 45792 (MAKE-MENUS-WINDOW 38925 . 41284) (MODE-MENU
41286 . 45790)) (45968 48955 (FASTBITBLT 45978 . 48953)))))
(FILEMAP (NIL (2306 12237 (CLOSE-FRAME 2316 . 2467) (GET-BITS 2469 . 10758) (START-GET-BITS 10760 .
12235)) (12293 25340 (SEND-BITS 12303 . 15124) (SEND-TILE 15126 . 18249) (LISTEN-TO-VIEWER 18251 .
19554) (MAPTILES 19556 . 24279) (SHUT-DOWN-VIEWER 24281 . 25150) (CHANGE-SENDER-UPDATE-MODE 25152 .
25338)) (25342 25656 (INCR 25342 . 25656)) (25658 25816 (\PILOTBITBLT 25658 . 25816)) (26181 28052 (
PACKET-EQUAL 26191 . 27594) (GET-CACHED-PACKET 27596 . 27911) (PUT-CACHED-PACKET 27913 . 28050)) (
29490 33213 (BMTOPACKET 29500 . 31461) (PACKETTOBM 31463 . 33211)) (33517 37826 (FRAME-EVENT 33527 .
34185) (MAKE-FRAME 34187 . 35969) (MOVE-FRAME 35971 . 36241) (SHAPE-FRAME 36243 . 37633) (
SET-FRAME-TITLE 37635 . 37824)) (37876 44753 (MAKE-MENUS-WINDOW 37886 . 40245) (MODE-MENU 40247 .
44751)) (44930 47917 (FASTBITBLT 44940 . 47915)))))
STOP

BIN
lispusers/COMMWINDOW.LCOM
View File

Binary file not shown.

BIN
lispusers/COMPILEBANG.LCOM
View File

Binary file not shown.

116
lispusers/CROCK
View File

@@ -1,43 +1,43 @@
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED " 2-Apr-87 00:37:46" {ERIS}<LISPUSERS>LYRIC>CROCK.;2 17791
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
previous date%: "11-Jan-86 19:46:27" {PHYLUM}<LISPUSERS>LYRIC>CROCK.;1)
(FILECREATED "18-Feb-2026 16:26:31" {WMEDLEY}<lispusers>CROCK.;2 17189
:EDIT-BY rmk
:PREVIOUS-DATE " 2-Apr-87 00:37:46" {WMEDLEY}<lispusers>CROCK.;1)
(* "
Copyright (c) 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT CROCKCOMS)
(RPAQQ CROCKCOMS ((* CROCK -- By Kelly Roach *)
(FNS CROCK CROCK.BUTTONEVENTFN CROCK.CHANGE.STYLE CROCK.CLOSEFN CROCK.PROCESS
CROCK.RESHAPEFN CROCK.ALARM CROCK.RING.ALARM CROCK.INIT)
(INITVARS (CROCK.DEFAULT.STYLE '(HANDS T TIMES NIL RINGS NIL NUMBERS T))
(CROCK.STYLE.MENU)
(CROCK.ALARMS)
(CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
[CROCK.TUNE '((1000 . 1000)
(800 . 1000)
(600 . 1000)
(500 . 1000)
(400 . 1000)
(NIL . 500)
(440 . 1000)
(484 . 1000)
(540 . 1000)
(600 . 1000)
(2000 . 1000)
(1600 . 1000)
(1200 . 1000)
(1000 . 1000)
(800 . 1000)
(NIL . 500)
(880 . 1000)
(968 . 1000)
(1080 . 1000)
(1188 . 1000]
(CROCKWINDOW))))
(RPAQQ CROCKCOMS
((* CROCK -- By Kelly Roach *)
(FNS CROCK CROCK.BUTTONEVENTFN CROCK.CHANGE.STYLE CROCK.CLOSEFN CROCK.PROCESS CROCK.RESHAPEFN
CROCK.ALARM CROCK.RING.ALARM CROCK.INIT)
(INITVARS (CROCK.DEFAULT.STYLE '(HANDS T TIMES NIL RINGS NIL NUMBERS T))
(CROCK.STYLE.MENU)
(CROCK.ALARMS)
(CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
[CROCK.TUNE '((1000 . 1000)
(800 . 1000)
(600 . 1000)
(500 . 1000)
(400 . 1000)
(NIL . 500)
(440 . 1000)
(484 . 1000)
(540 . 1000)
(600 . 1000)
(2000 . 1000)
(1600 . 1000)
(1200 . 1000)
(1000 . 1000)
(800 . 1000)
(NIL . 500)
(880 . 1000)
(968 . 1000)
(1080 . 1000)
(1188 . 1000]
(CROCKWINDOW))))
@@ -334,31 +334,31 @@ Copyright (c) 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
(RPAQ? CROCK.DATEFORMAT '(DATEFORMAT NO.SECONDS))
(RPAQ? CROCK.TUNE '((1000 . 1000)
(800 . 1000)
(600 . 1000)
(500 . 1000)
(400 . 1000)
(NIL . 500)
(440 . 1000)
(484 . 1000)
(540 . 1000)
(600 . 1000)
(2000 . 1000)
(1600 . 1000)
(1200 . 1000)
(1000 . 1000)
(800 . 1000)
(NIL . 500)
(880 . 1000)
(968 . 1000)
(1080 . 1000)
(1188 . 1000)))
(RPAQ? CROCK.TUNE
'((1000 . 1000)
(800 . 1000)
(600 . 1000)
(500 . 1000)
(400 . 1000)
(NIL . 500)
(440 . 1000)
(484 . 1000)
(540 . 1000)
(600 . 1000)
(2000 . 1000)
(1600 . 1000)
(1200 . 1000)
(1000 . 1000)
(800 . 1000)
(NIL . 500)
(880 . 1000)
(968 . 1000)
(1080 . 1000)
(1188 . 1000)))
(RPAQ? CROCKWINDOW )
(PUTPROPS CROCK COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1940 16814 (CROCK 1950 . 2520) (CROCK.BUTTONEVENTFN 2522 . 2811) (CROCK.CHANGE.STYLE
2813 . 5626) (CROCK.CLOSEFN 5628 . 5790) (CROCK.PROCESS 5792 . 14290) (CROCK.RESHAPEFN 14292 . 14451)
(CROCK.ALARM 14453 . 15681) (CROCK.RING.ALARM 15683 . 16424) (CROCK.INIT 16426 . 16812)))))
(FILEMAP (NIL (1609 16483 (CROCK 1619 . 2189) (CROCK.BUTTONEVENTFN 2191 . 2480) (CROCK.CHANGE.STYLE
2482 . 5295) (CROCK.CLOSEFN 5297 . 5459) (CROCK.PROCESS 5461 . 13959) (CROCK.RESHAPEFN 13961 . 14120)
(CROCK.ALARM 14122 . 15350) (CROCK.RING.ALARM 15352 . 16093) (CROCK.INIT 16095 . 16481)))))
STOP

BIN
lispusers/CROCK.LCOM
View File

Binary file not shown.

277
lispusers/DEFAULTICON
View File

@@ -1,14 +1,11 @@
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED "13-Jan-87 01:23:25" {ERIS}<LISPUSERS>LISPCORE>DEFAULTICON.;1 4586
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS \MAKEICONWINDOW)
(FILECREATED "18-Feb-2026 16:26:48" {WMEDLEY}<lispusers>DEFAULTICON.;2 4702
previous date%: "19-Dec-85 01:24:06" {ERIS}<LISP>KOTO>LISPUSERS>DEFAULTICON.;1)
:EDIT-BY rmk
:PREVIOUS-DATE "13-Jan-87 01:23:25" {WMEDLEY}<lispusers>DEFAULTICON.;1)
(* "
Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT DEFAULTICONCOMS)
@@ -16,137 +13,140 @@ Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
(UGLYVARS \DEFAULTICON)
(INITVARS (DEFAULTICON \DEFAULTICON))
(FNS \MAKEICONWINDOW)))
(FILESLOAD ICONW)
(READVARS \DEFAULTICON)
(({(READBITMAP)(64 64
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@AOOOOOOOOOOH@@"
"@@N@@@@@@@@@@G@@"
"@C@@@@@@@@@@@@L@"
"@D@@@@@@@@@@@@B@"
"@H@@@@@@@@@@@@A@"
"A@@@@@@@@@@@@@@H"
"B@@@@@@@@@@@CO@D"
"B@@@@@@@@@@@BDHD"
"D@@@@@@@@@@@ABDB"
"D@@@@@@@@@@@AODB"
"D@@@@@@@@@@@ABLB"
"D@@@@@@@@@@@ABDA"
"H@@@@@@@@@@@ABDA"
"H@@@@@@@@@@@AOHA"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"D@@@@@@@@@@@@@@B"
"D@@@@@@@@@@@@@@B"
"D@@@@@@@@@@@@@@B"
"B@@@@@@@@@@@@@@D"
"B@@@@@@@@@@@@@@D"
"A@@@@@@@@@@@@@@H"
"@H@@@@@@@@@@@@A@"
"@D@@@@@@@@@@@@B@"
"@C@@@@@@@@@@@@L@"
"@@N@@@@@@@@@@G@@"
"@@AOOOOOOOOOOH@@")} {(READBITMAP)(64 64
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@AOOOOOOOOOOH@@"
"@@OOOOOOOOOOOO@@"
"@COOOOOOOOOOOOL@"
"@GOOOOOOOOOOOON@"
"@OOOOOOOOOOOOOO@"
"AOOOOOOOOOOOOOOH"
"COOOOOOOOOOOOOOL"
"COOOOOOOOOOONDOL"
"GOOOOOOOOOOOOBGN"
"GOOOOOOOOOOOOOGN"
"GOOOOOOOOOOOOBON"
"GOOOOOOOOOOOOBGO"
"OOOOOOOOOOOOOBGO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"GOOOOOOOOOOOOOON"
"GOOOOOOOOOOOOOON"
"GOOOOOOOOOOOOOON"
"COOOOOOOOOOOOOOL"
"COOOOOOOOOOOOOOL"
"AOOOOOOOOOOOOOOH"
"@OOOOOOOOOOOOOO@"
"@GOOOOOOOOOOOON@"
"@COOOOOOOOOOOOL@"
"@@OOOOOOOOOOOO@@"
"@@AOOOOOOOOOOH@@")} (5 6 52 46)))
(READVARS-FROM-STRINGS '(\DEFAULTICON)
"(({(READBITMAP)(64 64
%"@@@@@@@@@@@@@@@@%"
%"@@@@@@@@@@@@@@@@%"
%"@@@@@@@@@@@@@@@@%"
%"@@@@@@@@@@@@@@@@%"
%"@@@@@@@@@@@@@@@@%"
%"@@AOOOOOOOOOOH@@%"
%"@@N@@@@@@@@@@G@@%"
%"@C@@@@@@@@@@@@L@%"
%"@D@@@@@@@@@@@@B@%"
%"@H@@@@@@@@@@@@A@%"
%"A@@@@@@@@@@@@@@H%"
%"B@@@@@@@@@@@CO@D%"
%"B@@@@@@@@@@@BDHD%"
%"D@@@@@@@@@@@ABDB%"
%"D@@@@@@@@@@@AODB%"
%"D@@@@@@@@@@@ABLB%"
%"D@@@@@@@@@@@ABDA%"
%"H@@@@@@@@@@@ABDA%"
%"H@@@@@@@@@@@AOHA%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"H@@@@@@@@@@@@@@A%"
%"D@@@@@@@@@@@@@@B%"
%"D@@@@@@@@@@@@@@B%"
%"D@@@@@@@@@@@@@@B%"
%"B@@@@@@@@@@@@@@D%"
%"B@@@@@@@@@@@@@@D%"
%"A@@@@@@@@@@@@@@H%"
%"@H@@@@@@@@@@@@A@%"
%"@D@@@@@@@@@@@@B@%"
%"@C@@@@@@@@@@@@L@%"
%"@@N@@@@@@@@@@G@@%"
%"@@AOOOOOOOOOOH@@%")} {(READBITMAP)(64 64
%"@@@@@@@@@@@@@@@@%"
%"@@@@@@@@@@@@@@@@%"
%"@@@@@@@@@@@@@@@@%"
%"@@@@@@@@@@@@@@@@%"
%"@@@@@@@@@@@@@@@@%"
%"@@AOOOOOOOOOOH@@%"
%"@@OOOOOOOOOOOO@@%"
%"@COOOOOOOOOOOOL@%"
%"@GOOOOOOOOOOOON@%"
%"@OOOOOOOOOOOOOO@%"
%"AOOOOOOOOOOOOOOH%"
%"COOOOOOOOOOOOOOL%"
%"COOOOOOOOOOONDOL%"
%"GOOOOOOOOOOOOBGN%"
%"GOOOOOOOOOOOOOGN%"
%"GOOOOOOOOOOOOBON%"
%"GOOOOOOOOOOOOBGO%"
%"OOOOOOOOOOOOOBGO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"OOOOOOOOOOOOOOOO%"
%"GOOOOOOOOOOOOOON%"
%"GOOOOOOOOOOOOOON%"
%"GOOOOOOOOOOOOOON%"
%"COOOOOOOOOOOOOOL%"
%"COOOOOOOOOOOOOOL%"
%"AOOOOOOOOOOOOOOH%"
%"@OOOOOOOOOOOOOO@%"
%"@GOOOOOOOOOOOON@%"
%"@COOOOOOOOOOOOL@%"
%"@@OOOOOOOOOOOO@@%"
%"@@AOOOOOOOOOOH@@%")} (5 6 52 46)))
")
(RPAQ? DEFAULTICON \DEFAULTICON)
(DEFINEQ
@@ -175,7 +175,6 @@ Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
(WINDOWPROP icon 'HEIGHT]
icon])
)
(PUTPROPS DEFAULTICON COPYRIGHT ("Xerox Corporation" 1985 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3170 4498 (\MAKEICONWINDOW 3180 . 4496)))))
(FILEMAP (NIL (3351 4679 (\MAKEICONWINDOW 3361 . 4677)))))
STOP

17
lispusers/DEFAULTSUBITEMFN
View File

@@ -1,17 +1,17 @@
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED " 4-Mar-87 15:59:01" {PHYLUM}<LISPUSERS>LYRIC>DEFAULTSUBITEMFN.;1 1299
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
previous date%: "31-Jan-86 17:45:55" {PHYLUM}<LISP>KOTO>LISPUSERS>DEFAULTSUBITEMFN.;1)
(FILECREATED "18-Feb-2026 16:28:38" {WMEDLEY}<lispusers>DEFAULTSUBITEMFN.;2 1229
:EDIT-BY rmk
:PREVIOUS-DATE " 4-Mar-87 15:59:01" {WMEDLEY}<lispusers>DEFAULTSUBITEMFN.;1)
(* "
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT DEFAULTSUBITEMFNCOMS)
(RPAQQ DEFAULTSUBITEMFNCOMS ((* * redefine the DEFAULTSUBITEMFN to add the EVAL keyword to the subitem menu field) (FNS DEFAULTSUBITEMFN))
)
(RPAQQ DEFAULTSUBITEMFNCOMS ((* * redefine the DEFAULTSUBITEMFN to add the EVAL keyword to the
subitem menu field)
(FNS DEFAULTSUBITEMFN)))
(* * redefine the DEFAULTSUBITEMFN to add the EVAL keyword to the subitem menu field)
(DEFINEQ
@@ -20,7 +20,6 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
(LAMBDA (MENU ITEM) (* edited%: "31-Dec-85 16:41") (* rrb "17-Aug-84 17:24") (* default subitemfn for menus. Checks the fourth element of the item for an expression of the form (SUBITEMS a b c) or if the fourth element is (EVAL form) will return the value of form. MENU and ITEM will be available during the evaluation) (PROG (TEMP) (RETURN (if (AND (LISTP ITEM) (LISTP (SETQ TEMP (CDR ITEM))) (LISTP (SETQ TEMP (CDR TEMP))) (LISTP (SETQ TEMP (CDR TEMP)))) then (SELECTQ (CAR (SETQ TEMP (LISTP (CAR TEMP)))) (SUBITEMS (CDR TEMP)) (EVAL (EVAL (CADR TEMP))) NIL)))))
)
)
(PUTPROPS DEFAULTSUBITEMFN COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (606 1206 (DEFAULTSUBITEMFN 616 . 1204)))))
STOP

BIN
lispusers/DEFAULTSUBITEMFN.LCOM
View File

Binary file not shown.

81
lispusers/LAMBDATRAN
View File

@@ -1,41 +1,38 @@
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED "19-Feb-87 10:40:43" {QV}<LFG>PARSER>NEXT>LAMBDATRAN.;2 9556
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS FNTYP1 LTDWIMUSERFN LTSTKNAME NARGS)
(FILECREATED "18-Feb-2026 16:30:17" {WMEDLEY}<lispusers>LAMBDATRAN.;2 9157
previous date%: "19-Feb-87 09:56:18" {QV}<LFG>PARSER>NEXT>LAMBDATRAN.;1)
:EDIT-BY rmk
:PREVIOUS-DATE "19-Feb-87 10:40:43" {WMEDLEY}<lispusers>LAMBDATRAN.;1)
(* "
Copyright (c) 1984, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAMBDATRANCOMS)
(RPAQQ LAMBDATRANCOMS [(* Translation machinery for new LAMBDA words)
(LOCALVARS . T)
[DECLARE%: FIRST (P (VIRGINFN 'ARGLIST T)
(MOVD? 'ARGLIST 'OLDARGLIST)
(VIRGINFN 'NARGS T)
(MOVD? 'NARGS 'OLDNARGS)
(VIRGINFN 'ARGTYPE T)
(MOVD? 'ARGTYPE 'OLDARGTYPE)
(MOVD? 'NILL 'LTDWIMUSERFN]
(FNS ARGLIST ARGTYPE FNTYP1 LTDWIMUSERFN LTSTKNAME NARGS)
(ADDVARS (DWIMUSERFORMS (LTDWIMUSERFN)))
(PROP VARTYPE LAMBDATRANFNS)
(ALISTS (LAMBDATRANFNS))
(PROP MACRO LTSTKNAME)
(P (PUTHASH 'LTSTKNAME '(NIL) MSTEMPLATES))
(P (RELINK 'WORLD))
(DECLARE%: EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T))
(GLOBALVARS CLISPARRAY COMMENTFLG LAMBDASPLST LAMBDATRANFNS BOUNDPDUMMY
))
(DECLARE%: DONTCOPY (RECORDS LAMBDAWORD))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML LTSTKNAME)
(LAMA])
(RPAQQ LAMBDATRANCOMS
[(* Translation machinery for new LAMBDA words)
(LOCALVARS . T)
[DECLARE%: FIRST (P (VIRGINFN 'ARGLIST T)
(MOVD? 'ARGLIST 'OLDARGLIST)
(VIRGINFN 'NARGS T)
(MOVD? 'NARGS 'OLDNARGS)
(VIRGINFN 'ARGTYPE T)
(MOVD? 'ARGTYPE 'OLDARGTYPE)
(MOVD? 'NILL 'LTDWIMUSERFN]
(FNS ARGLIST ARGTYPE FNTYP1 LTDWIMUSERFN LTSTKNAME NARGS)
(ADDVARS (DWIMUSERFORMS (LTDWIMUSERFN)))
(PROP VARTYPE LAMBDATRANFNS)
(ALISTS (LAMBDATRANFNS))
(PROP MACRO LTSTKNAME)
(P (PUTHASH 'LTSTKNAME '(NIL)
MSTEMPLATES))
(P (RELINK 'WORLD))
(DECLARE%: EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T))
(GLOBALVARS CLISPARRAY COMMENTFLG LAMBDASPLST LAMBDATRANFNS BOUNDPDUMMY))
(DECLARE%: DONTCOPY (RECORDS LAMBDAWORD))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML LTSTKNAME)
(LAMA])
@@ -46,12 +43,19 @@ Copyright (c) 1984, 1987 by Xerox Corporation. All rights reserved.
(LOCALVARS . T)
)
(DECLARE%: FIRST
(VIRGINFN 'ARGLIST T)
(MOVD? 'ARGLIST 'OLDARGLIST)
(VIRGINFN 'NARGS T)
(MOVD? 'NARGS 'OLDNARGS)
(VIRGINFN 'ARGTYPE T)
(MOVD? 'ARGTYPE 'OLDARGTYPE)
(MOVD? 'NILL 'LTDWIMUSERFN)
)
(DEFINEQ
@@ -190,14 +194,18 @@ Copyright (c) 1984, 1987 by Xerox Corporation. All rights reserved.
(ADDTOVAR DWIMUSERFORMS (LTDWIMUSERFN))
(PUTPROPS LAMBDATRANFNS VARTYPE ALIST)
(PUTPROPS LAMBDATRANFNS VARTYPE ALIST)
(ADDTOVAR LAMBDATRANFNS )
(PUTPROPS LTSTKNAME MACRO (X (CONS COMMENTFLG X)))
(PUTHASH 'LTSTKNAME '(NIL) MSTEMPLATES)
(PUTPROPS LTSTKNAME MACRO (X (CONS COMMENTFLG X)))
(PUTHASH 'LTSTKNAME '(NIL)
MSTEMPLATES)
(RELINK 'WORLD)
(DECLARE%: EVAL@COMPILE DONTCOPY
(RESETSAVE DWIMIFYCOMPFLG T)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -219,8 +227,7 @@ Copyright (c) 1984, 1987 by Xerox Corporation. All rights reserved.
(ADDTOVAR LAMA )
)
(PUTPROPS LAMBDATRAN COPYRIGHT ("Xerox Corporation" 1984 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2224 8821 (ARGLIST 2234 . 3188) (ARGTYPE 3190 . 3544) (FNTYP1 3546 . 4455) (
LTDWIMUSERFN 4457 . 7957) (LTSTKNAME 7959 . 8483) (NARGS 8485 . 8819)))))
(FILEMAP (NIL (1871 8468 (ARGLIST 1881 . 2835) (ARGTYPE 2837 . 3191) (FNTYP1 3193 . 4102) (
LTDWIMUSERFN 4104 . 7604) (LTSTKNAME 7606 . 8130) (NARGS 8132 . 8466)))))
STOP

BIN
lispusers/LAMBDATRAN.LCOM
View File

Binary file not shown.

189
lispusers/LAYOUT-SEDIT
View File

@@ -1,128 +1,127 @@
(DEFINE-FILE-INFO §READTABLE "XCL" §PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" (§NICKNAMES "L-S")))
(il:filecreated " 9-Jan-87 19:55:25" il:{eris}<lispusers>lispcore>layout-sedit.\;2 7190
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" (NICKNAMES "L-S")) READTABLE "XCL" BASE 10)
il:|changes| il:|to:| (il:variables user::*l-s-region-zero* user::*l-s-region-delta*
user::*l-s-reuse-earlier-regions*)
(il:functions get-region save-region user::use-l-s-regions
user::stop-using-l-s-regions)
(il:vars il:layout-seditcoms)
(IL:FILECREATED "18-Feb-2026 16:36:18" IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;2| 5714
il:|previous| il:|date:| "26-Dec-86 19:42:46" il:{eris}<pavel>lisp>layout-sedit.\;2)
:EDIT-BY IL:|rmk|
:CHANGES-TO (IL:VARS IL:LAYOUT-SEDITCOMS)
(IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA*
USER::*L-S-REUSE-EARLIER-REGIONS*)
(IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS REGION-PLUS
GET-REGION SAVE-REGION)
:PREVIOUS-DATE " 9-Jan-87 19:55:25" IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;1|)
; Copyright (c) 1986, 1987 by Pavel Curtis. All rights reserved.
(IL:PRETTYCOMPRINT IL:LAYOUT-SEDITCOMS)
(il:prettycomprint il:layout-seditcoms)
(IL:RPAQQ IL:LAYOUT-SEDITCOMS
((IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS)
(IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA*
USER::*L-S-REUSE-EARLIER-REGIONS*)
(IL:FUNCTIONS REGION-PLUS)
(IL:FUNCTIONS GET-REGION SAVE-REGION)
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY (IL:P (USER::USE-L-S-REGIONS)
))
(IL:* IL:|;;| "Arrange to use the proper compiler and makefile environment ")
(il:rpaqq il:layout-seditcoms ((il:functions user::use-l-s-regions user::stop-using-l-s-regions)
(il:variables *region-alist* user::*l-s-region-zero*
user::*l-s-region-delta* user::*l-s-reuse-earlier-regions*)
(il:functions region-plus)
(il:functions get-region save-region)
(il:declare\: il:donteval@load il:donteval@compile il:docopy
(il:p (user::use-l-s-regions)))
(il:* il:|;;|
"Arrange to use the proper compiler and makefile environment ")
(il:prop (il:filetype il:makefile-environment)
il:layout-sedit)))
(IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT)
IL:LAYOUT-SEDIT)))
(defun user::use-l-s-regions nil (assert (null il:|\\\\contexts|)
nil "Close all open SEdit windows")
(il:sedit.reset)
(il:movd 'il:sedit.get.window.region 'old-get-region)
(il:movd 'il:sedit.save.window.region 'old-save-region)
(il:movd 'get-region 'il:sedit.get.window.region)
(il:movd 'save-region 'il:sedit.save.window.region))
(DEFUN USER::USE-L-S-REGIONS ()
(ASSERT (NULL IL:|\\\\contexts|)
NIL "Close all open SEdit windows")
(IL:SEDIT.RESET)
(IL:MOVD 'IL:SEDIT.GET.WINDOW.REGION 'OLD-GET-REGION)
(IL:MOVD 'IL:SEDIT.SAVE.WINDOW.REGION 'OLD-SAVE-REGION)
(IL:MOVD 'GET-REGION 'IL:SEDIT.GET.WINDOW.REGION)
(IL:MOVD 'SAVE-REGION 'IL:SEDIT.SAVE.WINDOW.REGION))
(DEFUN USER::STOP-USING-L-S-REGIONS ()
(ASSERT (NULL IL:|\\\\contexts|)
NIL "Close all open SEdit windows")
(IL:SEDIT.RESET)
(IL:MOVD 'OLD-GET-REGION 'IL:SEDIT.GET.WINDOW.REGION)
(IL:MOVD 'OLD-SAVE-REGION 'IL:SEDIT.SAVE.WINDOW.REGION))
(defun user::stop-using-l-s-regions nil (assert (null il:|\\\\contexts|)
nil "Close all open SEdit windows")
(il:sedit.reset)
(il:movd 'old-get-region 'il:sedit.get.window.region)
(il:movd 'old-save-region 'il:sedit.save.window.region))
(DEFVAR *REGION-ALIST* NIL
(IL:* IL:|;;;| "An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL.")
(defvar *region-alist* nil
)
(il:* il:|;;;| "An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL.")
)
(defvar user::*l-s-region-zero* (il:createregion 25 (- (truncate il:screenheight 2)
(DEFVAR USER::*L-S-REGION-ZERO* (IL:CREATEREGION 25 (- (TRUNCATE IL:SCREENHEIGHT 2)
19)
(truncate il:screenwidth 2)
(truncate il:screenheight 2))
(TRUNCATE IL:SCREENWIDTH 2)
(TRUNCATE IL:SCREENHEIGHT 2))
(il:* il:|;;;| "The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window.")
)
(IL:* IL:|;;;| "The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window.")
)
(defvar user::*l-s-region-delta* (il:createregion 11 -44 0 0) )
(DEFVAR USER::*L-S-REGION-DELTA* (IL:CREATEREGION 11 -44 0 0))
(DEFVAR USER::*L-S-REUSE-EARLIER-REGIONS* NIL
(defvar user::*l-s-reuse-earlier-regions* nil
(IL:* IL:|;;;| "If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created.")
(il:* il:|;;;| "If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created.")
)
)
(DEFUN REGION-PLUS (ONE TWO)
(IL:CREATEREGION (+ (IL:FETCH (IL:REGION IL:LEFT) IL:OF ONE)
(IL:FETCH (IL:REGION IL:LEFT) IL:OF TWO))
(+ (IL:FETCH (IL:REGION IL:BOTTOM) IL:OF ONE)
(IL:FETCH (IL:REGION IL:BOTTOM) IL:OF TWO))
(+ (IL:FETCH (IL:REGION IL:WIDTH) IL:OF ONE)
(IL:FETCH (IL:REGION IL:WIDTH) IL:OF TWO))
(+ (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF ONE)
(IL:FETCH (IL:REGION IL:HEIGHT) IL:OF TWO))))
(defun region-plus (one two) (il:createregion (+ (il:fetch (il:region il:left) il:of one)
(il:fetch (il:region il:left) il:of two))
(+ (il:fetch (il:region il:bottom) il:of one)
(il:fetch (il:region il:bottom) il:of two))
(+ (il:fetch (il:region il:width) il:of one)
(il:fetch (il:region il:width) il:of two))
(+ (il:fetch (il:region il:height) il:of one)
(il:fetch (il:region il:height) il:of two))))
(DEFUN GET-REGION (CONTEXT)
(LET ((PAIR (AND USER::*L-S-REUSE-EARLIER-REGIONS* (FIND NIL *REGION-ALIST* :KEY 'CDR))))
(COND
((NULL PAIR)
(COND
((NULL *REGION-ALIST*)
(SETQ *REGION-ALIST* (LIST (CONS USER::*L-S-REGION-ZERO* CONTEXT)))
USER::*L-S-REGION-ZERO*)
(T (LET ((NEW-REGION (REGION-PLUS (CAR (FIRST *REGION-ALIST*))
USER::*L-S-REGION-DELTA*)))
(PUSH (CONS NEW-REGION CONTEXT)
*REGION-ALIST*)
NEW-REGION))))
(T (SETF (CDR PAIR)
CONTEXT)
(CAR PAIR)))))
(DEFUN SAVE-REGION (CONTEXT)
(defun get-region (context) (let ((pair (and user::*l-s-reuse-earlier-regions* (find nil
*region-alist*
:key
'cdr))))
(cond
((null pair)
(cond
((null *region-alist*)
(setq *region-alist* (list (cons user::*l-s-region-zero*
context)))
user::*l-s-region-zero*)
(t (let ((new-region (region-plus (car (first *region-alist*)
)
user::*l-s-region-delta*)))
(push (cons new-region context)
*region-alist*)
new-region))))
(t (setf (cdr pair)
context)
(car pair)))))
(IL:* IL:|;;;| "The context is done with its region. Deallocate it.")
(LET ((PAIR (FIND CONTEXT *REGION-ALIST* :KEY 'CDR)))
(IF (NULL PAIR)
(WARN "An SEdit context is trying to give up an unallocated region.")
(SETF (CDR PAIR)
NIL))
(SETQ *REGION-ALIST* (MEMBER-IF-NOT 'NULL *REGION-ALIST* :KEY 'CDR))))
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY
(defun save-region (context)
(il:* il:|;;;| "The context is done with its region. Deallocate it.")
(let ((pair (find context *region-alist* :key 'cdr)))
(if (null pair)
(warn "An SEdit context is trying to give up an unallocated region.")
(setf (cdr pair)
nil))
(setq *region-alist* (member-if-not 'null *region-alist* :key 'cdr))))
(il:declare\: il:donteval@load il:donteval@compile il:docopy
(user::use-l-s-regions)
(USER::USE-L-S-REGIONS)
)
(il:* il:|;;| "Arrange to use the proper compiler and makefile environment ")
(IL:* IL:|;;| "Arrange to use the proper compiler and makefile environment ")
(il:putprops il:layout-sedit il:filetype compile-file)
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:FILETYPE COMPILE-FILE)
(il:putprops il:layout-sedit il:makefile-environment (:readtable "XCL" :package (xcl:defpackage
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (XCL:DEFPACKAGE
"LAYOUT-SEDIT"
(:nicknames "L-S"))))
(il:putprops il:layout-sedit il:copyright ("Pavel Curtis" 1986 1987))
(il:declare\: il:dontcopy
(il:filemap (nil)))
il:stop
(:NICKNAMES "L-S"))))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL (1426 1788 (USER::USE-L-S-REGIONS 1426 . 1788)) (1790 2051 (USER::STOP-USING-L-S-REGIONS
1790 . 2051)) (3443 4007 (REGION-PLUS 3443 . 4007)) (4009 4732 (GET-REGION 4009 . 4732)) (4734 5138 (
SAVE-REGION 4734 . 5138)))))
IL:STOP

53
lispusers/LAYOUT-SEDIT.LCOM
View File

@@ -1 +1,52 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" (NICKNAMES "L-S"))) (IL:FILECREATED " 9-Sep-94 13:47:35" ("compiled on " IL:|{DSK}<lispcore>lispusers>LAYOUT-SEDIT.;1|) "28-Jul-94 17:28:46" IL:|bcompl'd| IL:|in| "Medley 25-Aug-94 ..." IL:|dated| "25-Aug-94 10:02:49") (IL:FILECREATED " 9-Jan-87 19:55:25" IL:{ERIS}<LISPUSERS>LISPCORE>LAYOUT-SEDIT.\;2 7190 IL:|changes| IL:|to:| (IL:VARIABLES USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA* USER::*L-S-REUSE-EARLIER-REGIONS* ) (IL:FUNCTIONS GET-REGION SAVE-REGION USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS) (IL:VARS IL:LAYOUT-SEDITCOMS) IL:|previous| IL:|date:| "26-Dec-86 19:42:46" IL:{ERIS}<PAVEL>LISP>LAYOUT-SEDIT.\;2 ) (IL:PRETTYCOMPRINT IL:LAYOUT-SEDITCOMS) (IL:RPAQQ IL:LAYOUT-SEDITCOMS ((IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS) ( IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA* USER::*L-S-REUSE-EARLIER-REGIONS*) (IL:FUNCTIONS REGION-PLUS) (IL:FUNCTIONS GET-REGION SAVE-REGION) ( IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY (IL:P (USER::USE-L-S-REGIONS))) (IL:* IL:|;;| "Arrange to use the proper compiler and makefile environment ") (IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT) IL:LAYOUT-SEDIT))) (DEFUN USER::USE-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL "Close all open SEdit windows") (IL:SEDIT.RESET) (IL:MOVD (QUOTE IL:SEDIT.GET.WINDOW.REGION) (QUOTE OLD-GET-REGION)) (IL:MOVD (QUOTE IL:SEDIT.SAVE.WINDOW.REGION) (QUOTE OLD-SAVE-REGION)) (IL:MOVD (QUOTE GET-REGION) (QUOTE IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION))) (DEFUN USER::STOP-USING-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL "Close all open SEdit windows") (IL:SEDIT.RESET) (IL:MOVD (QUOTE OLD-GET-REGION) (QUOTE IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE OLD-SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION))) (DEFVAR *REGION-ALIST* NIL (IL:* IL:|;;;| "An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL." )) (DEFVAR USER::*L-S-REGION-ZERO* (IL:CREATEREGION 25 (- (TRUNCATE IL:SCREENHEIGHT 2) 19) (TRUNCATE IL:SCREENWIDTH 2) (TRUNCATE IL:SCREENHEIGHT 2)) (IL:* IL:|;;;| "The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window." )) (DEFVAR USER::*L-S-REGION-DELTA* (IL:CREATEREGION 11 -44 0 0)) (DEFVAR USER::*L-S-REUSE-EARLIER-REGIONS* NIL (IL:* IL:|;;;| "If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created." )) (DEFUN REGION-PLUS (ONE TWO) (IL:CREATEREGION (+ (IL:FETCH (IL:REGION IL:LEFT) IL:OF ONE) (IL:FETCH ( IL:REGION IL:LEFT) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:BOTTOM) IL:OF ONE) (IL:FETCH (IL:REGION IL:BOTTOM) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:WIDTH) IL:OF ONE) (IL:FETCH (IL:REGION IL:WIDTH) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF ONE) (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF TWO)))) (DEFUN GET-REGION (CONTEXT) (LET ((PAIR (AND USER::*L-S-REUSE-EARLIER-REGIONS* (FIND NIL *REGION-ALIST* :KEY (QUOTE CDR))))) (COND ((NULL PAIR) (COND ((NULL *REGION-ALIST*) (SETQ *REGION-ALIST* (LIST (CONS USER::*L-S-REGION-ZERO* CONTEXT))) USER::*L-S-REGION-ZERO*) (T (LET (( NEW-REGION (REGION-PLUS (CAR (FIRST *REGION-ALIST*)) USER::*L-S-REGION-DELTA*))) (PUSH (CONS NEW-REGION CONTEXT) *REGION-ALIST*) NEW-REGION)))) (T (SETF (CDR PAIR) CONTEXT) (CAR PAIR))))) (DEFUN SAVE-REGION (CONTEXT) (IL:* IL:|;;;| "The context is done with its region. Deallocate it.") ( LET ((PAIR (FIND CONTEXT *REGION-ALIST* :KEY (QUOTE CDR)))) (IF (NULL PAIR) (WARN "An SEdit context is trying to give up an unallocated region.") (SETF (CDR PAIR) NIL)) (SETQ *REGION-ALIST* (MEMBER-IF-NOT (QUOTE NULL) *REGION-ALIST* :KEY (QUOTE CDR))))) (USER::USE-L-S-REGIONS) (IL:PUTPROPS IL:LAYOUT-SEDIT IL:FILETYPE COMPILE-FILE) (IL:PUTPROPS IL:LAYOUT-SEDIT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (XCL:DEFPACKAGE "LAYOUT-SEDIT" (:NICKNAMES "L-S")))) (IL:PUTPROPS IL:LAYOUT-SEDIT IL:COPYRIGHT ("Pavel Curtis" 1986 1987)) NIL
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "LAYOUT-SEDIT" (NICKNAMES "L-S")) READTABLE "XCL" BASE 10)
(IL:FILECREATED "18-Feb-2026 16:39:44" ("compiled on " IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;2|)
"18-Feb-2026 16:37:55" IL:|bcompl'd| IL:|in| "FULL 18-Feb-2026 ..." IL:|dated| "18-Feb-2026 16:38:04")
(IL:FILECREATED "18-Feb-2026 16:36:18" IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;2| 5714 :EDIT-BY IL:|rmk|
:CHANGES-TO (IL:VARS IL:LAYOUT-SEDITCOMS) (IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO*
USER::*L-S-REGION-DELTA* USER::*L-S-REUSE-EARLIER-REGIONS*) (IL:FUNCTIONS USER::USE-L-S-REGIONS
USER::STOP-USING-L-S-REGIONS REGION-PLUS GET-REGION SAVE-REGION) :PREVIOUS-DATE " 9-Jan-87 19:55:25"
IL:|{WMEDLEY}<lispusers>LAYOUT-SEDIT.;1|)
(IL:PRETTYCOMPRINT IL:LAYOUT-SEDITCOMS)
(IL:RPAQQ IL:LAYOUT-SEDITCOMS ((IL:FUNCTIONS USER::USE-L-S-REGIONS USER::STOP-USING-L-S-REGIONS) (
IL:VARIABLES *REGION-ALIST* USER::*L-S-REGION-ZERO* USER::*L-S-REGION-DELTA*
USER::*L-S-REUSE-EARLIER-REGIONS*) (IL:FUNCTIONS REGION-PLUS) (IL:FUNCTIONS GET-REGION SAVE-REGION) (
IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY (IL:P (USER::USE-L-S-REGIONS))) (IL:*
IL:|;;| "Arrange to use the proper compiler and makefile environment ") (IL:PROP (IL:FILETYPE
IL:MAKEFILE-ENVIRONMENT) IL:LAYOUT-SEDIT)))
(DEFUN USER::USE-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL "Close all open SEdit windows")
(IL:SEDIT.RESET) (IL:MOVD (QUOTE IL:SEDIT.GET.WINDOW.REGION) (QUOTE OLD-GET-REGION)) (IL:MOVD (QUOTE
IL:SEDIT.SAVE.WINDOW.REGION) (QUOTE OLD-SAVE-REGION)) (IL:MOVD (QUOTE GET-REGION) (QUOTE
IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION)))
(DEFUN USER::STOP-USING-L-S-REGIONS NIL (ASSERT (NULL IL:|\\\\contexts|) NIL
"Close all open SEdit windows") (IL:SEDIT.RESET) (IL:MOVD (QUOTE OLD-GET-REGION) (QUOTE
IL:SEDIT.GET.WINDOW.REGION)) (IL:MOVD (QUOTE OLD-SAVE-REGION) (QUOTE IL:SEDIT.SAVE.WINDOW.REGION)))
(DEFVAR *REGION-ALIST* NIL (IL:* IL:|;;;|
"An AList mapping a region to the SEdit context that currently owns it. The associations of regions no longer in use should have a CDR of NIL. The list is kept in reverse order, with the farthest region from *REGION-ZERO* at the front of the list. So as to allow experimentation by users, we maintain the invariant that the first association on the list never has a CDR of NIL. To reestablish that invariant, we sometimes POP the AList rather than set the CDR to NIL."
))
(DEFVAR USER::*L-S-REGION-ZERO* (IL:CREATEREGION 25 (- (TRUNCATE IL:SCREENHEIGHT 2) 19) (TRUNCATE
IL:SCREENWIDTH 2) (TRUNCATE IL:SCREENHEIGHT 2)) (IL:* IL:|;;;|
"The region to be used by the first SEdit window. This works in conjunction with USER::*L-S-REGION-DELTA* to specify the region for each new SEdit window."
))
(DEFVAR USER::*L-S-REGION-DELTA* (IL:CREATEREGION 11 -44 0 0))
(DEFVAR USER::*L-S-REUSE-EARLIER-REGIONS* NIL (IL:* IL:|;;;|
"If non-NIL, then earlier regions (i.e., those closer to USER::*L-S-REGION-ZERO* will get reused when free. Otherwise, new regions, farther from USER::*L-S-REGION-ZERO* than any currently in use, will be created."
))
(DEFUN REGION-PLUS (ONE TWO) (IL:CREATEREGION (+ (IL:FETCH (IL:REGION IL:LEFT) IL:OF ONE) (IL:FETCH (
IL:REGION IL:LEFT) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:BOTTOM) IL:OF ONE) (IL:FETCH (IL:REGION
IL:BOTTOM) IL:OF TWO)) (+ (IL:FETCH (IL:REGION IL:WIDTH) IL:OF ONE) (IL:FETCH (IL:REGION IL:WIDTH) IL:OF
TWO)) (+ (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF ONE) (IL:FETCH (IL:REGION IL:HEIGHT) IL:OF TWO))))
(DEFUN GET-REGION (CONTEXT) (LET ((PAIR (AND USER::*L-S-REUSE-EARLIER-REGIONS* (FIND NIL
*REGION-ALIST* :KEY (QUOTE CDR))))) (COND ((NULL PAIR) (COND ((NULL *REGION-ALIST*) (SETQ
*REGION-ALIST* (LIST (CONS USER::*L-S-REGION-ZERO* CONTEXT))) USER::*L-S-REGION-ZERO*) (T (LET ((
NEW-REGION (REGION-PLUS (CAR (FIRST *REGION-ALIST*)) USER::*L-S-REGION-DELTA*))) (PUSH (CONS
NEW-REGION CONTEXT) *REGION-ALIST*) NEW-REGION)))) (T (SETF (CDR PAIR) CONTEXT) (CAR PAIR)))))
(DEFUN SAVE-REGION (CONTEXT) (IL:* IL:|;;;| "The context is done with its region. Deallocate it.") (
LET ((PAIR (FIND CONTEXT *REGION-ALIST* :KEY (QUOTE CDR)))) (IF (NULL PAIR) (WARN
"An SEdit context is trying to give up an unallocated region.") (SETF (CDR PAIR) NIL)) (SETQ
*REGION-ALIST* (MEMBER-IF-NOT (QUOTE NULL) *REGION-ALIST* :KEY (QUOTE CDR)))))
(USER::USE-L-S-REGIONS)
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:FILETYPE COMPILE-FILE)
(IL:PUTPROPS IL:LAYOUT-SEDIT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (XCL:DEFPACKAGE
"LAYOUT-SEDIT" (:NICKNAMES "L-S"))))
NIL

50
lispusers/PHONE-DIRECTORY
View File

@@ -1,32 +1,27 @@
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED " 2-Feb-87 10:38:19" {ERIS}<LISPUSERS>LYRIC>PHONE-DIRECTORY.;1 9029
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (VARS PHONE-DIRECTORYCOMS)
(FILECREATED "18-Feb-2026 16:27:33" {WMEDLEY}<lispusers>PHONE-DIRECTORY.;2 8485
previous date%: " 9-Jan-87 19:45:25" {ERIS}<LISPUSERS>KOTO>PHONE-DIRECTORY.;3)
:EDIT-BY rmk
:PREVIOUS-DATE " 2-Feb-87 10:38:19" {WMEDLEY}<lispusers>PHONE-DIRECTORY.;1)
(* "
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT PHONE-DIRECTORYCOMS)
(RPAQQ PHONE-DIRECTORYCOMS ((FNS Cache-Phone-Directory-Files Let-your-fingers-do-the-walking
Phone-Directory-Kill-Proc Phone-Window-ButtonEventFn Lookup-Person
Phone-Window-WhenOpenedFn)
(VARS fingersIconMask fingersIconBM)
(INITVARS (*Cached-Phone-Directory-Files* NIL)
(*Phone-Directory-Pos* (create POSITION XCOORD _ 15 YCOORD _
(DIFFERENCE SCREENHEIGHT 75)))
(*Phone-Directory-Region* (CREATEREGION 15 (DIFFERENCE
SCREENHEIGHT 258
)
400 250)))
(GLOBALVARS *Cached-Phone-Directory-Files* *Phone-Directory-Pos*
*Phone-Directory-Region* fingersIconMask fingersIconBM)
(FILES GREP)
(P (Let-your-fingers-do-the-walking))))
(RPAQQ PHONE-DIRECTORYCOMS
((FNS Cache-Phone-Directory-Files Let-your-fingers-do-the-walking Phone-Directory-Kill-Proc
Phone-Window-ButtonEventFn Lookup-Person Phone-Window-WhenOpenedFn)
(VARS fingersIconMask fingersIconBM)
(INITVARS (*Cached-Phone-Directory-Files* NIL)
(*Phone-Directory-Pos* (create POSITION XCOORD _ 15 YCOORD _ (DIFFERENCE SCREENHEIGHT
75)))
(*Phone-Directory-Region* (CREATEREGION 15 (DIFFERENCE SCREENHEIGHT 258)
400 250)))
(GLOBALVARS *Cached-Phone-Directory-Files* *Phone-Directory-Pos* *Phone-Directory-Region*
fingersIconMask fingersIconBM)
(FILES GREP)
(P (Let-your-fingers-do-the-walking))))
(DEFINEQ
(Cache-Phone-Directory-Files
@@ -139,11 +134,12 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
(GLOBALVARS *Cached-Phone-Directory-Files* *Phone-Directory-Pos* *Phone-Directory-Region*
fingersIconMask fingersIconBM)
)
(FILESLOAD GREP)
(Let-your-fingers-do-the-walking)
(PUTPROPS PHONE-DIRECTORY COPYRIGHT ("Xerox Corporation" 1986 1987))
(Let-your-fingers-do-the-walking)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1649 6373 (Cache-Phone-Directory-Files 1659 . 2954) (Let-your-fingers-do-the-walking
2956 . 4251) (Phone-Directory-Kill-Proc 4253 . 4684) (Phone-Window-ButtonEventFn 4686 . 5362) (
Lookup-Person 5364 . 5976) (Phone-Window-WhenOpenedFn 5978 . 6371)))))
(FILEMAP (NIL (1168 5892 (Cache-Phone-Directory-Files 1178 . 2473) (Let-your-fingers-do-the-walking
2475 . 3770) (Phone-Directory-Kill-Proc 3772 . 4203) (Phone-Window-ButtonEventFn 4205 . 4881) (
Lookup-Person 4883 . 5495) (Phone-Window-WhenOpenedFn 5497 . 5890)))))
STOP

49
lispusers/SKETCHCOLOR
View File

@@ -1,15 +1,11 @@
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED " 9-Jan-87 16:47:16" {ERIS}<LISPCORE>LIBRARY>SKETCHCOLOR.;2 4779
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (VARS BLACKSHADE16 DARKGRAY16 MEDIUMGRAY16 LIGHTGRAY16 WHITESHADE16 REDTEXTURE
GREENTEXTURE BLUETEXTURE SKETCHCOLORCOMS)
(FILECREATED "18-Feb-2026 16:28:03" {WMEDLEY}<lispusers>SKETCHCOLOR.;2 4732
previous date%: "29-Oct-85 14:44:30" {ERIS}<LISPCORE>LIBRARY>SKETCHCOLOR.;1)
:EDIT-BY rmk
:PREVIOUS-DATE " 9-Jan-87 16:47:16" {WMEDLEY}<lispusers>SKETCHCOLOR.;1)
(* "
Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT SKETCHCOLORCOMS)
@@ -75,25 +71,30 @@ Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
)
(RPAQQ SKETCHINCOLORFLG T)
(FILESLOAD COLOR STYLESHEET)
(PUTPROPS \FILLCIRCLE.DISPLAY READVICE [NIL (BEFORE NIL (COND ((LISTP TEXTURE)
(COND ((TEXTUREP (CAR TEXTURE))
(SETQ TEXTURE (CAR TEXTURE)))
(T (SETQ TEXTURE
(TEXTUREOFCOLOR
(CADR TEXTURE])
[XCL:REINSTALL-ADVICE '\FILLCIRCLE.DISPLAY :BEFORE '((:LAST (COND
((LISTP TEXTURE)
(COND
((TEXTUREP (CAR TEXTURE))
(SETQ TEXTURE (CAR TEXTURE)))
(T (SETQ TEXTURE
(TEXTUREOFCOLOR (CADR TEXTURE]
[XCL:REINSTALL-ADVICE '\POLYSHADE.DISPLAY :BEFORE '((:LAST (COND
((LISTP FILL.SHADE)
(COND
((TEXTUREP (CAR FILL.SHADE))
(SETQ FILL.SHADE (CAR FILL.SHADE))
)
(T (SETQ FILL.SHADE
(TEXTUREOFCOLOR (CADR
FILL.SHADE
]
(PUTPROPS \POLYSHADE.DISPLAY READVICE [NIL (BEFORE NIL (COND ((LISTP FILL.SHADE)
(COND ((TEXTUREP (CAR FILL.SHADE))
(SETQ FILL.SHADE (CAR FILL.SHADE
)))
(T (SETQ FILL.SHADE
(TEXTUREOFCOLOR
(CADR FILL.SHADE])
(READVISE \FILLCIRCLE.DISPLAY \POLYSHADE.DISPLAY)
(PUTPROPS SKETCHCOLOR COPYRIGHT ("Xerox Corporation" 1985 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (771 3368 (COLORTEXTURETEST 781 . 2128) (LEVELTEXTURE 2130 . 2662) (PRIMARYTEXTURE 2664
. 3366)))))
(FILEMAP (NIL (547 3144 (COLORTEXTURETEST 557 . 1904) (LEVELTEXTURE 1906 . 2438) (PRIMARYTEXTURE 2440
. 3142)))))
STOP

148
lispusers/TRANSOR
View File

@@ -1,16 +1,18 @@
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
(FILECREATED "17-Mar-87 17:03:54" {DSK}<XAVIER>TRANSOR.;16 44778
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (VARS TRANSORCOMS)
(FNS PRECH1 TRANSOUT)
(FILECREATED "18-Feb-2026 21:57:19" {WMEDLEY}<lispusers>TRANSOR.;2 43458
previous date%: "17-Mar-87 17:00:04" {DSK}<XAVIER>TRANSOR.;15)
:EDIT-BY rmk
:CHANGES-TO (VARS TRANSORCOMS)
:PREVIOUS-DATE "17-Mar-87 17:03:54" {WMEDLEY}<lispusers>TRANSOR.;1)
(PRETTYCOMPRINT TRANSORCOMS)
(RPAQQ TRANSORCOMS
((FNS TRANSOR TRANSOR-PROCEED TRANSORFORM TRANSORFNS TRANSFORM TRANSIT TRANXT TRANSEXIT
(RPAQQ TRANSORCOMS
[(FNS TRANSOR TRANSOR-PROCEED TRANSORFORM TRANSORFNS TRANSFORM TRANSIT TRANXT TRANSEXIT
KEEPLIST TRANSERR TRANSOUT PPASS1 TRANSLIST TRANSLIST1 PREMTEXT WACHADOON PRECH PRECH1
PRECH2 RETAIL LNC PRESCAN)
TRANSORMACROS TRANSOREMARKS TRANSORGLOBALS
@@ -18,8 +20,10 @@
(TESTRAN)
(USERMACROS (APPEND TRANSORMACROS USERMACROS))
(GLOBALVARS (APPEND TRANSORGLOBALS GLOBALVARS))
(EDITCOMSA (UNION '(NLAM NLAMIT DOTHESE DOTHIS XFORMER CONTINUE) EDITCOMSA))
(EDITCOMSL (UNION '(REMARK) EDITCOMSL))
(EDITCOMSA (UNION '(NLAM NLAMIT DOTHESE DOTHIS XFORMER CONTINUE)
EDITCOMSA))
(EDITCOMSL (UNION '(REMARK)
EDITCOMSL))
(TRANSITCONSES '(ORR NIL XFORMER))
(PRESCARRAY (ARRAY 127 127)))
(INITVARS (NLISTPCOMS)
@@ -36,10 +40,9 @@
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
(NIL PRESCAN (GLOBALVARS PRESCARRAY)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML TRANSERR KEEPLIST
(NLAML TRANSERR KEEPLIST
TRANSOR-PROCEED)
(LAMA)))
(EDITHIST TRANSOR)))
(LAMA])
(DEFINEQ
(TRANSOR
@@ -861,52 +864,49 @@ TRANSOR made a translation error: " T)
(RETURN (CLOSEF OUTF)))))
)
(RPAQQ TRANSORMACROS ((REMARK (TXT)
(E (KEEPLIST TXT)
T))
(NLAM NIL (E (SETQQ WHERETOGONEXT NLAMIT)
T))
[NLAMIT NIL (ORR NX !NX ((E (TRANSEXIT]
(DOTHESE NIL (E (TRANSOR-PROCEED DOTHESE)
T)
NLAM)
(DOTHIS NIL (E (TRANSOR-PROCEED DOTHIS)
T)
NLAM)
(XFORMER NIL (E (TRANSERR TRANSFORMATIONERROR "FAULTY TRANSFORMATION"
(CURRENTFORM CURRENTCOMS))
T))))
(RPAQQ TRANSORMACROS
((REMARK (TXT)
(E (KEEPLIST TXT)
T))
(NLAM NIL (E (SETQQ WHERETOGONEXT NLAMIT)
T))
[NLAMIT NIL (ORR NX !NX ((E (TRANSEXIT]
(DOTHESE NIL (E (TRANSOR-PROCEED DOTHESE)
T)
NLAM)
(DOTHIS NIL (E (TRANSOR-PROCEED DOTHIS)
T)
NLAM)
(XFORMER NIL (E (TRANSERR TRANSFORMATIONERROR "FAULTY TRANSFORMATION" (CURRENTFORM
CURRENTCOMS))
T))))
(RPAQQ TRANSOREMARKS ((TRANSFORMATIONERROR (* The TRANSFORMATIONS specified for this form failed to
work properly. The TTY message %'FAULTY TRANSFORMATION'
was printed, any commands remaining in the
transformation after the erroneous one were skipped,
and translation continued as if the transformation had
been normally completed. The user should treat the
translated form with caution and amend his
transformation to avoid future problems.))
(TRANSERROR (* TRANSOR got confused at this point. The TTY message %'SHOW JIM
GOODWIN' was printed and translation continued with the next
form, but the user should treat the compromised area of code
with caution.))
(BLAMBDA1 (* Non-atomic CAR of form, but not an open lambda. Either a
parenthesis error or computed CAR of form. Computed CAR of form is
no longer legal in BBN-LISP; APPLY* is used instead. If computed
CAR of form was intended, the translation to APPLY* will run ok.
See manual for discussion of APPLY*.))
(BLAMBDA2 (* Open LAMBDA with wrong number of args. What can it mean?))
(BLAMBDA3 (* Lambda-expression without forms. What can it mean?))
(ILLCAR (* Illegal data-type encountered as CAR of form Expression treated as
list of forms.))
(TAILP/DOTHIS (* When the transormacro DOTHIS is executed at a TAILP position,
TRANSOR does a 1 command first, assuming that the current
position is a list of forms and CAR of it is the form
intended. The user should make sure that this is what was
intended by the TRANSFORMATIONS which called DOTHIS, i.e. the
TRANSFORMATIONS for the form containing this one.))))
(RPAQQ TRANSOREMARKS
((TRANSFORMATIONERROR (* The TRANSFORMATIONS specified for this form failed to work properly.
The TTY message %'FAULTY TRANSFORMATION' was printed, any commands
remaining in the transformation after the erroneous one were skipped,
and translation continued as if the transformation had been normally
completed. The user should treat the translated form with caution and
amend his transformation to avoid future problems.))
(TRANSERROR (* TRANSOR got confused at this point. The TTY message %'SHOW JIM GOODWIN' was
printed and translation continued with the next form, but the user should
treat the compromised area of code with caution.))
(BLAMBDA1 (* Non-atomic CAR of form, but not an open lambda. Either a parenthesis error or
computed CAR of form. Computed CAR of form is no longer legal in BBN-LISP;
APPLY* is used instead. If computed CAR of form was intended, the translation to
APPLY* will run ok. See manual for discussion of APPLY*.))
(BLAMBDA2 (* Open LAMBDA with wrong number of args. What can it mean?))
(BLAMBDA3 (* Lambda-expression without forms. What can it mean?))
(ILLCAR (* Illegal data-type encountered as CAR of form Expression treated as list of forms.)
)
(TAILP/DOTHIS (* When the transormacro DOTHIS is executed at a TAILP position, TRANSOR does a
1 command first, assuming that the current position is a list of forms and
CAR of it is the form intended. The user should make sure that this is what
was intended by the TRANSFORMATIONS which called DOTHIS, i.e. the
TRANSFORMATIONS for the form containing this one.))))
(RPAQQ TRANSORGLOBALS (USERNOTES USERNOTES TESTFORM TESTFORM TRANSFORMATIONS TRANSFORMATIONS
XFORMSFNS XFORMSVARS XFORMSVARS DUMPFILE TRANSFORMATIONS TRANSFORMATIONS
XFORMSFNS XFORMSVARS XFORMSVARS DUMPFILE TRANSFORMATIONS TRANSFORMATIONS
TRANSFORMATIONS TRANSFORMATIONS))
(RPAQQ MAXLOOP 1530)
@@ -917,9 +917,11 @@ TRANSOR made a translation error: " T)
(RPAQ GLOBALVARS (APPEND TRANSORGLOBALS GLOBALVARS))
(RPAQ EDITCOMSA (UNION '(NLAM NLAMIT DOTHESE DOTHIS XFORMER CONTINUE) EDITCOMSA))
(RPAQ EDITCOMSA (UNION '(NLAM NLAMIT DOTHESE DOTHIS XFORMER CONTINUE)
EDITCOMSA))
(RPAQ EDITCOMSL (UNION '(REMARK) EDITCOMSL))
(RPAQ EDITCOMSL (UNION '(REMARK)
EDITCOMSL))
(RPAQQ TRANSITCONSES (ORR NIL XFORMER))
@@ -932,7 +934,7 @@ TRANSOR made a translation error: " T)
(RPAQ? TRANSOUTREADTABLE FILERDTBL)
(DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(PUTPROPS TAILP BLKLIBRARYDEF [LAMBDA (.BLKVAR.X .BLKVAR.Y)
(PUTPROPS TAILP BLKLIBRARYDEF [LAMBDA (.BLKVAR.X .BLKVAR.Y)
(* True if .BLKVAR.X is A tail of .BLKVAR.Y .BLKVAR.X and
.BLKVAR.Y non-null.)
(* Included with editor for block compilation purposes.)
@@ -944,15 +946,19 @@ TRANSOR made a translation error: " T)
(GO LP])
)
(PUTPROPS TRANSOR FILEGROUP (TRANSOR TSET))
(PUTPROPS TRANSOR FILEGROUP (TRANSOR TSET))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK%: PRECHBLOCK PRECH PRECH1 PRECH2 RETAIL LNC (ENTRIES PRECH)
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
(BLOCK%: TRANSITBLOCK TRANSIT WACHADOON (ENTRIES TRANSIT WACHADOON)
(GLOBALVARS WACHADID WHENTODOIT TRANSITCONSES LAMBDACOMS NLISTPCOMS)
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
(BLOCK%: TRANXTBLOCK TRANXT (ENTRIES TRANXT)
(BLKLIBRARY TAILP MEMB LAST LENGTH ASSOC GETP))
(BLOCK%: NIL PRESCAN (GLOBALVARS PRESCARRAY))
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
@@ -963,23 +969,11 @@ TRANSOR made a translation error: " T)
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(ADDTOVAR EDITHISTALIST (TRANSOR (" 5-Feb-87 16:18:06" DJVB {DSK}<XAVIER>TRANSOR.;11 (TRANSOR)
(FIXED TO WORK WITH NEW FILE RULES IN LYRIC))
(" 6-Feb-87 15:24:20" DJVB {DSK}<XAVIER>TRANSOR.;12 (TRANSOR))
(" 6-Mar-87 14:41:26" DJVB {DSK}<XAVIER>TRANSOR.;13
(TRANSOR TRANSOR-PROCEED TRANSORFORM TRANSORFNS TRANSFORM
RETAIL))
("17-Mar-87 17:01:53" DJVB {DSK}<XAVIER>TRANSOR.;15 (PRECH1 TRANSOUT)
(ADDED SPLIT READ/WRITE READTABLES AND PP FOR DEFUN))))
)
(PUTPROPS TRANSOR COPYRIGHT (NONE))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2231 38324 (TRANSOR 2241 . 6284) (TRANSOR-PROCEED 6286 . 9093) (TRANSORFORM 9095 . 9527
) (TRANSORFNS 9529 . 10225) (TRANSFORM 10227 . 11965) (TRANSIT 11967 . 14735) (TRANXT 14737 . 17950) (
TRANSEXIT 17952 . 18262) (KEEPLIST 18264 . 19224) (TRANSERR 19226 . 19990) (TRANSOUT 19992 . 22436) (
PPASS1 22438 . 22679) (TRANSLIST 22681 . 23700) (TRANSLIST1 23702 . 23934) (PREMTEXT 23936 . 24641) (
WACHADOON 24643 . 25114) (PRECH 25116 . 25609) (PRECH1 25611 . 27779) (PRECH2 27781 . 28727) (RETAIL
28729 . 29976) (LNC 29978 . 30841) (PRESCAN 30843 . 38322)))))
(FILEMAP (NIL (2262 38355 (TRANSOR 2272 . 6315) (TRANSOR-PROCEED 6317 . 9124) (TRANSORFORM 9126 . 9558
) (TRANSORFNS 9560 . 10256) (TRANSFORM 10258 . 11996) (TRANSIT 11998 . 14766) (TRANXT 14768 . 17981) (
TRANSEXIT 17983 . 18293) (KEEPLIST 18295 . 19255) (TRANSERR 19257 . 20021) (TRANSOUT 20023 . 22467) (
PPASS1 22469 . 22710) (TRANSLIST 22712 . 23731) (TRANSLIST1 23733 . 23965) (PREMTEXT 23967 . 24672) (
WACHADOON 24674 . 25145) (PRECH 25147 . 25640) (PRECH1 25642 . 27810) (PRECH2 27812 . 28758) (RETAIL
28760 . 30007) (LNC 30009 . 30872) (PRESCAN 30874 . 38353)))))
STOP

50
lispusers/TRANSOR-LOADTRAN
View File

@@ -1,25 +1,19 @@
(DEFINE-FILE-INFO §PACKAGE "XCL-USER" §READTABLE "XCL")
(IL:FILECREATED "13-Apr-87 17:38:17" IL:{DSK}<XAVIER>LOADTRAN.\;9 2045
(DEFINE-FILE-INFO PACKAGE "XCL-USER" READTABLE "XCL" BASE 10)
IL:|changes| IL:|to:| (IL:VARS IL:LOADTRANCOMS STOP)
(IL:FUNCTIONS MYLOAD I.S.OPR PRETTYCOMPRINT SETTEMPLATE DEFINE-FILE-INFO
)
(IL:FNS PRETTYCOMPRINT SETTEMPLATE)
(IL:FILECREATED "18-Feb-2026 22:58:35" IL:|{WMEDLEY}<lispusers>TRANSOR-LOADTRAN.;2| 1561
IL:|previous| IL:|date:| " 6-Apr-87 16:57:48" IL:{DSK}<XAVIER>LOADTRAN.\;1)
:EDIT-BY IL:|rmk|)
; Copyright (c) 1987 by System Development Corp.. All rights reserved.
(IL:PRETTYCOMPRINT IL:TRANSOR-LOADTRANCOMS)
(IL:PRETTYCOMPRINT IL:LOADTRANCOMS)
(IL:RPAQQ IL:LOADTRANCOMS ((IL:VARS STOP)
(IL:FNS PRETTYCOMPRINT SETTEMPLATE)
(IL:FUNCTIONS DEFINE-FILE-INFO I.S.OPR MYLOAD)
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY
IL:COMPILERVARS (IL:ADDVARS (IL:NLAMA PRETTYCOMPRINT)
(IL:NLAML)
(IL:LAMA SETTEMPLATE)))))
(IL:RPAQQ IL:TRANSOR-LOADTRANCOMS ((IL:VARS STOP)
(IL:FNS PRETTYCOMPRINT SETTEMPLATE)
(IL:FUNCTIONS DEFINE-FILE-INFO I.S.OPR MYLOAD)
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY
IL:COMPILERVARS (IL:ADDVARS (IL:NLAMA PRETTYCOMPRINT)
(IL:NLAML)
(IL:LAMA SETTEMPLATE)))))
(IL:RPAQQ STOP STOP)
(IL:DEFINEQ
@@ -33,17 +27,17 @@
(BLOCK SETTEMPLATE (NILL))))
)
(DEFUN DEFINE-FILE-INFO (&REST ARGS) (NILL))
(DEFUN DEFINE-FILE-INFO (&REST ARGS)
(NILL))
(DEFUN I.S.OPR (X)
(NILL))
(DEFUN I.S.OPR (X) (NILL))
(DEFUN MYLOAD (FILE) (LET ((FILE (OPEN FILE :DIRECTION :INPUT)))
(UNWIND-PROTECT (IL:\\CML-LOAD FILE T *TERMINAL-IO* (FIND-PACKAGE
"XCL-USER"))
(CLOSE FILE))))
(DEFUN MYLOAD (FILE)
(LET ((FILE (OPEN FILE :DIRECTION :INPUT)))
(UNWIND-PROTECT
(IL:\\CML-LOAD FILE T *TERMINAL-IO* (FIND-PACKAGE "XCL-USER"))
(CLOSE FILE))))
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY IL:COMPILERVARS
(IL:ADDTOVAR IL:NLAMA PRETTYCOMPRINT)
@@ -52,7 +46,7 @@
(IL:ADDTOVAR IL:LAMA SETTEMPLATE)
)
(IL:PUTPROPS IL:LOADTRAN IL:COPYRIGHT ("System Development Corp." 1987))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL (1134 1357 (PRETTYCOMPRINT 1147 . 1283) (SETTEMPLATE 1285 . 1355)))))
(IL:FILEMAP (NIL (830 1053 (PRETTYCOMPRINT 843 . 979) (SETTEMPLATE 981 . 1051)) (1055 1106 (
DEFINE-FILE-INFO 1055 . 1106)) (1108 1141 (I.S.OPR 1108 . 1141)) (1143 1341 (MYLOAD 1143 . 1341)))))
IL:STOP

BIN
lispusers/TRANSOR-LOADTRAN.LCOM
View File

Binary file not shown.

BIN
lispusers/TRANSOR.LCOM
View File

Binary file not shown.

306
lispusers/UNBOXEDOPS
View File

@@ -1,20 +1,15 @@
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "INTERLISP" §BASE 10)
(FILECREATED " 7-Dec-86 17:26:23" {ERIS}<LISPUSERS>LISPCORE>UNBOXEDOPS.;7 12906
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (OPTIMIZERS UFREMAINDER2 UFREMAINDER)
(FNS UFREMAINDER)
(VARS UNBOXEDOPSCOMS)
(FILECREATED "18-Feb-2026 16:17:02" {WMEDLEY}<lispusers>UNBOXEDOPS.;2 10856
previous date%: " 3-Nov-86 20:30:24" {ERIS}<LISPUSERS>LISPCORE>UNBOXEDOPS.;6)
:EDIT-BY rmk
:PREVIOUS-DATE " 7-Dec-86 17:26:23" {WMEDLEY}<lispusers>UNBOXEDOPS.;1)
(* "
Copyright (c) 1986 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT UNBOXEDOPSCOMS)
(RPAQQ UNBOXEDOPSCOMS
(RPAQQ UNBOXEDOPSCOMS
[(FNS UFABS UFEQP UFGEQ UFGREATERP UFIX UFLEQ UFLESSP UFMAX UFMIN UFMINUS UFREMAINDER)
(OPTIMIZERS UFABS UFABS1 UFEQP UFEQP2 UFGEQ UFGEQ2 UFGREATERP UFGREATERP2 UFIX UFIX1 UFLEQ
UFLEQ2 UFLESSP UFLESSP2 UFMAX UFMAX2 UFMIN UFMIN2 UFMINUS UFMINUS1 UFREMAINDER)
@@ -81,178 +76,168 @@ Copyright (c) 1986 by Xerox Corporation. All rights reserved.
FY])
)
(DEFOPTIMIZER UFABS (&OPTIONAL (ARG1 NIL ARG1GIVEN)
&REST RESTARGS &WHOLE ORIGINAL) (if (OR (NOT ARG1GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T
"Illegal args to UFABS" %,
%, ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFABS1 ARG1))
(DEFOPTIMIZER UFABS (&OPTIONAL (ARG1 NIL ARG1GIVEN)
&REST RESTARGS &WHOLE ORIGINAL)
(if (OR (NOT ARG1GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFABS" %, %, ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFABS1 ARG1))
(DEFOPTIMIZER UFABS1 (X)
`[\FLOATBOX ((OPCODES UBFLOAT1 2)
(\FLOATUNBOX ,X])
(DEFOPTIMIZER UFABS1 (X) `[\FLOATBOX ((OPCODES UBFLOAT1 2)
(\FLOATUNBOX ,X])
(DEFOPTIMIZER UFEQP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(DEFOPTIMIZER UFEQP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFEQP" %, %,
ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFEQP2 ARG1 ARG2))
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFEQP" %, %, ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFEQP2 ARG1 ARG2))
(DEFOPTIMIZER UFEQP2 (X Y)
`(EQ (\FLOATUNBOX (FDIFFERENCE ,X ,Y))
NIL))
(DEFOPTIMIZER UFEQP2 (X Y) `(EQ (\FLOATUNBOX (FDIFFERENCE ,X ,Y))
NIL))
(DEFOPTIMIZER UFGEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(DEFOPTIMIZER UFGEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFGEQ" %, %,
ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFGEQ2 ARG1 ARG2))
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFGEQ" %, %, ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFGEQ2 ARG1 ARG2))
(DEFOPTIMIZER UFGEQ2 (X Y)
`[NOT ((OPCODES SWAP UBFLOAT2 5)
(\FLOATUNBOX ,X)
(\FLOATUNBOX ,Y])
(DEFOPTIMIZER UFGEQ2 (X Y) `[NOT ((OPCODES SWAP UBFLOAT2 5)
(\FLOATUNBOX ,X)
(\FLOATUNBOX ,Y])
(DEFOPTIMIZER UFGREATERP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(DEFOPTIMIZER UFGREATERP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFGREATERP" %,
%, ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFGREATERP2 ARG1 ARG2))
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFGREATERP" %, %, ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFGREATERP2 ARG1 ARG2))
(DEFOPTIMIZER UFGREATERP2 (X Y)
`((OPCODES UBFLOAT2 5)
(\FLOATUNBOX ,X)
(\FLOATUNBOX ,Y)))
(DEFOPTIMIZER UFGREATERP2 (X Y) `((OPCODES UBFLOAT2 5)
(\FLOATUNBOX ,X)
(\FLOATUNBOX ,Y)))
(DEFOPTIMIZER UFIX (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFIX" %, %, ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFIX1 ARG1))
(DEFOPTIMIZER UFIX1 (X)
`((OPCODES UBFLOAT1 4)
(\FLOATUNBOX ,X)))
(DEFOPTIMIZER UFIX (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFIX" %, %, ORIGINAL
T)
(PRINTOUT T "************" T))
(LIST 'UFIX1 ARG1))
(DEFOPTIMIZER UFIX1 (X) `((OPCODES UBFLOAT1 4)
(\FLOATUNBOX ,X)))
(DEFOPTIMIZER UFLEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(DEFOPTIMIZER UFLEQ (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFLEQ" %, %,
ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFLEQ2 ARG1 ARG2))
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFLEQ" %, %, ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFLEQ2 ARG1 ARG2))
(DEFOPTIMIZER UFLEQ2 (X Y)
`[NOT ((OPCODES UBFLOAT2 5)
(\FLOATUNBOX ,X)
(\FLOATUNBOX ,Y])
(DEFOPTIMIZER UFLEQ2 (X Y) `[NOT ((OPCODES UBFLOAT2 5)
(DEFOPTIMIZER UFLESSP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFLESSP" %, %, ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFLESSP2 ARG1 ARG2))
(DEFOPTIMIZER UFLESSP2 (X Y)
`((OPCODES SWAP UBFLOAT2 5)
(\FLOATUNBOX ,X)
(\FLOATUNBOX ,Y)))
(DEFOPTIMIZER UFMAX (&OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS)
(if (NOT ARG1GIVEN)
then 'MIN.FLOAT
elseif (NOT ARG2GIVEN)
then `(FLOAT %, ARG1)
elseif RESTARGS
then `(UFMAX (UFMAX2 %, ARG1 %, ARG2)
., RESTARGS)
else (LIST 'UFMAX2 ARG1 ARG2)))
(DEFOPTIMIZER UFMAX2 (X Y)
`[\FLOATBOX ((OPCODES UBFLOAT2 6)
(\FLOATUNBOX ,X)
(\FLOATUNBOX ,Y])
(DEFOPTIMIZER UFLESSP (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
(NOT ARG2GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFLESSP" %, %,
ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFLESSP2 ARG1 ARG2))
(DEFOPTIMIZER UFLESSP2 (X Y) `((OPCODES SWAP UBFLOAT2 5)
(\FLOATUNBOX ,X)
(\FLOATUNBOX ,Y)))
(DEFOPTIMIZER UFMAX (&OPTIONAL (ARG1 NIL ARG1GIVEN)
(DEFOPTIMIZER UFMIN (&OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS) (if (NOT ARG1GIVEN)
then 'MIN.FLOAT
elseif (NOT ARG2GIVEN)
then `(FLOAT %, ARG1)
elseif RESTARGS
then `(UFMAX (UFMAX2 %, ARG1 %, ARG2)
., RESTARGS)
else (LIST 'UFMAX2 ARG1 ARG2)))
&REST RESTARGS)
(if (NOT ARG1GIVEN)
then 'MAX.FLOAT
elseif (NOT ARG2GIVEN)
then `(FLOAT %, ARG1)
elseif RESTARGS
then `(UFMIN (UFMIN2 %, ARG1 %, ARG2)
., RESTARGS)
else (LIST 'UFMIN2 ARG1 ARG2)))
(DEFOPTIMIZER UFMIN2 (X Y)
`[\FLOATBOX ((OPCODES UBFLOAT2 7)
(\FLOATUNBOX ,X)
(\FLOATUNBOX ,Y])
(DEFOPTIMIZER UFMAX2 (X Y) `[\FLOATBOX ((OPCODES UBFLOAT2 6)
(\FLOATUNBOX ,X)
(\FLOATUNBOX ,Y])
(DEFOPTIMIZER UFMINUS (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
&REST RESTARGS)
(if (OR (NOT ARG1GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFMINUS" %, %, ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFMINUS1 ARG1))
(DEFOPTIMIZER UFMINUS1 (X)
`[\FLOATBOX ((OPCODES UBFLOAT1 3)
(\FLOATUNBOX ,X])
(DEFOPTIMIZER UFMIN (&OPTIONAL (ARG1 NIL ARG1GIVEN)
(ARG2 NIL ARG2GIVEN)
&REST RESTARGS) (if (NOT ARG1GIVEN)
then 'MAX.FLOAT
elseif (NOT ARG2GIVEN)
then `(FLOAT %, ARG1)
elseif RESTARGS
then `(UFMIN (UFMIN2 %, ARG1 %, ARG2)
., RESTARGS)
else (LIST 'UFMIN2 ARG1 ARG2)))
(DEFOPTIMIZER UFREMAINDER (X Y)
(CL:IF (AND (OR (CL:CONSTANTP X)
(CL:SYMBOLP X))
(OR (CL:CONSTANTP Y)
(CL:SYMBOLP Y)))
`(FDIFFERENCE ,X (FTIMES [FLOAT (UFIX (FQUOTIENT ,X ,Y]
,Y))
'COMPILER:PASS))
(DEFOPTIMIZER UFMIN2 (X Y) `[\FLOATBOX ((OPCODES UBFLOAT2 7)
(\FLOATUNBOX ,X)
(\FLOATUNBOX ,Y])
(DEFOPTIMIZER UFMINUS (&WHOLE ORIGINAL &OPTIONAL (ARG1 NIL ARG1GIVEN)
&REST RESTARGS) (if (OR (NOT ARG1GIVEN)
RESTARGS)
then (PRINTOUT T "************" T)
(PRINTOUT T "Illegal args to UFMINUS" %, %,
ORIGINAL T)
(PRINTOUT T "************" T))
(LIST 'UFMINUS1 ARG1))
(DEFOPTIMIZER UFMINUS1 (X) `[\FLOATBOX ((OPCODES UBFLOAT1 3)
(\FLOATUNBOX ,X])
(DEFOPTIMIZER UFREMAINDER (X Y) (CL:IF (AND (OR (CL:CONSTANTP X)
(CL:SYMBOLP X))
(OR (CL:CONSTANTP Y)
(CL:SYMBOLP Y)))
`(FDIFFERENCE ,X (FTIMES [FLOAT (UFIX (FQUOTIENT ,X
,Y]
,Y))
'COMPILER:PASS))
(PUTPROPS UNBOXEDOPS FILETYPE CL:COMPILE-FILE)
(PUTPROPS UNBOXEDOPS FILETYPE CL:COMPILE-FILE)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -267,9 +252,8 @@ Copyright (c) 1986 by Xerox Corporation. All rights reserved.
(ADDTOVAR LAMA UFMIN UFMAX)
)
(PUTPROPS UNBOXEDOPS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1185 3385 (UFABS 1195 . 1316) (UFEQP 1318 . 1441) (UFGEQ 1443 . 1565) (UFGREATERP 1567
. 1700) (UFIX 1702 . 1821) (UFLEQ 1823 . 1945) (UFLESSP 1947 . 2074) (UFMAX 2076 . 2478) (UFMIN 2480
. 2879) (UFMINUS 2881 . 3006) (UFREMAINDER 3008 . 3383)))))
(FILEMAP (NIL (983 3183 (UFABS 993 . 1114) (UFEQP 1116 . 1239) (UFGEQ 1241 . 1363) (UFGREATERP 1365 .
1498) (UFIX 1500 . 1619) (UFLEQ 1621 . 1743) (UFLESSP 1745 . 1872) (UFMAX 1874 . 2276) (UFMIN 2278 .
2677) (UFMINUS 2679 . 2804) (UFREMAINDER 2806 . 3181)))))
STOP

BIN
lispusers/UNBOXEDOPS.DFASL Normal file
View File

Binary file not shown.

37
lispusers/WHOCALLS
View File

@@ -1,19 +1,17 @@
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "XCL" §BASE 10)
(filecreated "18-Dec-86 19:03:25" {eris}<lispcore>internal>library>whocalls.\;2 4500
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|changes| |to:| (fns distribute.callinfo distribute-call-info-for-symbol)
(vars whocallscoms)
(FILECREATED "18-Feb-2026 16:08:45" |{WMEDLEY}<lispusers>WHOCALLS.;2| 4272
|previous| |date:| " 7-Nov-86 02:47:11" {eris}<lispusers>lispcore>whocalls.\;2)
:EDIT-BY |rmk|
:PREVIOUS-DATE "18-Dec-86 19:03:25" |{WMEDLEY}<lispusers>WHOCALLS.;1|)
; Copyright (c) 1986 by Xerox Corporation. All rights reserved.
(PRETTYCOMPRINT WHOCALLSCOMS)
(prettycomprint whocallscoms)
(rpaqq whocallscoms ((fns whocalls whocalls1 distribute.callinfo distribute-call-info-for-symbol)
(prop proptype calledby usedfreeby usedglobalby boundby)))
(defineq
(RPAQQ WHOCALLSCOMS ((FNS WHOCALLS WHOCALLS1 DISTRIBUTE.CALLINFO DISTRIBUTE-CALL-INFO-FOR-SYMBOL)
(PROP PROPTYPE CALLEDBY USEDFREEBY USEDGLOBALBY BOUNDBY)))
(DEFINEQ
(WHOCALLS
(LAMBDA (CALLEE USAGE)
@@ -78,15 +76,14 @@
x))))))
)
(putprops calledby proptype ignore)
(PUTPROPS CALLEDBY PROPTYPE IGNORE)
(putprops usedfreeby proptype ignore)
(PUTPROPS USEDFREEBY PROPTYPE IGNORE)
(putprops usedglobalby proptype ignore)
(PUTPROPS USEDGLOBALBY PROPTYPE IGNORE)
(putprops boundby proptype ignore)
(putprops whocalls copyright ("Xerox Corporation" 1986))
(declare\: dontcopy
(filemap (nil (653 4251 (whocalls 663 . 2057) (whocalls1 2059 . 3191) (distribute.callinfo 3193 . 3419
) (distribute-call-info-for-symbol 3421 . 4249)))))
stop
(PUTPROPS BOUNDBY PROPTYPE IGNORE)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (466 4064 (WHOCALLS 476 . 1870) (WHOCALLS1 1872 . 3004) (DISTRIBUTE.CALLINFO 3006 . 3232
) (DISTRIBUTE-CALL-INFO-FOR-SYMBOL 3234 . 4062)))))
STOP

BIN
lispusers/WHOCALLS.LCOM
View File

Binary file not shown.

34
lispusers/compilebang
View File

@@ -1,14 +1,11 @@
(DEFINE-FILE-INFO §PACKAGE "INTERLISP" §READTABLE "INTERLISP" §BASE 10)
(FILECREATED "22-Dec-86 18:42:34" {ERIS}<LISPUSERS>LISPCORE>COMPILEBANG.;3 3465
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS COMPILE!)
(FILECREATED "18-Feb-2026 16:23:37" {WMEDLEY}<lispusers>compilebang.;2 3232
previous date%: "18-Nov-86 22:23:43" {ERIS}<LISPUSERS>LISPCORE>COMPILEBANG.;2)
:EDIT-BY rmk
:PREVIOUS-DATE "22-Dec-86 18:42:34" {WMEDLEY}<lispusers>compilebang.;1)
(* "
Copyright (c) 1982, 1983, 1984, 1986 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT COMPILEBANGCOMS)
@@ -63,23 +60,22 @@ Copyright (c) 1982, 1983, 1984, 1986 by Xerox Corporation. All rights reserved.
NIL NIL T))
(T C))))
(ADDTOVAR USERMACROS [C NIL (ORR (UP 1)
NIL)
(ORR ((E (COMPILE! (OR (LISTP (%##))
(%## !0))
T T T)))
((E 'C?])
(ADDTOVAR USERMACROS
[C NIL (ORR (UP 1)
NIL)
(ORR ((E (COMPILE! (OR (LISTP (%##))
(%## !0))
T T T)))
((E 'C?])
(ADDTOVAR EDITCOMSA C)
(DEFCOMMAND (C :EVAL) (&REST LISPXLINE) (COND
(LISPXLINE (COMPILE! (CAR LISPXLINE)
(DEFCOMMAND (C :EVAL) (&REST LISPXLINE) (COND
(LISPXLINE (COMPILE! (CAR LISPXLINE)
NIL NIL T))
(T C)))
(PUTPROPS COMPILEBANG FILETYPE CL:COMPILE-FILE)
(PUTPROPS COMPILEBANG COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1986))
(PUTPROPS COMPILEBANG FILETYPE CL:COMPILE-FILE)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (622 2567 (COMPILE! 632 . 2565)))))
(FILEMAP (NIL (506 2451 (COMPILE! 516 . 2449)))))
STOP