Merge branch 'master' into mth63--Misc_READ-BDF_fixes_and_performance_changes
This commit is contained in:
Matt Heffron
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -1,14 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 7-Sep-88 17:08:57" {ERINYES}<LISPUSERS>MEDLEY>CHATSERVER.;11 47957
|
||||
|
||||
changes to%: (FNS CHATSERVEROPENFN)
|
||||
(FILECREATED " 9-Feb-2026 22:25:32" {WMEDLEY}<lispusers>CHATSERVER.;2 45227
|
||||
|
||||
previous date%: "19-May-88 00:37:49" {ERINYES}<LISPUSERS>MEDLEY>CHATSERVER.;10)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \CREATELINEBUFFER)
|
||||
|
||||
:PREVIOUS-DATE " 7-Sep-88 17:08:57" {WMEDLEY}<lispusers>CHATSERVER.;1)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT CHATSERVERCOMS)
|
||||
|
||||
@@ -40,8 +39,7 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights res
|
||||
(COMMANDS "QUIT" "SAY")
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA \REMOTE.BIN
|
||||
CHATSERVEROPENFN])
|
||||
(LAMA CHATSERVEROPENFN])
|
||||
(DEFINEQ
|
||||
|
||||
(CHATSERVER
|
||||
@@ -450,34 +448,34 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights res
|
||||
(RETURN CHARBUFFER])
|
||||
|
||||
(\CREATELINEBUFFER
|
||||
[LAMBDA (TERMINAL.STREAM) (* ; "Edited 13-Apr-87 22:57 by bvm:")
|
||||
(* ;;
|
||||
"Create a new stream that buffers the raw input from TERMINAL.STREAM (default is the keyboard).")
|
||||
[LAMBDA (TERMINAL.STREAM) (* ; "Edited 9-Feb-2026 22:21 by rmk")
|
||||
(* ; "Edited 13-Apr-87 22:57 by bvm:")
|
||||
|
||||
(LET* ([STREAM (\OPENFILE '{LINEBUFFER} 'BOTH 'NEW '((CHARSET T]
|
||||
(* ;; "This is a copy of \CREATELINEBUFFER on ATERM, except for the source of the EOFMETHOD.")
|
||||
|
||||
(* ;;
|
||||
"Create a new stream that buffers the raw input from TERMINAL.STREAM (default is the keyboard).")
|
||||
|
||||
(LET* ([STREAM (\OPENFILE '{LINEBUFFER} 'BOTH 'NEW '((:EXTERNAL-FORMAT :THROUGH16]
|
||||
(DEV (fetch (STREAM DEVICE) of STREAM))
|
||||
EOFMETHOD)
|
||||
(replace LINEBUFSTATE of STREAM with READING.LBS)
|
||||
(replace (LINEBUFFER KEYBOARDSTREAM) of STREAM with (OR TERMINAL.STREAM
|
||||
\KEYBOARD.STREAM))
|
||||
(replace (LINEBUFFER KEYBOARDSTREAM) of STREAM with (OR TERMINAL.STREAM \KEYBOARD.STREAM))
|
||||
(replace USERCLOSEABLE of STREAM with NIL)
|
||||
(replace USERVISIBLE of STREAM with NIL)
|
||||
(* ;
|
||||
"Other linebuffer fields default properly")
|
||||
(replace USERVISIBLE of STREAM with NIL) (* ;
|
||||
"Other linebuffer fields default properly")
|
||||
[replace ENDOFSTREAMOP of STREAM with (FUNCTION (LAMBDA (STREAM)
|
||||
(CL:FUNCALL \RefillBufferFn]
|
||||
(if (AND TERMINAL.STREAM (NEQ (SETQ EOFMETHOD (fetch (FDEV EOFP)
|
||||
of (fetch (STREAM DEVICE)
|
||||
TERMINAL.STREAM)))
|
||||
'NILL))
|
||||
(CL:FUNCALL \RefillBufferFn]
|
||||
(if (AND TERMINAL.STREAM (NEQ (SETQ EOFMETHOD (fetch (FDEV EOFP) of (fetch (STREAM DEVICE)
|
||||
TERMINAL.STREAM)
|
||||
))
|
||||
'NILL))
|
||||
then
|
||||
(* ;; "Need to install an eof method for the buffered stream that looks at TERMINAL.STREAM when the buffer runs out. This is optimized away for the normal keyboard case, which never runs out.")
|
||||
(* ;; "Need to install an eof method for the buffered stream that looks at TERMINAL.STREAM when the buffer runs out. This is optimized away for the normal keyboard case, which never runs out.")
|
||||
|
||||
(replace (STREAM DEVICE) of STREAM with (SETQ DEV (NCREATE
|
||||
'FDEV DEV)))
|
||||
(* ;
|
||||
"Copy the basic linebuffer device")
|
||||
(replace (FDEV EOFP) of DEV with EOFMETHOD))
|
||||
(replace (STREAM DEVICE) of STREAM with (SETQ DEV (NCREATE 'FDEV DEV)))
|
||||
(* ; "Copy the basic linebuffer device")
|
||||
(replace (FDEV EOFP) of DEV with EOFMETHOD))
|
||||
STREAM])
|
||||
|
||||
(\PROMPTFORWORDBIN
|
||||
@@ -650,7 +648,7 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights res
|
||||
(SETQ CHATSERVERTTBL (COPYTERMTABLE 'ORIG))
|
||||
|
||||
(for I from 1 to 8 do (ECHOCHAR I 'IGNORE CHATSERVERTTBL)
|
||||
(ECHOCHAR I 'IGNORE ASKUSERTTBL))
|
||||
(ECHOCHAR I 'IGNORE ASKUSERTTBL))
|
||||
|
||||
(ECHOCHAR (CHARCODE CR)
|
||||
'SIMULATE CHATSERVERTTBL)
|
||||
@@ -715,29 +713,25 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights res
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PROGN (PUTPROPS \SYNCODE DMACRO [OPENLAMBDA (TABLE CHAR)
|
||||
(CHECK (type? CHARTABLE TABLE))
|
||||
(CHECK (type? CHARTABLE TABLE))
|
||||
(* ;
|
||||
"0 is either NONE.TC, REAL.CCE, or OTHER.RC")
|
||||
(COND
|
||||
((IGREATERP CHAR \MAXTHINCHAR)
|
||||
(OR (AND (fetch (CHARTABLE NSCHARHASH)
|
||||
of TABLE)
|
||||
(GETHASH CHAR (fetch (CHARTABLE
|
||||
NSCHARHASH)
|
||||
of TABLE)))
|
||||
0))
|
||||
(T (\GETBASEBYTE TABLE CHAR])
|
||||
"0 is either NONE.TC, REAL.CCE, or OTHER.RC")
|
||||
(COND
|
||||
((IGREATERP CHAR \MAXTHINCHAR)
|
||||
(OR (AND (fetch (CHARTABLE NSCHARHASH) of TABLE)
|
||||
(GETHASH CHAR (fetch (CHARTABLE NSCHARHASH)
|
||||
of TABLE)))
|
||||
0))
|
||||
(T (\GETBASEBYTE TABLE CHAR])
|
||||
(PUTPROPS \SYNCODE MACRO [OPENLAMBDA (TABLE CHAR)
|
||||
(CHECK (type? CHARTABLE TABLE))
|
||||
(COND
|
||||
((IGREATERP CHAR \MAXTHINCHAR)
|
||||
(OR (AND (fetch (CHARTABLE NSCHARHASH)
|
||||
of TABLE)
|
||||
(GETHASH CHAR (fetch (CHARTABLE
|
||||
NSCHARHASH)
|
||||
of TABLE)))
|
||||
0))
|
||||
(T (\GETBASEBYTE TABLE CHAR])]
|
||||
(CHECK (type? CHARTABLE TABLE))
|
||||
(COND
|
||||
((IGREATERP CHAR \MAXTHINCHAR)
|
||||
(OR (AND (fetch (CHARTABLE NSCHARHASH) of TABLE)
|
||||
(GETHASH CHAR (fetch (CHARTABLE NSCHARHASH)
|
||||
of TABLE)))
|
||||
0))
|
||||
(T (\GETBASEBYTE TABLE CHAR])]
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
@@ -773,10 +767,9 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights res
|
||||
(READVISE MENU CHAT RINGBELLS)
|
||||
)
|
||||
|
||||
(DEFCOMMAND "QUIT" ()
|
||||
(RETFROM 'CHATSERVEROPENFN))
|
||||
(DEFCOMMAND "QUIT" NIL (RETFROM 'CHATSERVEROPENFN))
|
||||
|
||||
(DEFCOMMAND "SAY" (&REST LINE)
|
||||
(DEFCOMMAND "SAY" (&REST LINE)
|
||||
[MAPC \PROCESSES (FUNCTION (LAMBDA (PROC)
|
||||
(CL:WHEN (STRPOS "CHAT.SERVER" (PROCESS.NAME PROC))
|
||||
(MAPRINT LINE (IF (EQ PROC (THIS.PROCESS))
|
||||
@@ -795,53 +788,13 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights res
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA \REMOTE.BIN CHATSERVEROPENFN)
|
||||
)
|
||||
(PRETTYCOMPRINT CHATSERVERCOMS)
|
||||
|
||||
(RPAQQ CHATSERVERCOMS
|
||||
[(FNS CHATSERVER CHATSERVERWHENCLOSEDFN CHATSERVEROPENFN DOBE REQUIRED.LOGIN SERVER-EXEC
|
||||
SWEEP.OFD \CLEARSYSBUF PROMPTFORWORD \CREATELINEBUFFER \PROMPTFORWORDBIN \REMOTE.BIN
|
||||
\REMOTE.EXEC.OUTCHARFN CHATSERVER.FONT)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (DISPLAYTERMFLG 'DM))
|
||||
(INITVARS (CHATSERVER.PROFILE)
|
||||
(\SIMPLEIMAGEOPS))
|
||||
(P (SETQ CHATSERVERTTBL (COPYTERMTABLE 'ORIG))
|
||||
(for I from 1 to 8 do (ECHOCHAR I 'IGNORE CHATSERVERTTBL)
|
||||
(ECHOCHAR I 'IGNORE ASKUSERTTBL))
|
||||
(ECHOCHAR (CHARCODE CR)
|
||||
'SIMULATE CHATSERVERTTBL)
|
||||
(ECHOCHAR (CHARCODE CR)
|
||||
'SIMULATE ASKUSERTTBL)
|
||||
(ECHOCHAR 0 'SIMULATE ASKUSERTTBL)
|
||||
(ECHOCHAR 0 'SIMULATE CHATSERVERTTBL)))
|
||||
(ADDVARS (\SWEPT.OFDS))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (P (CHECKIMPORTS '(LLCHAR ATERM IMAGEIO FILEIO ATBL AOFD)
|
||||
T)))
|
||||
[COMS (FNS SIMPLECHATSERVER)
|
||||
(INITVARS (CHATSERVERWINDOW)
|
||||
(CHATSERVERWINDOWREGION '(11 228 392 190]
|
||||
(MACROS \SYNCODE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (FILES CL-TTYEDIT SIMPLECHAT)
|
||||
(ADVISE MENU CHAT RINGBELLS))
|
||||
(COMMANDS "QUIT" "SAY")
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA CHATSERVEROPENFN])
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA CHATSERVEROPENFN)
|
||||
)
|
||||
(PUTPROPS CHATSERVER COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2216 38509 (CHATSERVER 2226 . 3955) (CHATSERVERWHENCLOSEDFN 3957 . 4304) (
|
||||
CHATSERVEROPENFN 4306 . 8433) (DOBE 8435 . 8481) (REQUIRED.LOGIN 8483 . 11220) (SERVER-EXEC 11222 .
|
||||
11395) (SWEEP.OFD 11397 . 11933) (\CLEARSYSBUF 11935 . 12184) (PROMPTFORWORD 12186 . 26531) (
|
||||
\CREATELINEBUFFER 26533 . 28708) (\PROMPTFORWORDBIN 28710 . 31646) (\REMOTE.BIN 31648 . 33890) (
|
||||
\REMOTE.EXEC.OUTCHARFN 33892 . 38114) (CHATSERVER.FONT 38116 . 38507)) (39151 41493 (SIMPLECHATSERVER
|
||||
39161 . 41491)))))
|
||||
(FILEMAP (NIL (2029 38278 (CHATSERVER 2039 . 3768) (CHATSERVERWHENCLOSEDFN 3770 . 4117) (
|
||||
CHATSERVEROPENFN 4119 . 8246) (DOBE 8248 . 8294) (REQUIRED.LOGIN 8296 . 11033) (SERVER-EXEC 11035 .
|
||||
11208) (SWEEP.OFD 11210 . 11746) (\CLEARSYSBUF 11748 . 11997) (PROMPTFORWORD 11999 . 26344) (
|
||||
\CREATELINEBUFFER 26346 . 28477) (\PROMPTFORWORDBIN 28479 . 31415) (\REMOTE.BIN 31417 . 33659) (
|
||||
\REMOTE.EXEC.OUTCHARFN 33661 . 37883) (CHATSERVER.FONT 37885 . 38276)) (38905 41247 (SIMPLECHATSERVER
|
||||
38915 . 41245)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -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
|
||||
|
||||
Binary file not shown.
Binary file not shown.
52
lispusers/CONVERT-TO-UTF8
Normal file
52
lispusers/CONVERT-TO-UTF8
Normal file
@@ -0,0 +1,52 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "25-Feb-2026 09:09:57" {WMEDLEY}<lispusers>CONVERT-TO-UTF8.;16 2573
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS CONVERT-TO-UTF8)
|
||||
|
||||
:PREVIOUS-DATE "24-Feb-2026 22:45:57" {WMEDLEY}<lispusers>CONVERT-TO-UTF8.;14)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT CONVERT-TO-UTF8COMS)
|
||||
|
||||
(RPAQQ CONVERT-TO-UTF8COMS ((FNS CONVERT-TO-UTF8)))
|
||||
(DEFINEQ
|
||||
|
||||
(CONVERT-TO-UTF8
|
||||
[LAMBDA (FILENAME FILETYPE) (* ; "Edited 25-Feb-2026 09:09 by rmk")
|
||||
|
||||
(* ;; "This produces a new version of the source FILENAME with :UTF-8 external format.")
|
||||
|
||||
(* ;; "If we had a list of problematic functions (multiple definitions on multiple files, MOVD's), we could check that against the functions in FILENAME, and at least produce a warning.")
|
||||
|
||||
(* ;; "Compiling may be tricky: some files have CL:COMPILE-FILE FILETYPE properties that don't correspond to the fact that they actually have only an LCOM. This tries to revert the filetype back to FAKE-COMPILE-FILE so that we don't get confused when a DFASL mysteriously appears.")
|
||||
|
||||
(SETQ FILENAME (PSEUDOFILENAME FILENAME))
|
||||
(SETQ FILENAME (OR (FINDFILE FILENAME T)
|
||||
(ERROR "FILE NOT FOUND" FILENAME)))
|
||||
(if [EQ :UTF-8 (CL:WITH-OPEN-FILE (STREAM FILENAME :DIRECTION :INPUT)
|
||||
(fetch (READER-ENVIRONMENT REFORMAT) of (GET-ENVIRONMENT-AND-FILEMAP STREAM
|
||||
T]
|
||||
then (PRINTOUT T FILENAME " is already " .P2 :UTF-8 T)
|
||||
NIL
|
||||
else (LOAD? (MEDLEYDIR "loadups" 'EXPORTS.ALL)) (* ; "Maybe this should load SYSEDIT ?")
|
||||
(LOAD FILENAME 'PROP)
|
||||
(LOADCOMP FILENAME)
|
||||
(SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY FILENAME))
|
||||
(CL:WHEN [AND (EQ 'CL:COMPILE-FILE (GETPROP (ROOTFILENAME FILENAME)
|
||||
'FILETYPE))
|
||||
(FINDFILE (PACKFILENAME 'EXTENSION 'LCOM 'BODY FILENAME))
|
||||
(NOT (FINDFILE (PACKFILENAME 'EXTENSION 'DFASL 'BODY FILENAME]
|
||||
(CL:UNLESS FILETYPE (SETQ FILETYPE :FAKE-COMPILE-FILE))
|
||||
(PRINTOUT T "Changing FILETYPE back to " .P2 FILETYPE T)
|
||||
(PUTPROP (ROOTFILENAME FILENAME)
|
||||
'FILETYPE FILETYPE))
|
||||
[SETQ FILENAME (MAKEFILE FILENAME '(NEW :UTF-8]
|
||||
(MAKEFILE1 FILENAME NIL '(F))
|
||||
FILENAME])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (406 2550 (CONVERT-TO-UTF8 416 . 2548)))))
|
||||
STOP
|
||||
BIN
lispusers/CONVERT-TO-UTF8.LCOM
Normal file
BIN
lispusers/CONVERT-TO-UTF8.LCOM
Normal file
Binary file not shown.
BIN
lispusers/CONVERT-TO-UTF8.TEDIT
Normal file
BIN
lispusers/CONVERT-TO-UTF8.TEDIT
Normal file
Binary file not shown.
116
lispusers/CROCK
116
lispusers/CROCK
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Binary file not shown.
215
lispusers/GITFNS
215
lispusers/GITFNS
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED "28-Oct-2025 14:10:06" {WMEDLEY}<lispusers>GITFNS.;569 131593
|
||||
(FILECREATED " 2-Mar-2026 14:00:13" {WMEDLEY}<lispusers>GITFNS.;576 133513
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-BRANCHES-COMPARE-DIRECTORIES)
|
||||
:CHANGES-TO (FNS GIT-MY-NEXT-BRANCH)
|
||||
|
||||
:PREVIOUS-DATE "28-Oct-2025 13:32:16" {WMEDLEY}<lispusers>GITFNS.;568)
|
||||
:PREVIOUS-DATE "26-Feb-2026 00:39:22" {WMEDLEY}<lispusers>GITFNS.;575)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -74,7 +74,7 @@
|
||||
|
||||
(* ;; "Differences")
|
||||
|
||||
(FNS GIT-BRANCH-DIFF GIT-COMMIT-DIFFS GIT-BRANCH-RELATIONS)
|
||||
(FNS GIT-BRANCH-DIFF GIT-COMMIT-DIFFS GIT-BRANCH-RELATIONS GIT-MODIFIED)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -169,6 +169,7 @@
|
||||
|
||||
(GIT-MAKE-PROJECT
|
||||
[LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
|
||||
(* ; "Edited 25-Feb-2026 23:25 by rmk")
|
||||
(* ; "Edited 25-Oct-2025 16:53 by rmk")
|
||||
(* ; "Edited 22-Oct-2025 12:45 by rmk")
|
||||
(* ; "Edited 20-Oct-2025 18:10 by rmk")
|
||||
@@ -234,9 +235,8 @@
|
||||
(CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY
|
||||
CLONEPATH)))
|
||||
(SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE :EXTERNAL-FORMAT :UTF-8)
|
||||
(bind L until (EOFP STREAM)
|
||||
while (SETQ L (CL:READ-LINE STREAM :EOF-ERROR-P NIL
|
||||
:EOF-VALUE NIL))
|
||||
(bind L until (EOFP STREAM) while (SETQ L (CL:READ-LINE
|
||||
STREAM NIL))
|
||||
unless (OR (EQ 0 (NCHARS L))
|
||||
(STRPOS "#" L)) collect L))))
|
||||
(SETQ EXCLUSIONS (CL:REMOVE-DUPLICATES (APPEND (for E inside EXCLUSIONS
|
||||
@@ -274,16 +274,16 @@
|
||||
"")
|
||||
"for " PROJECTNAME]
|
||||
(SETQ PROJECT (create GIT-PROJECT
|
||||
PROJECTNAME _ PROJECTNAME
|
||||
GITHOST _ (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH)
|
||||
PROJECTNAME ← PROJECTNAME
|
||||
GITHOST ← (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH)
|
||||
"}")
|
||||
WHOST _ (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W"
|
||||
WHOST ← (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W"
|
||||
PROJECTNAME)
|
||||
WORKINGPATH)
|
||||
"}"))
|
||||
EXCLUSIONS _ EXCLUSIONS
|
||||
DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS)
|
||||
CLONEPATH _ CLONEPATH))
|
||||
EXCLUSIONS ← EXCLUSIONS
|
||||
DEFAULTSUBDIRS ← (MKLIST DEFAULTSUBDIRS)
|
||||
CLONEPATH ← CLONEPATH))
|
||||
(/RPLACD [OR (ASSOC PROJECTNAME GIT-PROJECTS)
|
||||
(CAR (push GIT-PROJECTS (CONS PROJECTNAME]
|
||||
PROJECT)
|
||||
@@ -358,7 +358,7 @@
|
||||
|
||||
(FIND-ANCESTOR-DIRECTORY
|
||||
[LAMBDA (STARTDIR PREDFN) (* ; "Edited 8-May-2022 12:17 by rmk")
|
||||
(BIND POS (A _ STARTDIR) WHILE (SETQ POS (STRPOS "/" A -2 NIL NIL NIL FILEDIRCASEARRAY T))
|
||||
(BIND POS (A ← STARTDIR) WHILE (SETQ POS (STRPOS "/" A -2 NIL NIL NIL FILEDIRCASEARRAY T))
|
||||
DO (SETQ A (SUBSTRING A 1 POS))
|
||||
(CL:WHEN (APPLY* PREDFN A)
|
||||
(RETURN A])
|
||||
@@ -372,7 +372,7 @@
|
||||
(GIT-CLONEP (GIT-PROJECT-PATH PROJECTNAME PROJECTPATH)
|
||||
T T)
|
||||
[FIND-ANCESTOR-DIRECTORY PROJECTPATH (FUNCTION (LAMBDA (A)
|
||||
(BIND D (GEN _ (\GENERATEFILES A NIL NIL 1))
|
||||
(BIND D (GEN ← (\GENERATEFILES A NIL NIL 1))
|
||||
WHILE (SETQ D (\GENERATENEXTFILE GEN))
|
||||
WHEN (GIT-CLONEP D T)
|
||||
DO (RETFROM (FUNCTION
|
||||
@@ -684,7 +684,7 @@
|
||||
|
||||
(GIT-MAINBRANCH? (GIT-WHICH-BRANCH PROJECT)
|
||||
PROJECT)
|
||||
(FOR MF GF DEST (MEDLEYSUBDIRS _ (MEDLEYSUBDIRS PROJECT)) INSIDE MFILES
|
||||
(FOR MF GF DEST (MEDLEYSUBDIRS ← (MEDLEYSUBDIRS PROJECT)) INSIDE MFILES
|
||||
COLLECT (SETQ MF (OR (FINDFILE MF NIL MEDLEYSUBDIRS)
|
||||
(ERROR "FILE NOT FOUND" MF)))
|
||||
(CL:UNLESS (STRING.EQUAL MF (INFILEP (PACKFILENAME 'VERSION NIL 'BODY MF))
|
||||
@@ -709,7 +709,7 @@
|
||||
(* ;; "Does anybody call this?")
|
||||
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(FOR GF MF DEST (GITSUBDIRS _ (GITSUBDIRS PROJECT)) INSIDE GFILES
|
||||
(FOR GF MF DEST (GITSUBDIRS ← (GITSUBDIRS PROJECT)) INSIDE GFILES
|
||||
COLLECT (SETQ GF (OR (FINDFILE GF NIL GITSUBDIRS)
|
||||
(ERROR "FILE NOT FOUND" GF)))
|
||||
(SETQ MF (MFILE4GFILE GF))
|
||||
@@ -742,8 +742,8 @@
|
||||
"")])
|
||||
|
||||
(STRIPDIR
|
||||
[LAMBDA (FILE DIRECTORY) (* ; "Edited 18-Jan-2022 16:09 by rmk")
|
||||
(* ; "Edited 8-Nov-2021 11:50 by rmk:")
|
||||
[LAMBDA (FILE DIRECTORY) (* ; "Edited 18-Jan-2022 16:09 by rmk")
|
||||
(* ; "Edited 8-Nov-2021 11:50 by rmk:")
|
||||
(IF (STRPOS DIRECTORY FILE 1 NIL T NIL FILEDIRCASEARRAY)
|
||||
THEN (SUBSTRING FILE (ADD1 (NCHARS DIRECTORY)))
|
||||
ELSE FILE])
|
||||
@@ -1023,7 +1023,7 @@
|
||||
": ")
|
||||
(IF (EQ (CAR X)
|
||||
'Comments)
|
||||
THEN (FOR CC (POS _ (POSITION T)) IN (CDR X)
|
||||
THEN (FOR CC (POS ← (POSITION T)) IN (CDR X)
|
||||
DO (IF (EQ CC T)
|
||||
THEN (TERPRI T)
|
||||
ELSE (PRINTOUT T .TAB0 POS CC)))
|
||||
@@ -1163,7 +1163,7 @@
|
||||
|
||||
(* ;; "Returns the identifiers for commits in BRANCH1 but not in BUTNOTBRANCH2")
|
||||
|
||||
(GIT-COMMAND (CONCAT "git log --format=%"%%h%" %"" BRANCH1 "%" %"" BUTNOTBRANCH2 "%"")
|
||||
(GIT-COMMAND (CONCAT "git log --format=%"%%h%" %"" BRANCH1 "%" %"^" BUTNOTBRANCH2 "%"")
|
||||
NIL NIL PROJECT])
|
||||
|
||||
(GIT-BRANCH-RELATIONS
|
||||
@@ -1227,6 +1227,16 @@
|
||||
then (CONS MAIN (DREMOVE MAIN (SORT DATUM)))
|
||||
else (SORT DATUM]
|
||||
(RETURN (LIST SUPERSETS EQUALS])
|
||||
|
||||
(GIT-MODIFIED
|
||||
[LAMBDA (PROJECT) (* ; "Edited 25-Dec-2025 13:39 by rmk")
|
||||
|
||||
(* ;;
|
||||
"A list of files that have been modified M or introduced but not committed ??. see git help status")
|
||||
|
||||
(for X POS in (GIT-COMMAND "git status --porcelain")
|
||||
when (SETQ POS (OR (STRPOS " M " X NIL NIL NIL T)
|
||||
(STRPOS "?? " X NIL NIL NIL T))) collect (SUBSTRING X POS])
|
||||
)
|
||||
|
||||
|
||||
@@ -1353,7 +1363,7 @@
|
||||
(CL:WHEN (thereis B in BRANCHES suchthat (STRPOS "HEAD detached" B))
|
||||
(PRINTOUT T "Execute %"git gc%" to eliminate a branch with a detached HEAD" T))
|
||||
(CL:WHEN EXCLUDEMERGED
|
||||
(SETQ BRANCHES (for B (MAINBRANCH _ (GIT-MAINBRANCH PROJECT 'LOCAL)) in BRANCHES
|
||||
(SETQ BRANCHES (for B (MAINBRANCH ← (GIT-MAINBRANCH PROJECT 'LOCAL)) in BRANCHES
|
||||
when (EQUAL (GIT-COMMAND (CONCAT "git merge-base %"" B "%" %""
|
||||
MAINBRANCH "%""))
|
||||
(GIT-COMMAND (CONCAT "git rev-parse %"" B "%"")))
|
||||
@@ -1392,11 +1402,11 @@
|
||||
(CL:WHEN PIN?
|
||||
[SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu])
|
||||
(create MENU
|
||||
TITLE _ (OR TITLE (CONCAT (LENGTH BRANCHES)
|
||||
TITLE ← (OR TITLE (CONCAT (LENGTH BRANCHES)
|
||||
" branches"))
|
||||
ITEMS _ BRANCHES
|
||||
MENUFONT _ DEFAULTFONT
|
||||
WHENSELECTEDFN _ (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))])
|
||||
ITEMS ← BRANCHES
|
||||
MENUFONT ← DEFAULTFONT
|
||||
WHENSELECTEDFN ← (FUNCTION GIT-BRANCH-WHENSELECTEDFN)))])
|
||||
|
||||
(GIT-BRANCH-WHENSELECTEDFN
|
||||
[LAMBDA (ITEM MENU BUTTON) (* ; "Edited 2-Oct-2025 23:08 by rmk")
|
||||
@@ -1446,20 +1456,20 @@
|
||||
eachtime [SETQ DRAFT (EQ 'true (JSON-GET JSOBJ 'isDraft] when (OR INCLUDEDRAFTS
|
||||
(NOT DRAFT))
|
||||
collect [SETQ PR (create PULLREQUEST
|
||||
PRNUMBER _ (JSON-GET JSOBJ 'number)
|
||||
PRNAME _ (JSON-GET JSOBJ 'headRefName)
|
||||
PRDESCRIPTION _ (JSON-GET JSOBJ 'title)
|
||||
PRSTATUS _ (CL:IF DRAFT
|
||||
PRNUMBER ← (JSON-GET JSOBJ 'number)
|
||||
PRNAME ← (JSON-GET JSOBJ 'headRefName)
|
||||
PRDESCRIPTION ← (JSON-GET JSOBJ 'title)
|
||||
PRSTATUS ← (CL:IF DRAFT
|
||||
'D
|
||||
(SELECTQ (MKATOM (JSON-GET JSOBJ 'reviewDecision))
|
||||
(CHANGES¬REQUESTED
|
||||
(CHANGES_REQUESTED
|
||||
'C)
|
||||
(REVIEW¬REQUIRED
|
||||
(REVIEW_REQUIRED
|
||||
" ")
|
||||
'A))
|
||||
PRPROJECT _ PROJECT
|
||||
PRURL _ (JSON-GET JSOBJ 'url)
|
||||
PRLOGIN _ (JSON-GET JSOBJ '(headRepositoryOwner login]
|
||||
PRPROJECT ← PROJECT
|
||||
PRURL ← (JSON-GET JSOBJ 'url)
|
||||
PRLOGIN ← (JSON-GET JSOBJ '(headRepositoryOwner login]
|
||||
(CL:WHEN (STRPOS ":" (fetch (PULLREQUEST PRNAME) of PR))
|
||||
|
||||
(* ;; "From Nick: Git commands to bring install and deal with the remotes:")
|
||||
@@ -1510,8 +1520,8 @@
|
||||
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (for PR in PRS
|
||||
collect (GITORIGIN (fetch PRNAME of PR)))
|
||||
NIL T PROJECT)))
|
||||
(SORT (for PR REL LABEL PRNAME STATUS (SUPERSETS _ (CAR RELATIONS))
|
||||
(EQUALS _ (CADR RELATIONS)) in PRS
|
||||
(SORT (for PR REL LABEL PRNAME STATUS (SUPERSETS ← (CAR RELATIONS))
|
||||
(EQUALS ← (CADR RELATIONS)) in PRS
|
||||
eachtime (SETQ PRNAME (fetch PRNAME of PR))
|
||||
(SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR)
|
||||
" "
|
||||
@@ -1558,15 +1568,33 @@
|
||||
(GIT-BRANCH-NUM (OR BRANCH (GIT-WHICH-BRANCH PROJECT T])
|
||||
|
||||
(GIT-MY-NEXT-BRANCH
|
||||
[LAMBDA (PROJECT) (* ; "Edited 19-May-2022 14:08 by rmk")
|
||||
[LAMBDA (PROJECT) (* ; "Edited 2-Mar-2026 14:00 by rmk")
|
||||
(* ; "Edited 19-May-2022 14:08 by rmk")
|
||||
(* ; "Edited 8-Jan-2022 09:43 by rmk")
|
||||
|
||||
(* ;; "Figures out the number of my next incremental branch would be. ")
|
||||
|
||||
(PACK* (GIT-INITIALS)
|
||||
(ADD1 (OR (GIT-MY-BRANCHP (GIT-MY-CURRENT-BRANCH PROJECT)
|
||||
PROJECT)
|
||||
0])
|
||||
(LET (PROJECTLIST PROJECTENTRY NEXTNUM)
|
||||
(CL:WITH-OPEN-FILE (STRM "{LI}GIT-MY-CURRENT-BRANCH-NUMS;1" :DIRECTION :IO
|
||||
:IF-DOES-NOT-EXIST :CREATE :IF-EXISTS :OVERWRITE)
|
||||
(SETQ PROJECTLIST (CL:UNLESS (EQ 0 (GETEOFPTR STRM))
|
||||
(READ STRM)))
|
||||
(SETQ PROJECTENTRY (ASSOC (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
|
||||
PROJECTLIST))
|
||||
(CL:UNLESS PROJECTENTRY
|
||||
(SETQ PROJECTENTRY (LIST (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
|
||||
(OR (GIT-MY-BRANCHP (GIT-MY-CURRENT-BRANCH
|
||||
PROJECT)
|
||||
PROJECT)
|
||||
0)))
|
||||
(push PROJECTLIST PROJECTENTRY))
|
||||
(SETQ NEXTNUM (ADD1 (CADR PROJECTENTRY)))
|
||||
(RPLACA (CDR PROJECTENTRY)
|
||||
NEXTNUM)
|
||||
(SETFILEPTR STRM 0)
|
||||
(PRINT PROJECTLIST STRM)
|
||||
NEXTNUM])
|
||||
|
||||
(GIT-MY-BRANCHES
|
||||
[LAMBDA (PROJECT EXCLUDEMERGED INITS) (* ; "Edited 19-May-2022 19:10 by rmk")
|
||||
@@ -1647,14 +1675,14 @@
|
||||
(CL:WHEN (STRPOS "fatal: " (CAR LINES)
|
||||
1 NIL T)
|
||||
(ERROR "Could not remove worktree for " BRANCH))
|
||||
(* (DELFILE (CONCAT PATH "/.DS_Store"))
|
||||
(* (DELFILE (CONCAT PATH "/.DS←Store"))
|
||||
(GIT-COMMAND (CONCAT "rmdir " DIR) NIL
|
||||
NIL PROJECT))
|
||||
BRANCH])
|
||||
|
||||
(GIT-LIST-WORKTREES
|
||||
[LAMBDA NIL (* ; "Edited 12-Dec-2021 12:13 by rmk")
|
||||
(* ; "Edited 19-Nov-2021 18:53 by rmk:")
|
||||
[LAMBDA NIL (* ; "Edited 12-Dec-2021 12:13 by rmk")
|
||||
(* ; "Edited 19-Nov-2021 18:53 by rmk:")
|
||||
|
||||
(* ;; "The git command tells us what the clone thinks about it, but then we look to see what is actually in our worktrees directory, to make sure that the subdirectory wasn't deleted in a wy that the clone didn't know about.")
|
||||
|
||||
@@ -1880,14 +1908,14 @@
|
||||
|
||||
(replace (CDENTRY INFO2) of CDE
|
||||
with (create CDINFO
|
||||
FULLNAME _ (CADR MAP)
|
||||
DATE _ (CL:IF (EQ 'R (CADDR MAP))
|
||||
FULLNAME ← (CADR MAP)
|
||||
DATE ← (CL:IF (EQ 'R (CADDR MAP))
|
||||
" <-"
|
||||
" ==")
|
||||
LENGTH _ ""
|
||||
AUTHOR _ ""
|
||||
TYPE _ ""
|
||||
EOL _ ""))
|
||||
LENGTH ← ""
|
||||
AUTHOR ← ""
|
||||
TYPE ← ""
|
||||
EOL ← ""))
|
||||
(replace (CDENTRY DATEREL) of CDE
|
||||
with (CADDR MAP]
|
||||
(TERPRI T)
|
||||
@@ -1957,10 +1985,10 @@
|
||||
then (SETQ SUBDIRS (ALLSUBDIRS PROJECT))
|
||||
"ALL subdirectories"
|
||||
else SUBDIRS)))
|
||||
(for SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT)
|
||||
(for SUBDIR TITLE CDVAL (WPROJ ← (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT)
|
||||
T)))
|
||||
(NENTRIES _ 0)
|
||||
(BRANCH2 _ (GIT-WHICH-BRANCH PROJECT T))
|
||||
(NENTRIES ← 0)
|
||||
(BRANCH2 ← (GIT-WHICH-BRANCH PROJECT T))
|
||||
first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
|
||||
(BKSYSBUF " ") inside SUBDIRS
|
||||
collect (TERPRI T)
|
||||
@@ -2132,12 +2160,12 @@
|
||||
NIL]
|
||||
(CL:WHEN (OR COPYITEM COMPAREITEMS)
|
||||
(SELECTQ (MENU (CREATE MENU
|
||||
TITLE _ (CONCAT (WINDOWPROP WINDOW 'SUBDIR)
|
||||
TITLE ← (CONCAT (WINDOWPROP WINDOW 'SUBDIR)
|
||||
"/"
|
||||
(FETCH MATCHNAME OF CDENTRY))
|
||||
ITEMS _ (APPEND COPYITEM COMPAREITEMS)
|
||||
MENUFONT _ FONT
|
||||
MENUTITLEFONT _ FONT))
|
||||
ITEMS ← (APPEND COPYITEM COMPAREITEMS)
|
||||
MENUFONT ← FONT
|
||||
MENUTITLEFONT ← FONT))
|
||||
(TOGIT (CL:WHEN (TOGIT (FETCH (CDINFO FULLNAME) OF INFO1)
|
||||
WINDOW)
|
||||
(IMAGEOBJPROP OBJ 'COPIED T)
|
||||
@@ -2162,18 +2190,18 @@
|
||||
NIL)))])
|
||||
|
||||
(GIT-CD-LABELFN
|
||||
[LAMBDA (FILE1 FILE2 USERDATA) (* ; "Edited 5-Jan-2022 15:10 by rmk")
|
||||
(* ; "Edited 16-Dec-2021 12:25 by rmk")
|
||||
[LAMBDA (FILE1 FILE2 USERDATA) (* ; "Edited 5-Jan-2022 15:10 by rmk")
|
||||
(* ; "Edited 16-Dec-2021 12:25 by rmk")
|
||||
(* ; "Edited 13-Dec-2021 22:13 by rmk")
|
||||
(DECLARE (USEDFREE CDVALUE))
|
||||
(LET (NC B LABEL1 LABEL2)
|
||||
(CL:WHEN (SETQ NC (FETCH NCDIR OF (FETCH CDMAXNC1 OF CDVALUE)))
|
||||
(SETQ LABEL1 (SLASHIT (SUBSTRING FILE1 (ADD1 NC))
|
||||
(SETQ LABEL1 (SLASHIT (SUBSTRING FILE1 (ADD1 NC))
|
||||
T))
|
||||
(CL:WHEN (SETQ B (LISTGET USERDATA 'BRANCH1))
|
||||
(SETQ LABEL1 (CONCAT B "/" LABEL1))))
|
||||
(CL:WHEN (SETQ NC (FETCH NCDIR OF (FETCH CDMAXNC2 OF CDVALUE)))
|
||||
(SETQ LABEL2 (SLASHIT (SUBSTRING FILE2 (ADD1 NC))
|
||||
(SETQ LABEL2 (SLASHIT (SUBSTRING FILE2 (ADD1 NC))
|
||||
T))
|
||||
(CL:WHEN (SETQ B (LISTGET USERDATA 'BRANCH2))
|
||||
(SETQ LABEL2 (CONCAT B "/" LABEL2))))
|
||||
@@ -2367,15 +2395,15 @@
|
||||
NIL])
|
||||
|
||||
(GIT-RESULT-TO-LINES
|
||||
[LAMBDA (FILE ALL) (* ; "Edited 31-Mar-2025 15:19 by rmk")
|
||||
[LAMBDA (FILE ALL) (* ; "Edited 25-Feb-2026 23:24 by rmk")
|
||||
(* ; "Edited 31-Mar-2025 15:19 by rmk")
|
||||
(* ; "Edited 16-Jul-2022 22:21 by rmk")
|
||||
|
||||
(* ;; "Suppress .git lines unless ALL SYSTEM-EXTERNALFORMAT may make the wrong guess, but at least we ensure here that lines get broken.")
|
||||
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT (LIST (SYSTEM-EXTERNALFORMAT)
|
||||
'ANY))
|
||||
(bind LINE until (EOFP STREAM) when [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P
|
||||
NIL :EOF-VALUE NIL))
|
||||
(bind LINE until (EOFP STREAM) when [PROGN (SETQ LINE (CL:READ-LINE STREAM NIL))
|
||||
(OR ALL (NOT (STRPOS ".git" LINE 1]
|
||||
collect LINE])
|
||||
|
||||
@@ -2394,32 +2422,33 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4196 21002 (GIT-CLONEP 4206 . 5637) (GIT-INIT 5639 . 6269) (GIT-MAKE-PROJECT 6271 .
|
||||
14060) (GIT-GET-PROJECT 14062 . 15987) (GIT-PUT-PROJECT-FIELD 15989 . 17630) (GIT-PROJECT-PATH 17632
|
||||
. 18676) (FIND-ANCESTOR-DIRECTORY 18678 . 19027) (GIT-FIND-CLONE 19029 . 20110) (GIT-MAINBRANCH 20112
|
||||
. 20507) (GIT-MAINBRANCH? 20509 . 21000)) (26465 31394 (PRC-COMMAND 26475 . 31392)) (31450 34238 (
|
||||
ALLSUBDIRS 31460 . 32746) (MEDLEYSUBDIRS 32748 . 33441) (GITSUBDIRS 33443 . 34236)) (34239 36640 (
|
||||
TOGIT 34249 . 35655) (FROMGIT 35657 . 36638)) (36641 39644 (MYMEDLEYSUBDIR 36651 . 37107) (GITSUBDIR
|
||||
37109 . 37552) (STRIPDIR 37554 . 37925) (STRIPHOST 37927 . 38167) (STRIPNAME 38169 . 38922) (
|
||||
STRIPWHERE 38924 . 39642)) (39645 41880 (GFILE4MFILE 39655 . 40351) (MFILE4GFILE 40353 . 40922) (
|
||||
GIT-REPO-FILENAME 40924 . 41878)) (41929 52184 (GIT-COMMIT 41939 . 42765) (GIT-PUSH 42767 . 43527) (
|
||||
GIT-PULL 43529 . 44281) (GIT-APPROVAL 44283 . 44632) (GIT-GET-FILE 44634 . 46549) (GIT-FILE-EXISTS?
|
||||
46551 . 46825) (GIT-REMOTE-UPDATE 46827 . 47662) (GIT-REMOTE-ADD 47664 . 47971) (GIT-FILE-DATE 47973
|
||||
. 49020) (GIT-FILE-HISTORY 49022 . 50956) (GIT-PRINT-FILE-HISTORY 50958 . 52008) (GIT-FETCH 52010 .
|
||||
52182)) (52214 63694 (GIT-BRANCH-DIFF 52224 . 59113) (GIT-COMMIT-DIFFS 59115 . 60006) (
|
||||
GIT-BRANCH-RELATIONS 60008 . 63692)) (63739 82478 (GIT-BRANCH-NUM 63749 . 64322) (GIT-CHECKOUT 64324
|
||||
. 65610) (GIT-WHICH-BRANCH 65612 . 66019) (GIT-MAKE-BRANCH 66021 . 68600) (GIT-BRANCHES 68602 . 71197
|
||||
) (GIT-BRANCH-EXISTS? 71199 . 72070) (GIT-PICK-BRANCH 72072 . 72562) (GIT-BRANCH-MENU 72564 . 73445) (
|
||||
GIT-BRANCH-WHENSELECTEDFN 73447 . 74986) (GIT-PULL-REQUESTS 74988 . 78859) (GIT-SHORT-BRANCH-NAME
|
||||
78861 . 79152) (GIT-LONG-NAME 79154 . 79471) (GIT-PRC-BRANCHES 79473 . 82476)) (82508 85956 (
|
||||
GIT-MY-CURRENT-BRANCH 82518 . 82888) (GIT-MY-BRANCHP 82890 . 83508) (GIT-MY-NEXT-BRANCH 83510 . 84004)
|
||||
(GIT-MY-BRANCHES 84006 . 85954)) (86002 90077 (GIT-ADD-WORKTREE 86012 . 87619) (GIT-REMOVE-WORKTREE
|
||||
87621 . 88551) (GIT-LIST-WORKTREES 88553 . 89357) (WORKTREEDIR 89359 . 90075)) (90125 123133 (
|
||||
GIT-GET-DIFFERENT-FILES 90135 . 97043) (GIT-BRANCHES-COMPARE-DIRECTORIES 97045 . 104672) (
|
||||
GIT-WORKING-COMPARE-DIRECTORIES 104674 . 110470) (GIT-COMPARE-WORKTREE 110472 . 114450) (
|
||||
GITCDOBJBUTTONFN 114452 . 118942) (GIT-CD-LABELFN 118944 . 120026) (GIT-CD-MENUFN 120028 . 121114) (
|
||||
GIT-WORKING-COMPARE-FILES 121116 . 121736) (GIT-BRANCHES-COMPARE-FILES 121738 . 122902) (
|
||||
GIT-PR-COMPARE 122904 . 123131)) (123203 131526 (CDGITDIR 123213 . 123900) (GIT-COMMAND 123902 .
|
||||
125460) (GITORIGIN 125462 . 126159) (GIT-INITIALS 126161 . 126465) (GIT-COMMAND-TO-FILE 126467 .
|
||||
129952) (GIT-RESULT-TO-LINES 129954 . 130859) (STRIPLOCAL 130861 . 131524)))))
|
||||
(FILEMAP (NIL (4178 21056 (GIT-CLONEP 4188 . 5619) (GIT-INIT 5621 . 6251) (GIT-MAKE-PROJECT 6253 .
|
||||
14110) (GIT-GET-PROJECT 14112 . 16037) (GIT-PUT-PROJECT-FIELD 16039 . 17680) (GIT-PROJECT-PATH 17682
|
||||
. 18726) (FIND-ANCESTOR-DIRECTORY 18728 . 19079) (GIT-FIND-CLONE 19081 . 20164) (GIT-MAINBRANCH 20166
|
||||
. 20561) (GIT-MAINBRANCH? 20563 . 21054)) (26519 31448 (PRC-COMMAND 26529 . 31446)) (31504 34292 (
|
||||
ALLSUBDIRS 31514 . 32800) (MEDLEYSUBDIRS 32802 . 33495) (GITSUBDIRS 33497 . 34290)) (34293 36698 (
|
||||
TOGIT 34303 . 35711) (FROMGIT 35713 . 36696)) (36699 39709 (MYMEDLEYSUBDIR 36709 . 37165) (GITSUBDIR
|
||||
37167 . 37610) (STRIPDIR 37612 . 37990) (STRIPHOST 37992 . 38232) (STRIPNAME 38234 . 38987) (
|
||||
STRIPWHERE 38989 . 39707)) (39710 41945 (GFILE4MFILE 39720 . 40416) (MFILE4GFILE 40418 . 40987) (
|
||||
GIT-REPO-FILENAME 40989 . 41943)) (41994 52251 (GIT-COMMIT 42004 . 42830) (GIT-PUSH 42832 . 43592) (
|
||||
GIT-PULL 43594 . 44346) (GIT-APPROVAL 44348 . 44697) (GIT-GET-FILE 44699 . 46614) (GIT-FILE-EXISTS?
|
||||
46616 . 46890) (GIT-REMOTE-UPDATE 46892 . 47727) (GIT-REMOTE-ADD 47729 . 48036) (GIT-FILE-DATE 48038
|
||||
. 49085) (GIT-FILE-HISTORY 49087 . 51021) (GIT-PRINT-FILE-HISTORY 51023 . 52075) (GIT-FETCH 52077 .
|
||||
52249)) (52281 64233 (GIT-BRANCH-DIFF 52291 . 59180) (GIT-COMMIT-DIFFS 59182 . 60073) (
|
||||
GIT-BRANCH-RELATIONS 60075 . 63759) (GIT-MODIFIED 63761 . 64231)) (64278 83045 (GIT-BRANCH-NUM 64288
|
||||
. 64861) (GIT-CHECKOUT 64863 . 66149) (GIT-WHICH-BRANCH 66151 . 66558) (GIT-MAKE-BRANCH 66560 . 69139
|
||||
) (GIT-BRANCHES 69141 . 71738) (GIT-BRANCH-EXISTS? 71740 . 72611) (GIT-PICK-BRANCH 72613 . 73103) (
|
||||
GIT-BRANCH-MENU 73105 . 73994) (GIT-BRANCH-WHENSELECTEDFN 73996 . 75535) (GIT-PULL-REQUESTS 75537 .
|
||||
79422) (GIT-SHORT-BRANCH-NAME 79424 . 79715) (GIT-LONG-NAME 79717 . 80034) (GIT-PRC-BRANCHES 80036 .
|
||||
83043)) (83075 87829 (GIT-MY-CURRENT-BRANCH 83085 . 83455) (GIT-MY-BRANCHP 83457 . 84075) (
|
||||
GIT-MY-NEXT-BRANCH 84077 . 85877) (GIT-MY-BRANCHES 85879 . 87827)) (87875 91959 (GIT-ADD-WORKTREE
|
||||
87885 . 89492) (GIT-REMOVE-WORKTREE 89494 . 90426) (GIT-LIST-WORKTREES 90428 . 91239) (WORKTREEDIR
|
||||
91241 . 91957)) (92007 125045 (GIT-GET-DIFFERENT-FILES 92017 . 98925) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 98927 . 106566) (GIT-WORKING-COMPARE-DIRECTORIES 106568 . 112370) (
|
||||
GIT-COMPARE-WORKTREE 112372 . 116350) (GITCDOBJBUTTONFN 116352 . 120850) (GIT-CD-LABELFN 120852 .
|
||||
121938) (GIT-CD-MENUFN 121940 . 123026) (GIT-WORKING-COMPARE-FILES 123028 . 123648) (
|
||||
GIT-BRANCHES-COMPARE-FILES 123650 . 124814) (GIT-PR-COMPARE 124816 . 125043)) (125115 133446 (CDGITDIR
|
||||
125125 . 125812) (GIT-COMMAND 125814 . 127372) (GITORIGIN 127374 . 128071) (GIT-INITIALS 128073 .
|
||||
128377) (GIT-COMMAND-TO-FILE 128379 . 131864) (GIT-RESULT-TO-LINES 131866 . 132779) (STRIPLOCAL 132781
|
||||
. 133444)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,45 +1,44 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 8-Aug-2021 13:22:31"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;18 22218
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (FNS \8859OUTCHARFN \IBMOUTCHARFN \MACOUTCHARFN)
|
||||
(FILECREATED "22-Feb-2026 12:22:12" {WMEDLEY}<lispusers>ISO8859IO.;22 21861
|
||||
|
||||
previous date%: " 6-Aug-2021 16:12:42"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;17)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS ISO1TOMSTRING MTOISO1STRING)
|
||||
(VARS ISO8859IOCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 2-Feb-2026 23:20:20" {WMEDLEY}<lispusers>ISO8859IO.;20)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT ISO8859IOCOMS)
|
||||
|
||||
(RPAQQ ISO8859IOCOMS
|
||||
(
|
||||
(* ;; "This package defines EXTERNALFORMATS for files that are encoded in either ISO8859/1, the standard IBM extended ascii, or the usual MAC encoding.")
|
||||
(* ;; "This package defines EXTERNALFORMATS for files that are encoded in ISIO8859/1, the standard IBM extended ascii, or the legacy MAC encoding.")
|
||||
|
||||
(COMS (* ; "ISO8859/1")
|
||||
(FNS \8859OUTCHARFN \8859INCCODEFN \8859PEEKCCODEFN)
|
||||
(GLOBALVARS *XEROXTOISO8859MAP* *ISO8859TOXEROXMAP*)
|
||||
(FNS MAKEISOFORMAT)
|
||||
(P (MAKEISOFORMAT)))
|
||||
(COMS (* ; "IBM-PC Extended Ascii")
|
||||
[COMS (* ; "ISO8859/1")
|
||||
(FNS ISO1TOMCODE MTOISO1CODE \CREATE.ISO1.FORMAT)
|
||||
(FNS ISO1TOMSTRING MTOISO1STRING)
|
||||
(VARS ISO1TOMCCS)
|
||||
(GLOBALVARS ISO1TOMCCS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.ISO1.FORMAT]
|
||||
(COMS (* ; "IBM-PC Extended Ascii")
|
||||
(FNS \IBMOUTCHARFN \IBMINCCODEFN \IBMPEEKCCODEFN)
|
||||
(GLOBALVARS *XEROXTOIBMMAP* *IBMTOXEROXMAP*)
|
||||
(FNS MAKEIBMFORMAT)
|
||||
(P (MAKEIBMFORMAT)))
|
||||
(COMS (* ; "Macintosh")
|
||||
(COMS (* ; "Macintosh")
|
||||
(FNS \MACOUTCHARFN \MACINCCODEFN \MACPEEKCCODEFN)
|
||||
(GLOBALVARS *XEROXTOMACMAP* *MACTOXEROXMAP*)
|
||||
(FNS MAKEMACFORMAT)
|
||||
(P (MAKEMACFORMAT)))
|
||||
(COMS (* ; "Independent of char encoding")
|
||||
(COMS (* ; "Independent of char encoding")
|
||||
(FNS \COMMONBACKCCODEFN \MAKERECODEMAP \RECODECCODE))))
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"This package defines EXTERNALFORMATS for files that are encoded in either ISO8859/1, the standard IBM extended ascii, or the usual MAC encoding."
|
||||
"This package defines EXTERNALFORMATS for files that are encoded in ISIO8859/1, the standard IBM extended ascii, or the legacy MAC encoding."
|
||||
)
|
||||
|
||||
|
||||
@@ -49,146 +48,150 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(\8859OUTCHARFN
|
||||
[LAMBDA (STREAM CHARCODE)
|
||||
(DECLARE (GLOBALVARS *XEROXTOISO8859MAP*)) (* ; "Edited 8-Aug-2021 13:21 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 14:34 by ")
|
||||
(* ; "Edited 7-Dec-95 14:32 by ")
|
||||
(ISO1TOMCODE
|
||||
[LAMBDA (ICODE) (* ; "Edited 5-Feb-2026 12:09 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:14 by rmk")
|
||||
(* ; "Edited 7-Sep-2025 22:39 by rmk")
|
||||
(* ; "Edited 3-Sep-2025 10:21 by rmk")
|
||||
(* ; "Edited 7-Aug-2025 09:37 by rmk")
|
||||
|
||||
(* ;; "Converts CHARCODE from internal encoding to ISO8859 before printing.")
|
||||
(* ;; "ISO codes are 8bit, MCODES maybe not. Caller shouldn't pass a fat code.")
|
||||
|
||||
(* ;; "Unconverted codes are left unchanged (no error).")
|
||||
(OR [CAR (find PAIR in ISO1TOMCCS suchthat (EQ ICODE (CADR PAIR]
|
||||
ICODE])
|
||||
|
||||
(* ;; "If any remaining codes are out of charset 0, the streams external format will be used. ")
|
||||
(MTOISO1CODE
|
||||
[LAMBDA (MCODE) (* ; "Edited 5-Feb-2026 12:26 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 22:58 by rmk")
|
||||
(OR (CADR (ASSOC MCODE ISO1TOMCCS))
|
||||
MCODE])
|
||||
|
||||
(IF (EQ CHARCODE (CHARCODE EOL))
|
||||
THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0)
|
||||
(\BOUTEOL STREAM)
|
||||
ELSE (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM)
|
||||
(IPLUS16 1 DATUM))
|
||||
(\BOUT STREAM (IF (IGREATERP CHARCODE 127)
|
||||
THEN
|
||||
|
||||
(* ;; "We know that ISO doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128")
|
||||
|
||||
(\RECODECCODE CHARCODE *XEROXTOISO8859MAP*)
|
||||
ELSE CHARCODE])
|
||||
|
||||
(\8859INCCODEFN
|
||||
[LAMBDA (STRM COUNTP) (* ; "Edited 6-Aug-2021 16:10 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 15:24 by ")
|
||||
(* ; "Edited 7-Dec-95 15:19 by ")
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1))
|
||||
(\RECODECCODE (\BIN STRM)
|
||||
*ISO8859TOXEROXMAP*])
|
||||
|
||||
(\8859PEEKCCODEFN
|
||||
[LAMBDA (STRM NOERROR) (* ; "Edited 5-May-2021 17:44 by rmk:")
|
||||
(* ; "Edited 3-Jan-96 14:21 by ")
|
||||
(* ; "Edited 7-Dec-95 15:51 by ")
|
||||
(* ; "Edited 7-Dec-95 15:19 by ")
|
||||
(\RECODECCODE (\PEEKCCODE STRM NOERROR)
|
||||
*ISO8859TOXEROXMAP*])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *XEROXTOISO8859MAP* *ISO8859TOXEROXMAP*)
|
||||
(\CREATE.ISO1.FORMAT
|
||||
[LAMBDA NIL (* ; "Edited 5-Feb-2026 10:42 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:37 by rmk")
|
||||
(* ; "Edited 1-Feb-2026 11:18 by rmk")
|
||||
(* ; "Edited 5-Aug-2021 22:15 by rmk:")
|
||||
(* ; "Edited 9-Mar-99 17:19 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 16:24 by ")
|
||||
(* ; "Edited 7-Dec-95 16:20 by ")
|
||||
(MAKE-EXTERNALFORMAT :ISO8859/1 [FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(ISO1TOMCODE (\THROUGHIN STREAM COUNTP]
|
||||
[FUNCTION (LAMBDA (STREAM NOERRORFLG)
|
||||
(ISO1TOMCODE (\PEEKBIN STREAM NOERRORFLG]
|
||||
(FUNCTION \THROUGHBACKCCODE)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
NIL NIL (FUNCTION MTOISO1STRING)
|
||||
NIL
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION ISO1TOMSTRING])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(MAKEISOFORMAT
|
||||
[LAMBDA NIL (* ; "Edited 5-Aug-2021 22:15 by rmk:")
|
||||
(* ; "Edited 9-Mar-99 17:19 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 16:24 by ")
|
||||
(* ; "Edited 7-Dec-95 16:20 by ")
|
||||
(LET [(XEROXTOISO '((61217 160)
|
||||
(61291 166)
|
||||
(8994 168)
|
||||
(211 169)
|
||||
(227 170)
|
||||
(61290 172)
|
||||
(61219 173)
|
||||
(210 174)
|
||||
(9086 175)
|
||||
(8999 180)
|
||||
(203 184)
|
||||
(209 185)
|
||||
(235 186)
|
||||
(61729 192)
|
||||
(61730 193)
|
||||
(61731 194)
|
||||
(61732 195)
|
||||
(61735 196)
|
||||
(61736 197)
|
||||
(225 198)
|
||||
(61741 199)
|
||||
(61744 200)
|
||||
(61745 201)
|
||||
(61746 202)
|
||||
(61749 203)
|
||||
(61758 204)
|
||||
(61759 205)
|
||||
(61760 206)
|
||||
(61764 207)
|
||||
(226 208)
|
||||
(61772 209)
|
||||
(61775 210)
|
||||
(61776 211)
|
||||
(61777 212)
|
||||
(61778 213)
|
||||
(61780 214)
|
||||
(180 215)
|
||||
(233 216)
|
||||
(61791 217)
|
||||
(61792 218)
|
||||
(61793 219)
|
||||
(61797 220)
|
||||
(61803 221)
|
||||
(236 222)
|
||||
(251 223)
|
||||
(61857 224)
|
||||
(61858 225)
|
||||
(61859 226)
|
||||
(61860 227)
|
||||
(61863 228)
|
||||
(61864 229)
|
||||
(241 230)
|
||||
(61869 231)
|
||||
(61872 232)
|
||||
(61873 233)
|
||||
(61874 234)
|
||||
(61877 235)
|
||||
(61886 236)
|
||||
(61887 237)
|
||||
(61888 238)
|
||||
(61892 239)
|
||||
(243 240)
|
||||
(61900 241)
|
||||
(61903 242)
|
||||
(61904 243)
|
||||
(61905 244)
|
||||
(61906 245)
|
||||
(61908 246)
|
||||
(184 247)
|
||||
(249 248)
|
||||
(61919 249)
|
||||
(61920 250)
|
||||
(61921 251)
|
||||
(61925 252)
|
||||
(61931 253)
|
||||
(252 254)
|
||||
(61933 255)
|
||||
(61805 376]
|
||||
(SETQ *XEROXTOISO8859MAP* (\MAKERECODEMAP XEROXTOISO))
|
||||
(SETQ *ISO8859TOXEROXMAP* (\MAKERECODEMAP XEROXTOISO T)))
|
||||
(MAKE-EXTERNALFORMAT :ISO8859/1 (FUNCTION \8859INCCODEFN)
|
||||
(FUNCTION \8859PEEKCCODEFN)
|
||||
(FUNCTION \COMMONBACKCCODEFN)
|
||||
(FUNCTION \8859OUTCHARFN])
|
||||
(ISO1TOMSTRING
|
||||
[LAMBDA (ISTRING DESTRUCTIVE) (* ; "Edited 22-Feb-2026 12:21 by rmk")
|
||||
(* ; "Edited 5-Feb-2026 11:01 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:46 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 12:14 by rmk")
|
||||
(* ; "Edited 29-Apr-2025 13:08 by rmk")
|
||||
|
||||
(* ;; "Converts ISO8859/1 codes to MCCS codes in MSTRING.")
|
||||
|
||||
(for I ICODE (MSTRING _ (CL:IF DESTRUCTIVE
|
||||
ISTRING
|
||||
(CONCAT ISTRING))) from 1 while (SETQ ICODE (NTHCHARCODE ISTRING I))
|
||||
do (RPLCHARCODE MSTRING I (ISO1TOMCODE ICODE)) finally (RETURN MSTRING])
|
||||
|
||||
(MTOISO1STRING
|
||||
[LAMBDA (MSTRING DESTRUCTIVE) (* ; "Edited 22-Feb-2026 12:22 by rmk")
|
||||
(* ; "Edited 2-Feb-2026 23:47 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 12:22 by rmk")
|
||||
(* ; "Edited 29-Apr-2025 13:08 by rmk")
|
||||
|
||||
(* ;; "Converts MCCS to ISO8859/1 codes in MSTRING.")
|
||||
|
||||
(for I MCODE (ISTRING _ (CL:IF DESTRUCTIVE
|
||||
MSTRING
|
||||
(CONCAT MSTRING))) from 1 while (SETQ MCODE (NTHCHARCODE MSTRING I))
|
||||
do (RPLCHARCODE ISTRING I (MTOISO1CODE MCODE)) finally (RETURN ISTRING])
|
||||
)
|
||||
|
||||
(MAKEISOFORMAT)
|
||||
(RPAQQ ISO1TOMCCS
|
||||
((94 8593)
|
||||
(95 8592)
|
||||
(169 8216)
|
||||
(170 8220)
|
||||
(172 95)
|
||||
(173 94)
|
||||
(174 8594)
|
||||
(175 8595)
|
||||
(180 215)
|
||||
(184 247)
|
||||
(185 8217)
|
||||
(186 8221)
|
||||
(193 768)
|
||||
(194 769)
|
||||
(195 770)
|
||||
(196 771)
|
||||
(197 772)
|
||||
(198 774)
|
||||
(199 775)
|
||||
(200 776)
|
||||
(202 778)
|
||||
(203 807)
|
||||
(204 818)
|
||||
(205 779)
|
||||
(206 808)
|
||||
(207 780)
|
||||
(208 8213)
|
||||
(209 185)
|
||||
(210 174)
|
||||
(211 169)
|
||||
(212 8482)
|
||||
(213 9834)
|
||||
(220 8539)
|
||||
(221 8540)
|
||||
(222 8541)
|
||||
(223 8542)
|
||||
(224 8486)
|
||||
(225 198)
|
||||
(226 208)
|
||||
(227 170)
|
||||
(228 294)
|
||||
(229 567)
|
||||
(230 306)
|
||||
(231 319)
|
||||
(232 321)
|
||||
(233 216)
|
||||
(234 338)
|
||||
(235 186)
|
||||
(236 222)
|
||||
(237 358)
|
||||
(238 330)
|
||||
(239 329)
|
||||
(240 312)
|
||||
(241 230)
|
||||
(242 273)
|
||||
(243 240)
|
||||
(244 295)
|
||||
(245 305)
|
||||
(246 307)
|
||||
(247 320)
|
||||
(248 322)
|
||||
(249 248)
|
||||
(250 339)
|
||||
(251 223)
|
||||
(252 254)
|
||||
(253 359)
|
||||
(254 331)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS ISO1TOMCCS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(\CREATE.ISO1.FORMAT)
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -515,26 +518,28 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
(\COMMONBACKCCODEFN
|
||||
[LAMBDA (STRM COUNTP) (* ; "Edited 6-Aug-2021 16:12 by rmk:")
|
||||
(* ; "Edited 8-Dec-95 13:26 by ")
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN (\BACKFILEPTR STRM)
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
|
||||
T)])
|
||||
|
||||
(\MAKERECODEMAP
|
||||
[LAMBDA (CODEMAP INVERTED) (* ; "Edited 1-Feb-2026 13:03 by rmk")
|
||||
(* ; "Edited 9-Mar-99 17:23 by rmk:")
|
||||
|
||||
(* ;; "Produces a map array for use by \RECODECCODE. The map array is a 256-array of either NIL or 256-arrays, so that space isn't allocated for widely separated codes.")
|
||||
|
||||
(DECLARE (USEDFREE FASTRECODEMAPCACHE))
|
||||
(CL:WHEN INVERTED
|
||||
[SETQ CODEMAP (FOR C IN CODEMAP COLLECT (LIST (CADR C)
|
||||
(CAR C])
|
||||
(FOR M (MAPARRAY _ (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
|
||||
CSMAP IN CODEMAP UNLESS (EQ (CAR M)
|
||||
(CADR M))
|
||||
DO (CL:UNLESS (SETQ CSMAP (CL:SVREF MAPARRAY (LRSH (CAR M)
|
||||
8)))
|
||||
(SETQ CSMAP (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
|
||||
|
||||
(* ;; "Produces a map array for use by \RECODECCODE. The map array is a 256-array of either NIL or 256-arrays, so that space isn't allocated for widely separated codes.")
|
||||
|
||||
(DECLARE (USEDFREE FASTRECODEMAPCACHE))
|
||||
(CL:WHEN INVERTED
|
||||
[SETQ CODEMAP (FOR C IN CODEMAP COLLECT (LIST (CADR C)
|
||||
(CAR C])
|
||||
(FOR M LEFT RIGHT (MAPARRAY ¬ (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
|
||||
CSMAP IN CODEMAP eachtime (SETQ LEFT (CAR M))
|
||||
(SETQ RIGHT (CADR M))
|
||||
(CL:UNLESS (CHARCODEP LEFT)
|
||||
(SETQ LEFT (CHARCODE.DECODE LEFT)))
|
||||
(CL:UNLESS (CHARCODEP RIGHT)
|
||||
(SETQ RIGHT (CHARCODE.DECODE RIGHT)))
|
||||
UNLESS (EQ LEFT RIGHT) DO (CL:UNLESS (SETQ CSMAP (CL:SVREF MAPARRAY (LRSH LEFT 8)))
|
||||
(SETQ CSMAP (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
|
||||
(CL:SETF (CL:SVREF MAPARRAY (LRSH LEFT 8))
|
||||
@@ -546,12 +551,11 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
[LAMBDA (CODE MAPARRAY) (* ; "Edited 9-Mar-99 17:28 by rmk:")
|
||||
(* ; "Edited 21-Jun-95 10:18 by rmk:")
|
||||
|
||||
(* ;; "Recodes a singleton charcode. Leaves everything else unchanged.")
|
||||
(* ;; "Recodes a singleton charcode. Leaves everything else unchanged.")
|
||||
(LET [(CSMAP (CL:SVREF MAPARRAY (LRSH CODE 8]
|
||||
(OR (AND CSMAP (CL:SVREF CSMAP (LOGAND CODE 255)))
|
||||
CODE])
|
||||
)
|
||||
(PUTPROPS ISO8859IO COPYRIGHT ("Xerox Corporation" 1995 1996 1997 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
|
||||
(LET [(CSMAP (CL:SVREF MAPARRAY (LRSH CODE 8]
|
||||
(OR (AND CSMAP (CL:SVREF CSMAP (LOGAND CODE 255)))
|
||||
CODE])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1834 4154 (ISO1TOMCODE 1844 . 2593) (MTOISO1CODE 2595 . 2885) (\CREATE.ISO1.FORMAT 2887
|
||||
|
||||
Binary file not shown.
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -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
BIN
lispusers/UNBOXEDOPS.DFASL
Normal file
Binary file not shown.
@@ -1,22 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED "27-Jan-2025 08:49:34" {WMEDLEY}<lispusers>VERSIONDEFS.;12 5880
|
||||
(FILECREATED " 7-Mar-2026 22:55:43" {WMEDLEY}<lispusers>VERSIONDEFS.;18 6534
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GETVINFO)
|
||||
|
||||
:PREVIOUS-DATE "12-Dec-2024 15:07:45" {WMEDLEY}<lispusers>VERSIONDEFS.;11)
|
||||
:PREVIOUS-DATE " 6-Mar-2026 22:47:25" {WMEDLEY}<lispusers>VERSIONDEFS.;17)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT VERSIONDEFSCOMS)
|
||||
|
||||
(RPAQQ VERSIONDEFSCOMS [(FNS FINDFILEVERSION GETVINFO VERSIONP)
|
||||
(FNS EDV DFV)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA DFV EDV)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(RPAQQ VERSIONDEFSCOMS
|
||||
[(FNS FINDFILEVERSION GETVINFO VERSIONP)
|
||||
(FNS EDV DFV)
|
||||
(PROP ARGNAMES EDV DFV)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA DFV EDV)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(DEFINEQ
|
||||
|
||||
(FINDFILEVERSION
|
||||
@@ -119,16 +118,26 @@
|
||||
(CAR VINFO])
|
||||
|
||||
(DFV
|
||||
[NLAMBDA ARGS (* ; "Edited 6-Dec-2024 21:29 by rmk")
|
||||
[NLAMBDA ARGS (* ; "Edited 6-Mar-2026 22:42 by rmk")
|
||||
(* ; "Edited 6-Dec-2024 21:29 by rmk")
|
||||
(* ; "Edited 2-Dec-2024 00:08 by rmk")
|
||||
(SETQ ARGS (MKLIST ARGS))
|
||||
(APPLY (FUNCTION EDV)
|
||||
(LIST (POP ARGS)
|
||||
NIL
|
||||
(POP ARGS)
|
||||
(POP ARGS)
|
||||
(POP ARGS])
|
||||
(LET ((NAME (POP ARGS))) (* ; "If FNS and FUNCTIONS, show both")
|
||||
(CL:WHEN (HASDEF NAME 'FUNCTIONS '?)
|
||||
(APPLY (FUNCTION EDV)
|
||||
(LIST NAME 'FUNCTIONS (POP ARGS)
|
||||
(POP ARGS)
|
||||
(POP ARGS))))
|
||||
(CL:WHEN (HASDEF NAME 'FNS '?)
|
||||
(APPLY (FUNCTION EDV)
|
||||
(LIST NAME 'FNS (POP ARGS)
|
||||
(POP ARGS)
|
||||
(POP ARGS))))])
|
||||
)
|
||||
|
||||
(PUTPROPS EDV ARGNAMES (NAME TYPE FILE VERSION DIRLST . VINFO))
|
||||
|
||||
(PUTPROPS DFV ARGNAMES (NAME FILE VERSION DIRLST . VINFO))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA DFV EDV)
|
||||
@@ -138,6 +147,6 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (671 4570 (FINDFILEVERSION 681 . 2128) (GETVINFO 2130 . 4253) (VERSIONP 4255 . 4568)) (
|
||||
4571 5717 (EDV 4581 . 5281) (DFV 5283 . 5715)))))
|
||||
(FILEMAP (NIL (706 4605 (FINDFILEVERSION 716 . 2163) (GETVINFO 2165 . 4288) (VERSIONP 4290 . 4603)) (
|
||||
4606 6230 (EDV 4616 . 5316) (DFV 5318 . 6228)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user