Compare commits
18 Commits
medley-221
...
medley-221
| Author | SHA1 | Date | |
|---|---|---|---|
|
17dd03a358 | ||
|
382881a068 | ||
|
|
d0d952a10d | ||
|
|
d5d21397d4 | ||
|
|
7a4470ce8b | ||
|
|
32ff7b7649 | ||
|
|
096d860ac8 | ||
|
|
418b1df00d | ||
|
ba90344080 | ||
|
0eac6efb61 | ||
|
|
540aff091c | ||
|
|
3f244f6cd3 | ||
|
|
58557d383a | ||
|
|
882fbacf59 | ||
|
|
70ce516e0c | ||
|
|
fdb573c761 | ||
|
|
06368f95eb | ||
|
|
654ebc359c |
1
.gitignore
vendored
1
.gitignore
vendored
@@ -36,3 +36,4 @@ core
|
||||
|
||||
# Mac OS detritus
|
||||
.DS_Store
|
||||
*.PS
|
||||
|
||||
@@ -1,22 +1,20 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "15-Jan-2022 20:17:21" |{DSK}<home>larry>medley>library>MSCOMMON.;4| 24053
|
||||
(FILECREATED " 2-Nov-2022 10:13:59" |{DSK}<home>larry>ilisp>medley>library>MSCOMMON.;3| 23999
|
||||
|
||||
:CHANGES-TO (TEMPLATES ADD-EXEC CL:ASSOC CL:COMPILE-FILE EXEC CL:IN-PACKAGE CL:MAKE-STRING OPEN
|
||||
CL:PUSH CL:PUSHNEW CL:RASSOC CL:WRITE-LINE CL:WRITE-STRING CL:WHEN CL:UNLESS
|
||||
)
|
||||
(FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
|
||||
(VARS MSCOMMONCOMS)
|
||||
:CHANGES-TO (VARS MSCOMMONCOMS)
|
||||
(TEMPLATES CL:UNLESS CL:WHEN)
|
||||
|
||||
:PREVIOUS-DATE " 4-May-92 13:10:53" |{DSK}<home>larry>medley>library>MSCOMMON.;3|)
|
||||
:PREVIOUS-DATE "15-Jan-2022 20:17:21" |{DSK}<home>larry>ilisp>medley>library>MSCOMMON.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation.
|
||||
; Copyright (c) 1988, 1990, 1992, 2022 by Venue & Xerox Corporation.
|
||||
|
||||
(PRETTYCOMPRINT MSCOMMONCOMS)
|
||||
|
||||
(RPAQQ MSCOMMONCOMS
|
||||
((PROP FILETYPE MSCOMMON)
|
||||
(DECLARE\: EVAL@COMPILE (GLOBALVARS USERTEMPLATES MSTEMPLATES))
|
||||
(FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
|
||||
|
||||
(* |;;| "Templates for CL stuff that need them.")
|
||||
@@ -89,6 +87,12 @@
|
||||
(CLRHASH USERTEMPLATES))))
|
||||
|
||||
(PUTPROPS MSCOMMON FILETYPE :COMPILE-FILE)
|
||||
(DECLARE\: EVAL@COMPILE
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS USERTEMPLATES MSTEMPLATES)
|
||||
)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(FUNCTIONSMSGETDEF
|
||||
@@ -470,13 +474,13 @@
|
||||
|
||||
(SETTEMPLATE 'CL:UNION '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
|
||||
|
||||
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFECT RETURN))
|
||||
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFFECT RETURN))
|
||||
|
||||
(SETTEMPLATE 'CL:VECTOR-PUSH '(EVAL SMASH))
|
||||
|
||||
(SETTEMPLATE 'CL:VECTOR-PUSH-EXTEND '(EVAL SMASH EVAL))
|
||||
|
||||
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFECT RETURN))
|
||||
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFFECT RETURN))
|
||||
|
||||
(SETTEMPLATE 'WRITE '(EVAL KEYWORDS :STREAM :ESCAPE :RADIX :BASE :CIRCLE :PRETTY :LEVEL :LENGTH :CASE
|
||||
:GENSYM :ARRAY))
|
||||
@@ -552,8 +556,8 @@
|
||||
(PUTHASH KEY VAL MSTEMPLATES)))
|
||||
|
||||
(CLRHASH USERTEMPLATES)
|
||||
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992))
|
||||
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992 2022))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (5280 7291 (FUNCTIONSMSGETDEF 5290 . 6258) (FUNCTIONSMSMC 6260 . 6731) (
|
||||
VARIABLESMSGETDEF 6733 . 7289)))))
|
||||
(FILEMAP (NIL (5219 7230 (FUNCTIONSMSGETDEF 5229 . 6197) (FUNCTIONSMSMC 6199 . 6670) (
|
||||
VARIABLESMSGETDEF 6672 . 7228)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Jul-2022 10:42:46"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNIXCOMM.;6 20326
|
||||
(FILECREATED " 8-Oct-2022 16:06:36" {DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;2 20352
|
||||
|
||||
:CHANGES-TO (FNS INITIALIZE-NEW-SHELL-DEVICE)
|
||||
:CHANGES-TO (FNS CREATE-PROCESS-STREAM)
|
||||
|
||||
:PREVIOUS-DATE " 3-Jul-2022 16:16:31"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNIXCOMM.;5)
|
||||
:PREVIOUS-DATE " 7-Jul-2022 10:42:46"
|
||||
{DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -133,6 +132,8 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(CREATE-PROCESS-STREAM
|
||||
[LAMBDA (COMM)
|
||||
|
||||
(* ;; "Edited 8-Oct-2022 16:04 by lmm")
|
||||
|
||||
(* ;; "Edited 3-Jul-2022 16:04 by rmk: Removed external format here, the device has the environmental defaultg")
|
||||
|
||||
(* ;; "Edited 26-Jun-2022 13:52 by larry")
|
||||
@@ -141,7 +142,7 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
|
||||
(* ;; "Edited 21-May-90 15:39 by jrb:")
|
||||
|
||||
(LET* ((SHELL-DEV (if (AND (BOUNDP '*NEW-SHELL-DEVICE)
|
||||
(LET* ((SHELL-DEV (if (AND (BOUNDP '*NEW-SHELL-DEVICE*)
|
||||
(SUBRCALL UNIX-HANDLECOMM 8))
|
||||
then (* ;
|
||||
"SUBRCALL tests that this is supported")
|
||||
@@ -455,12 +456,12 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(PUTPROPS UNIXCOMM FILETYPE FAKE-COMPILE-FILE)
|
||||
(PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2492 8463 (FORK-SHELL 2502 . 3699) (FORK-UNIX 3701 . 3877) (UNIX-KILL 3879 . 4068) (
|
||||
UNIX-WRITE 4070 . 4781) (CREATE-SHELL-STREAM 4783 . 6099) (CREATE-PROCESS-STREAM 6101 . 7560) (
|
||||
UNIXCOMM-AROUNDEXITFN 7562 . 8461)) (8511 13805 (INITIALIZE-NEW-SHELL-DEVICE 8521 . 9920) (
|
||||
UNIX-GET-NEXT-BUFFER 9922 . 12122) (UNIX-BACKFILEPTR-NEW 12124 . 12603) (UNIX-STREAM-EOFP-NEW 12605 .
|
||||
13151) (UNIX-STREAM-OUT 13153 . 13409) (UNIX-STREAM-CLOSE 13411 . 13803)) (14061 15926 (
|
||||
CREATE-UNIX-SOCKET-STREAM 14071 . 14932) (ACCEPT-UNIX-SOCKET-STREAM 14934 . 15924)) (16275 19735 (
|
||||
UNIX-BACKFILEPTR 16285 . 16783) (UNIX-READ 16785 . 17307) (INITIALIZE-SHELL-DEVICE 17309 . 18329) (
|
||||
UNIX-STREAM-IN 18331 . 18707) (UNIX-STREAM-EOFP 18709 . 19483) (UNIX-STREAM-PEEK 19485 . 19733)))))
|
||||
(FILEMAP (NIL (2467 8489 (FORK-SHELL 2477 . 3674) (FORK-UNIX 3676 . 3852) (UNIX-KILL 3854 . 4043) (
|
||||
UNIX-WRITE 4045 . 4756) (CREATE-SHELL-STREAM 4758 . 6074) (CREATE-PROCESS-STREAM 6076 . 7586) (
|
||||
UNIXCOMM-AROUNDEXITFN 7588 . 8487)) (8537 13831 (INITIALIZE-NEW-SHELL-DEVICE 8547 . 9946) (
|
||||
UNIX-GET-NEXT-BUFFER 9948 . 12148) (UNIX-BACKFILEPTR-NEW 12150 . 12629) (UNIX-STREAM-EOFP-NEW 12631 .
|
||||
13177) (UNIX-STREAM-OUT 13179 . 13435) (UNIX-STREAM-CLOSE 13437 . 13829)) (14087 15952 (
|
||||
CREATE-UNIX-SOCKET-STREAM 14097 . 14958) (ACCEPT-UNIX-SOCKET-STREAM 14960 . 15950)) (16301 19761 (
|
||||
UNIX-BACKFILEPTR 16311 . 16809) (UNIX-READ 16811 . 17333) (INITIALIZE-SHELL-DEVICE 17335 . 18355) (
|
||||
UNIX-STREAM-IN 18357 . 18733) (UNIX-STREAM-EOFP 18735 . 19509) (UNIX-STREAM-PEEK 19511 . 19759)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,18 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Feb-2022 12:04:09"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITESEND.;2 100778
|
||||
(FILECREATED "16-Oct-2022 10:02:19" {DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;2 100794
|
||||
|
||||
:CHANGES-TO (FILES LAFITEDECLS)
|
||||
(FNS \SENDMESSAGE.RESTARTABLE \SENDMESSAGE LAFITE.SENDMESSAGE MAKEXXXSUPPORTFORM
|
||||
MAKENEWMESSAGEFORM MAKEANSWERFORM LAFITE.FILL.IN.ANSWER.FORM MAKEFORWARDFORM)
|
||||
:CHANGES-TO (FNS \SENDMESSAGE.RESTARTABLE)
|
||||
|
||||
:PREVIOUS-DATE "30-Sep-2021 22:58:58"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITESEND.;1)
|
||||
:PREVIOUS-DATE " 7-Feb-2022 12:04:09"
|
||||
{DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation.
|
||||
Copyright (c) 1984-1990, 1993, 1999-2000, 2021-2022 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LAFITESENDCOMS)
|
||||
@@ -529,7 +526,8 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation.
|
||||
(RETURN (\SENDMESSAGE.RESTARTABLE FORM TEDITPROPS NIL FORMNAME])
|
||||
|
||||
(\SENDMESSAGE.RESTARTABLE
|
||||
[LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME) (* ; "Edited 7-Feb-2022 11:50 by rmk")
|
||||
[LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME) (* ; "Edited 16-Oct-2022 09:59 by briggs")
|
||||
(* ; "Edited 7-Feb-2022 11:50 by rmk")
|
||||
(* ; "Edited 3-Nov-89 15:06 by bvm")
|
||||
(bind (CURRENTMESSAGE _ FORM)
|
||||
(FIRSTTIME _ T)
|
||||
@@ -558,7 +556,9 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation.
|
||||
EDITORWINDOW))
|
||||
(push LAFITECURRENTEDITORWINDOWS EDITORWINDOW)
|
||||
(SETQ FIRSTTIME)))
|
||||
[SETQ EDITORRESULT (TEDIT (OPENSTRINGSTREAM FORM)
|
||||
[SETQ EDITORRESULT (TEDIT (CL:IF (STRINGP FORM)
|
||||
(OPENSTRINGSTREAM FORM)
|
||||
FORM)
|
||||
EDITORWINDOW T (APPEND TEDITPROPS (LIST 'FONT LAFITEEDITORFONT]
|
||||
(COND
|
||||
((TTY.PROCESSP) (* ; "give back the keyboard")
|
||||
@@ -1764,31 +1764,31 @@ cc: ~A
|
||||
)
|
||||
)
|
||||
(PUTPROPS LAFITESEND COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1993 1999 2000
|
||||
2021))
|
||||
2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5539 28516 (DOLAFITESENDINGCOMMAND 5549 . 6039) (\SENDMESSAGE.INITIATE 6041 . 7980) (
|
||||
\SENDMSG.DELIVER 7982 . 8590) (\SENDMSG.EXIT.TEDIT 8592 . 8963) (\SENDMSG.SAVE.FORM 8965 . 10952) (
|
||||
\LAFITE.HEADER.EOF 10954 . 11247) (\LAFITE.INSERT.REPLYTO 11249 . 11857) (\SENDMSG.REPLYTO 11859 .
|
||||
12418) (\SENDMSG.CHANGE.MODE 12420 . 17996) (\SENDMSG.FIND.FIELD 17998 . 18508) (\SENDMESSAGE.PARSE
|
||||
18510 . 19306) (\LAFITE.PREPARE.SEND 19308 . 22141) (\LAFITE.PREPARE.ERROR 22143 . 23325) (
|
||||
\LAFITE.CHOOSE.MSG.FORMAT 23327 . 25968) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25970 . 26895) (
|
||||
\SENDMESSAGE.MENUPROMPT 26897 . 27760) (\SENDMESSAGE.PROMPT 27762 . 28298) (\SENDMESSAGEFAIL 28300 .
|
||||
28514)) (28517 52962 (\SENDMESSAGE 28527 . 29879) (\SENDMESSAGE.RESTARTABLE 29881 . 34865) (
|
||||
\SENDMESSAGE.CLEANUP 34867 . 35083) (\SENDMESSAGE.MAKEWINDOW 35085 . 41258) (MAKELAFITEDELIVERMENU
|
||||
41260 . 41567) (\LAFITE.CLOSEMSG? 41569 . 42519) (\LAFITE.AFTER.DELIVER 42521 . 45840) (
|
||||
\LAFITE.UNSENT.ICON 45842 . 46152) (\LAFITE.FETCH.SUBJECT 46154 . 46954) (LAFITE.SENDMESSAGE 46956 .
|
||||
47849) (\SENDMESSAGE0 47851 . 50715) (LA.ASSURE.PROMPT.WINDOW 50717 . 51614) (\LAFITE.SEND.FAIL 51616
|
||||
. 52087) (\LAFITE.INVALID.RECIPIENTS 52089 . 52547) (\SENDMESSAGE.ABORT 52549 . 52960)) (52994 62907
|
||||
(\OUTBOX.CREATE 53004 . 54467) (\OUTBOX.RESET 54469 . 54962) (\OUTBOX.CLOSEFN 54964 . 55104) (
|
||||
\OUTBOX.REPAINTFN 55106 . 55769) (\OUTBOX.RESHAPEFN 55771 . 57054) (\OUTBOX.SHADEITEM 57056 . 57729) (
|
||||
\OUTBOX.BUTTONFN 57731 . 60579) (\OUTBOX.DISPLAYLINE 60581 . 61075) (\OUTBOX.ADD.ITEM 61077 . 62905))
|
||||
(63203 79611 (\LAFITE.MESSAGEFORM 63213 . 67556) (MAKELAFITESUPPORTFORM 67558 . 67747) (
|
||||
MAKELISPSUPPORTFORM 67749 . 67915) (MAKEXXXSUPPORTFORM 67917 . 71966) (MAKENEWMESSAGEFORM 71968 .
|
||||
72924) (MAKELAFITEPRIVATEFORMSITEMS 72926 . 73354) (\LAFITE.UNCACHE.MESSAGEFORM 73356 . 73809) (
|
||||
\LAFITE.DELETE.MESSAGEFORM 73811 . 74412) (\LAFITE.SELECT.FORM 74414 . 74769) (
|
||||
\LAFITE.DELETE.FORM.INTERNAL 74771 . 75915) (\LAFITE.READ.FORM 75917 . 78654) (\LAFITE.FIND.TEMPLATE
|
||||
78656 . 79609)) (79635 87366 (\LAFITE.ANSWER 79645 . 80050) (\LAFITE.ANSWER.PROC 80052 . 81946) (
|
||||
MAKEANSWERFORM 81948 . 84478) (LA.PRINT.COMMA.LIST 84480 . 84966) (LAFITE.FILL.IN.ANSWER.FORM 84968 .
|
||||
87364)) (87391 93587 (\LAFITE.FORWARD 87401 . 87809) (\LAFITE.FORWARD.PROC 87811 . 89800) (
|
||||
MAKEFORWARDFORM 89802 . 93585)))))
|
||||
(FILEMAP (NIL (5333 28310 (DOLAFITESENDINGCOMMAND 5343 . 5833) (\SENDMESSAGE.INITIATE 5835 . 7774) (
|
||||
\SENDMSG.DELIVER 7776 . 8384) (\SENDMSG.EXIT.TEDIT 8386 . 8757) (\SENDMSG.SAVE.FORM 8759 . 10746) (
|
||||
\LAFITE.HEADER.EOF 10748 . 11041) (\LAFITE.INSERT.REPLYTO 11043 . 11651) (\SENDMSG.REPLYTO 11653 .
|
||||
12212) (\SENDMSG.CHANGE.MODE 12214 . 17790) (\SENDMSG.FIND.FIELD 17792 . 18302) (\SENDMESSAGE.PARSE
|
||||
18304 . 19100) (\LAFITE.PREPARE.SEND 19102 . 21935) (\LAFITE.PREPARE.ERROR 21937 . 23119) (
|
||||
\LAFITE.CHOOSE.MSG.FORMAT 23121 . 25762) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25764 . 26689) (
|
||||
\SENDMESSAGE.MENUPROMPT 26691 . 27554) (\SENDMESSAGE.PROMPT 27556 . 28092) (\SENDMESSAGEFAIL 28094 .
|
||||
28308)) (28311 52973 (\SENDMESSAGE 28321 . 29673) (\SENDMESSAGE.RESTARTABLE 29675 . 34876) (
|
||||
\SENDMESSAGE.CLEANUP 34878 . 35094) (\SENDMESSAGE.MAKEWINDOW 35096 . 41269) (MAKELAFITEDELIVERMENU
|
||||
41271 . 41578) (\LAFITE.CLOSEMSG? 41580 . 42530) (\LAFITE.AFTER.DELIVER 42532 . 45851) (
|
||||
\LAFITE.UNSENT.ICON 45853 . 46163) (\LAFITE.FETCH.SUBJECT 46165 . 46965) (LAFITE.SENDMESSAGE 46967 .
|
||||
47860) (\SENDMESSAGE0 47862 . 50726) (LA.ASSURE.PROMPT.WINDOW 50728 . 51625) (\LAFITE.SEND.FAIL 51627
|
||||
. 52098) (\LAFITE.INVALID.RECIPIENTS 52100 . 52558) (\SENDMESSAGE.ABORT 52560 . 52971)) (53005 62918
|
||||
(\OUTBOX.CREATE 53015 . 54478) (\OUTBOX.RESET 54480 . 54973) (\OUTBOX.CLOSEFN 54975 . 55115) (
|
||||
\OUTBOX.REPAINTFN 55117 . 55780) (\OUTBOX.RESHAPEFN 55782 . 57065) (\OUTBOX.SHADEITEM 57067 . 57740) (
|
||||
\OUTBOX.BUTTONFN 57742 . 60590) (\OUTBOX.DISPLAYLINE 60592 . 61086) (\OUTBOX.ADD.ITEM 61088 . 62916))
|
||||
(63214 79622 (\LAFITE.MESSAGEFORM 63224 . 67567) (MAKELAFITESUPPORTFORM 67569 . 67758) (
|
||||
MAKELISPSUPPORTFORM 67760 . 67926) (MAKEXXXSUPPORTFORM 67928 . 71977) (MAKENEWMESSAGEFORM 71979 .
|
||||
72935) (MAKELAFITEPRIVATEFORMSITEMS 72937 . 73365) (\LAFITE.UNCACHE.MESSAGEFORM 73367 . 73820) (
|
||||
\LAFITE.DELETE.MESSAGEFORM 73822 . 74423) (\LAFITE.SELECT.FORM 74425 . 74780) (
|
||||
\LAFITE.DELETE.FORM.INTERNAL 74782 . 75926) (\LAFITE.READ.FORM 75928 . 78665) (\LAFITE.FIND.TEMPLATE
|
||||
78667 . 79620)) (79646 87377 (\LAFITE.ANSWER 79656 . 80061) (\LAFITE.ANSWER.PROC 80063 . 81957) (
|
||||
MAKEANSWERFORM 81959 . 84489) (LA.PRINT.COMMA.LIST 84491 . 84977) (LAFITE.FILL.IN.ANSWER.FORM 84979 .
|
||||
87375)) (87402 93598 (\LAFITE.FORWARD 87412 . 87820) (\LAFITE.FORWARD.PROC 87822 . 89811) (
|
||||
MAKEFORWARDFORM 89813 . 93596)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1022
lispusers/HELPSYS
1022
lispusers/HELPSYS
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Mar-2022 23:20:21"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;40 30674
|
||||
(FILECREATED " 7-Oct-2022 21:45:29"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>MODERNIZE.;43 30755
|
||||
|
||||
:CHANGES-TO (FNS MODERNWINDOW.BUTTONEVENTFN)
|
||||
:CHANGES-TO (FNS MODERNWINDOW)
|
||||
|
||||
:PREVIOUS-DATE "25-Dec-2021 22:27:41"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;39)
|
||||
:PREVIOUS-DATE " 5-Mar-2022 23:20:21"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>MODERNIZE.;40)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MODERNIZECOMS)
|
||||
@@ -104,11 +104,12 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MODERNWINDOW
|
||||
[LAMBDA (WINDOW ANYWHERE TITLEPROPORTION) (* ; "Edited 8-Jul-2021 23:33 by rmk:")
|
||||
(* ; "Edited 3-Jul-2021 10:31 by rmk:")
|
||||
(* ; "Edited 24-Jun-2021 14:52 by rmk:")
|
||||
[LAMBDA (WINDOW ANYWHERE TITLEPROPORTION) (* ; "Edited 7-Oct-2022 21:45 by rmk")
|
||||
(* ; "Edited 8-Jul-2021 23:33 by rmk:")
|
||||
(* ; "Edited 3-Jul-2021 10:31 by rmk:")
|
||||
(* ; "Edited 24-Jun-2021 14:52 by rmk:")
|
||||
|
||||
(* ;; "This can be applied to windows that have been created with an unknown or unmodifiable buttoneventfn. If the window was previously modernized, we restore its original state first, in case it is called here with different parameters")
|
||||
(* ;; "This can be applied to windows that have been created with an unknown or unmodifiable buttoneventfn. If the window was previously modernized, we restore its original state first, in case it is called here with different parameters")
|
||||
|
||||
(CL:WHEN (AND TITLEPROPORTION (GREATERP TITLEPROPORTION 0.5))
|
||||
(ERROR "TITLEPROPORTION cannot be greater than .5"))
|
||||
@@ -117,9 +118,9 @@
|
||||
(WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN NIL))
|
||||
(WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN (WINDOWPROP WINDOW 'BUTTONEVENTFN))
|
||||
(WINDOWPROP WINDOW 'BUTTONEVENTFN (IF (OR ANYWHERE TITLEPROPORTION)
|
||||
THEN [FUNCTION (LAMBDA (WINDOW)
|
||||
(MODERNWINDOW.BUTTONEVENTFN
|
||||
WINDOW NIL T ,TITLEPROPORTION]
|
||||
THEN `[LAMBDA (WINDOW)
|
||||
(MODERNWINDOW.BUTTONEVENTFN WINDOW NIL T
|
||||
',TITLEPROPORTION]
|
||||
ELSE (FUNCTION MODERNWINDOW.BUTTONEVENTFN)))
|
||||
WINDOW])
|
||||
|
||||
@@ -613,12 +614,12 @@
|
||||
(ADDTOVAR LAMA MODERN-ADD-EXEC)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5129 11406 (MODERNWINDOW 5139 . 6594) (MODERNWINDOW.SETUP 6596 . 9545) (UNMODERNWINDOW
|
||||
9547 . 9941) (MODERNWINDOW.UNSETUP 9943 . 10755) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10757 . 11404)) (
|
||||
11471 21633 (MODERNWINDOW.BUTTONEVENTFN 11481 . 18508) (NEARTOP 18510 . 19438) (NEARESTCORNER 19440 .
|
||||
20319) (INCORNER.REGION 20321 . 21631)) (21691 24163 (MODERN-ADD-EXEC 21701 . 22132) (MODERN-SNAPW
|
||||
22134 . 22677) (TOTOPW.MODERNIZE 22679 . 23107) (MODERN-MENUBUTTONFN 23109 . 24161)) (24164 26593 (
|
||||
\MODERNIZED.FREEMENU.BUTTONEVENTFN 24174 . 24821) (MODERNIZED.TB.BUTTONEVENTFN 24823 . 26591)) (26634
|
||||
28913 (TEDIT.MODERNIZE 26644 . 27458) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27460 . 28582) (TEDIT.SELECTALL
|
||||
28584 . 28911)))))
|
||||
(FILEMAP (NIL (5125 11487 (MODERNWINDOW 5135 . 6675) (MODERNWINDOW.SETUP 6677 . 9626) (UNMODERNWINDOW
|
||||
9628 . 10022) (MODERNWINDOW.UNSETUP 10024 . 10836) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10838 . 11485))
|
||||
(11552 21714 (MODERNWINDOW.BUTTONEVENTFN 11562 . 18589) (NEARTOP 18591 . 19519) (NEARESTCORNER 19521
|
||||
. 20400) (INCORNER.REGION 20402 . 21712)) (21772 24244 (MODERN-ADD-EXEC 21782 . 22213) (MODERN-SNAPW
|
||||
22215 . 22758) (TOTOPW.MODERNIZE 22760 . 23188) (MODERN-MENUBUTTONFN 23190 . 24242)) (24245 26674 (
|
||||
\MODERNIZED.FREEMENU.BUTTONEVENTFN 24255 . 24902) (MODERNIZED.TB.BUTTONEVENTFN 24904 . 26672)) (26715
|
||||
28994 (TEDIT.MODERNIZE 26725 . 27539) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27541 . 28663) (TEDIT.SELECTALL
|
||||
28665 . 28992)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because one or more lines are too long
BIN
lispusers/migration/IL-SIM.gz
Normal file
BIN
lispusers/migration/IL-SIM.gz
Normal file
Binary file not shown.
56
run-medley
56
run-medley
@@ -58,86 +58,84 @@ export LDEKBDTYPE=x
|
||||
|
||||
while [ "$#" -ne 0 ]; do
|
||||
case "$1" in
|
||||
"-loadup")
|
||||
-loadup)
|
||||
# Keep (GREET) from finding a different init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
|
||||
export MEDLEYLOADUP="$2"
|
||||
export LDEINIT="$2"
|
||||
shift
|
||||
;;
|
||||
"-nogreet" | "--nogreet")
|
||||
-nogreet | --nogreet)
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
|
||||
export LDEINIT="$MEDLEYDIR/greetfiles/NOGREET"
|
||||
;;
|
||||
"-greet" | "--greet")
|
||||
-greet | --greet)
|
||||
export LDEINIT="$2"
|
||||
shift
|
||||
;;
|
||||
"-noscroll")
|
||||
-noscroll)
|
||||
scroll=0
|
||||
noscroll="-noscroll"
|
||||
;;
|
||||
"--dimensions" | "-dimensions")
|
||||
--dimensions | -dimensions)
|
||||
sw=`expr "$2" : "\([0-9]*\)x[0-9]*$"`
|
||||
sh=`expr "$2" : "[0-9]*x\([0-9]*\)$"`
|
||||
if [ -n "$sw" -a -n "$sh" ] ; then
|
||||
sw=$(( (31+$sw)/32*32 ))
|
||||
gw=$(( $scroll+$sw ))
|
||||
gh=$(( $scroll+$sh ))
|
||||
geometry="-g ${gw}x${gh}"
|
||||
screensize="-sc ${sw}x${sh}"
|
||||
sw=$(( (31+$sw)/32*32 ))
|
||||
gw=$(( $scroll+$sw ))
|
||||
gh=$(( $scroll+$sh ))
|
||||
geometry="-g ${gw}x${gh}"
|
||||
screensize="-sc ${sw}x${sh}"
|
||||
fi
|
||||
shift
|
||||
;;
|
||||
"--geometry" | "-geometry" | "-g")
|
||||
--geometry | -geometry | -g)
|
||||
geometry="-g $2"
|
||||
shift
|
||||
;;
|
||||
"--screensize" | "-screensize" | "-sc")
|
||||
--screensize | -screensize | -sc)
|
||||
screensize="-sc $2"
|
||||
shift
|
||||
;;
|
||||
"--display" | "-d")
|
||||
--display | -d)
|
||||
export DISPLAY="$2"
|
||||
shift
|
||||
;;
|
||||
"-prog" )
|
||||
-prog)
|
||||
prog="$2"
|
||||
shift
|
||||
;;
|
||||
"-m" | "-mem" )
|
||||
-m | -mem)
|
||||
mem="-m $2 "
|
||||
shift
|
||||
;;
|
||||
"-vmem" | "--vmem" | "-vmfile" )
|
||||
-vmem | --vmem | -vmfile)
|
||||
export LDEDESTSYSOUT="$2"
|
||||
shift
|
||||
;;
|
||||
"-full")
|
||||
-full)
|
||||
export LDESRCESYSOUT="$MEDLEYDIR/loadups/full.sysout"
|
||||
;;
|
||||
"-lisp")
|
||||
-lisp)
|
||||
export LDESRCESYSOUT="$MEDLEYDIR/loadups/lisp.sysout"
|
||||
;;
|
||||
"-n" | "-new" | "-newfull" )
|
||||
-n | -new | -newfull)
|
||||
export LDESRCESYSOUT="$MEDLEYDIR/tmp/full.sysout"
|
||||
;;
|
||||
"-nl" | "-newlisp" )
|
||||
-nl | -newlisp)
|
||||
export LDESRCESYSOUT="$MEDLEYDIR/tmp/lisp.sysout"
|
||||
;;
|
||||
"-NF")
|
||||
pass="$pass $1"
|
||||
-NF)
|
||||
pass="$pass $1" # for making init, don't fork
|
||||
;;
|
||||
"-*")
|
||||
-*)
|
||||
pass="$pass $1 $2"
|
||||
shift
|
||||
;;
|
||||
*)
|
||||
shift
|
||||
;;
|
||||
*)
|
||||
echo sysout "$1"
|
||||
export LDESRCESYSOUT="$1"
|
||||
;;
|
||||
@@ -199,5 +197,5 @@ echo "greet: $LDEINIT"
|
||||
|
||||
export INMEDLEY=1
|
||||
|
||||
"$prog" $noscroll $geometry $screensize $mem -t "Medley Interlisp" $pass "$LDESRCESYSOUT"
|
||||
"$prog" $noscroll $geometry $screensize $mem -title "Medley Interlisp" $pass "$LDESRCESYSOUT"
|
||||
|
||||
|
||||
@@ -11,12 +11,9 @@ fi
|
||||
./scripts/loadup-mid-from-init.sh && \
|
||||
./scripts/loadup-lisp-from-mid.sh && \
|
||||
./scripts/loadup-full-from-lisp.sh && \
|
||||
./scripts/loadup-aux.sh
|
||||
./scripts/loadup-aux.sh && \
|
||||
./scripts/copy-all.sh
|
||||
|
||||
echo "loadups are in $MEDLEYDIR/tmp"
|
||||
echo use
|
||||
echo " ./scripts/copy-all.sh "
|
||||
echo "to copy to loadups library"
|
||||
echo "**** DONE ****"
|
||||
|
||||
|
||||
|
||||
@@ -7,14 +7,14 @@ if [ ! -f run-medley ] ; then
|
||||
exit 1
|
||||
fi
|
||||
|
||||
touch tmp/loadup.timestamp
|
||||
touch tmp/db.timestamp
|
||||
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
echo '" (IL:MEDLEY-INIT-VARS)(IL:FILESLOAD MEDLEY-UTILS)(IL:MAKE-FULLER-DB)(IL:LOGOUT T)"' > tmp/loadup-db.cm
|
||||
./run-medley $scr -loadup "$MEDLEYDIR"/tmp/loadup-db.cm tmp/full.sysout
|
||||
echo '" (IL:MEDLEY-INIT-VARS)(IL:FILESLOAD MEDLEY-UTILS)(IL:MAKE-FULLER-DB)(IL:LOGOUT T)"' > tmp/db.cm
|
||||
./run-medley $scr -loadup "$MEDLEYDIR"/tmp/db.cm -full
|
||||
|
||||
if [ tmp/fuller.database -nt tmp/loadup.timestamp ]; then
|
||||
if [ tmp/fuller.database -nt tmp/db.timestamp ]; then
|
||||
|
||||
echo ---- made ----
|
||||
ls -l tmp/fuller*
|
||||
|
||||
117
sources/APUTDQ
117
sources/APUTDQ
@@ -1,13 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "25-Aug-2021 13:12:07" {DSK}<home>larry>medley>sources>APUTDQ.;2 11185
|
||||
|
||||
changes to%: (FNS ENDLOADUP)
|
||||
(FILECREATED "25-Oct-2022 11:44:17" {DSK}<home>larry>ilisp>medley>sources>APUTDQ.;3 14079
|
||||
|
||||
previous date%: "25-Aug-2021 12:11:36" {DSK}<home>larry>medley>sources>APUTDQ.;1)
|
||||
:CHANGES-TO (FNS ENDLOADUP)
|
||||
|
||||
:PREVIOUS-DATE "25-Oct-2022 11:07:06" {DSK}<home>larry>ilisp>medley>sources>APUTDQ.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1981-1988, 1990, 2021-2022 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT APUTDQCOMS)
|
||||
@@ -139,33 +140,26 @@ Copyright (c) 1981-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
(SMASHFILECOMS X])
|
||||
|
||||
(ENDLOADUP
|
||||
[LAMBDA NIL (* ; "Edited 25-Aug-2021 13:07 by larry")
|
||||
[LAMBDA NIL
|
||||
(DECLARE (GLOBALVARS USERRECLST SYSTEMINITVARS MEDLEY-INIT-VARS))
|
||||
(* ; "Edited 25-Oct-2022 11:43 by lmm")
|
||||
|
||||
(* ;; "set up for NONET configuration; sites with ethernet can load in init from other places")
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "All records existing at this point in time have been loaded as part of the system.")
|
||||
|
||||
(DECLARE (GLOBALVARS USERRECLST SYSTEMINITVARS MEDLEY-INIT-VARS AFTERSYSOUTFORMS))
|
||||
(FOR R IN USERRECLST DO (RECORDPRIORITY R 'SYSTEM))
|
||||
|
||||
(* ;; "reset variables to nil")
|
||||
|
||||
(MEDLEY-INIT-VARS T)
|
||||
(* ;; " MEDLEY-INIT-VARS is done by aroundexitfn")
|
||||
|
||||
[FOR X IN SYSTEMINITVARS WHEN (NOT (ASSOC (CAR X)
|
||||
MEDLEY-INIT-VARS))
|
||||
MEDLEY-INIT-VARS))
|
||||
DO (SETTOPVAL (CAR X)
|
||||
(COPY (CDR X]
|
||||
|
||||
(* ;; " make sure these are done first")
|
||||
|
||||
(SETQ AFTERSYSOUTFORMS (CONS '(MEDLEY-INIT-VARS)
|
||||
(REMOVE '(MEDLEY-INIT-VARS)
|
||||
AFTERSYSOUTFORMS)))
|
||||
(SETQ AFTERMAKESYSFORMS (CONS '(MEDLEY-INIT-VARS)
|
||||
(REMOVE '(MEDLEY-INIT-VARS)
|
||||
AFTERMAKESYSFORMS)))
|
||||
(COPY (CDR X]
|
||||
(FOR FILE IN (OPENP) DO (PRINTOUT T (CLOSEF FILE)
|
||||
" closed" T))
|
||||
" closed" T))
|
||||
|
||||
(* ;; "get rid of files loaded")
|
||||
|
||||
@@ -261,12 +255,87 @@ Copyright (c) 1981-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PRETTYCOMPRINT APUTDQCOMS)
|
||||
|
||||
(RPAQQ APUTDQCOMS
|
||||
[
|
||||
(* ;; " this file contains some dummy definitions of functions whose real implementation is on other files")
|
||||
|
||||
(DECLARE%: EVAL@LOAD DONTCOPY (P (PRIN1 "Warning: APUTDQ contains dummy definitions of " T)
|
||||
(PRIN1
|
||||
"FAULTEVAL FAULTAPPLY ERRORX SET-DOCUMENTATION SMASHFILECOMS"
|
||||
T)
|
||||
(PRIN1 "Be careful not to confuse with the real definitions"
|
||||
T)
|
||||
(TERPRI T)))
|
||||
(FNS GREETFILENAME FAULTEVAL FAULTAPPLY ERRORX SET-DOCUMENTATION)
|
||||
(FNS SMASHFILECOMS SMASHFILECOMSLST)
|
||||
(INITVARS (DEFAULTREGISTRY)
|
||||
(USERGREETFILES)
|
||||
(LOGINHOST/DIR '{DSK}))
|
||||
(FNS LOADUP ENDLOADUP)
|
||||
(ALISTS (SYSTEMINITVARS \CONNECTED.DIRECTORY DWIMFLG ADDSPELLFLG FILEPKGFLG BUILDMAPFLG
|
||||
UPDATEMAPFLG DEFAULTREGISTRY DEFAULTPRINTINGHOST DIRECTORIES USERGREETFILES
|
||||
NETWORKOSTYPES CH.NET.HINT CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION
|
||||
ADVISEDFNS LISPUSERSDIRECTORIES DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS
|
||||
INTERPRESSFONTDIRECTORIES))
|
||||
[DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(* ;; "many of these are obsolete and can be removed, but it is unclear which ones")
|
||||
|
||||
(P (DUMMYDEF (ADDSTATS *)
|
||||
(LISPXWATCH NILL)
|
||||
(CLBUFS NILL)
|
||||
(FINDFILE INFILEP)
|
||||
(FILEMAP *)
|
||||
(VIRGINFN GETD))
|
||||
(DUMMYDEF (* QUOTE)
|
||||
(GETP GETPROP)
|
||||
(DECLARE QUOTE)
|
||||
(FRPLNODE2 RPLNODE2)
|
||||
(DISPLAYTERMP TRUE)
|
||||
(FRPLACA RPLACA)
|
||||
(FRPLACD RPLACD)
|
||||
(MISSPELLED? NILL)
|
||||
(UNDOSAVE NILL)
|
||||
(SETLINELENGTH ZERO)
|
||||
(DOBE NILL)
|
||||
(RELINK NILL)
|
||||
(PUT PUTPROP)
|
||||
(/PUT PUTPROP)))
|
||||
(ADDVARS (SYSFILES)
|
||||
(LISPXHISTORY)
|
||||
(LINKEDFNS))
|
||||
(VARS (CLEARSTKLST T)
|
||||
(SYSHASHARRAY (HASHARRAY 50))
|
||||
(DISPLAYTERMFLG T)
|
||||
(%#UNDOSAVES)
|
||||
(NLAMA)
|
||||
(NLAML)
|
||||
(LAMS)
|
||||
(TTYLINELENGTH 82)
|
||||
(COMPILE.EXT 'LCOM)
|
||||
(FASL.EXT 'DFASL)
|
||||
(*COMPILED-EXTENSIONS* '(DFASL LCOM))
|
||||
(SYSOUT.EXT 'SYSOUT]
|
||||
(LOCALVARS . T)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS APUTDQ COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
|
||||
2021))
|
||||
2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3963 6171 (GREETFILENAME 3973 . 5846) (FAULTEVAL 5848 . 5920) (FAULTAPPLY 5922 . 6008)
|
||||
(ERRORX 6010 . 6076) (SET-DOCUMENTATION 6078 . 6169)) (6172 7192 (SMASHFILECOMS 6182 . 6524) (
|
||||
SMASHFILECOMSLST 6526 . 7190)) (7286 9211 (LOADUP 7296 . 7719) (ENDLOADUP 7721 . 9209)))))
|
||||
(FILEMAP (NIL (3978 6186 (GREETFILENAME 3988 . 5861) (FAULTEVAL 5863 . 5935) (FAULTAPPLY 5937 . 6023)
|
||||
(ERRORX 6025 . 6091) (SET-DOCUMENTATION 6093 . 6184)) (6187 7207 (SMASHFILECOMS 6197 . 6539) (
|
||||
SMASHFILECOMSLST 6541 . 7205)) (7301 8744 (LOADUP 7311 . 7734) (ENDLOADUP 7736 . 8742)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
277
sources/CMLUNDO
277
sources/CMLUNDO
@@ -1,13 +1,13 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL")
|
||||
(IL:FILECREATED "16-May-90 14:54:01" IL:|{DSK}<usr>local>lde>lispcore>sources>CMLUNDO.;2| 30797
|
||||
(DEFINE-FILE-INFO PACKAGE "XEROX-COMMON-LISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
IL:|changes| IL:|to:| (IL:VARS IL:CMLUNDOCOMS)
|
||||
(IL:FILECREATED "18-Oct-2022 16:24:32" IL:|{DSK}<home>larry>ilisp>medley>sources>CMLUNDO.;2| 31891
|
||||
|
||||
IL:|previous| IL:|date:| "29-Feb-88 19:40:15" IL:|{DSK}<usr>local>lde>lispcore>sources>CMLUNDO.;1|
|
||||
)
|
||||
:CHANGES-TO (IL:FUNCTIONS UNDOABLY)
|
||||
|
||||
:PREVIOUS-DATE "15-Oct-2022 17:21:17" IL:|{DSK}<home>larry>ilisp>medley>sources>CMLUNDO.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1986, 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1986-1988, 1990, 2022 by Venue & Xerox Corporation.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:CMLUNDOCOMS)
|
||||
|
||||
@@ -38,7 +38,7 @@
|
||||
(PSETF . UNDOABLY-PSETF)
|
||||
(PUSH . UNDOABLY-PUSH)
|
||||
(PUSHNEW . UNDOABLY-PUSHNEW)
|
||||
((REMF) . UNDOABLY-REMF)
|
||||
(REMF . UNDOABLY-REMF)
|
||||
(ROTATEF . UNDOABLY-ROTATEF)
|
||||
(SHIFTF . UNDOABLY-SHIFTF)
|
||||
(DECF . UNDOABLY-DECF)
|
||||
@@ -69,60 +69,75 @@
|
||||
(DEFUN NOHOOK (FN ARGS &OPTIONAL ENV &AUX (*EVALHOOK* NIL))
|
||||
(APPLY FN ARGS))
|
||||
|
||||
(DEFMACRO UNDOABLY (&REST FORMS &ENVIRONMENT ENV)
|
||||
(WALK-FORM
|
||||
(IL:MKPROGN FORMS)
|
||||
:ENVIRONMENT ENV :WALK-FUNCTION
|
||||
#'(LAMBDA
|
||||
(X CONTEXT)
|
||||
(COND
|
||||
((NOT (CONSP X))
|
||||
X)
|
||||
((NOT (SYMBOLP (CAR X)))
|
||||
X)
|
||||
(T
|
||||
(CASE (CAR X)
|
||||
((SETQ SETQ SETF)
|
||||
(VALUES
|
||||
(IL:MKPROGN
|
||||
(WITH-COLLECTION
|
||||
(DO ((TAIL (CDR X)
|
||||
(CDDR TAIL)))
|
||||
((NULL TAIL))
|
||||
(COLLECT
|
||||
(IF (SYMBOLP (CAR TAIL))
|
||||
(IF (VARIABLE-LEXICAL-P (CAR TAIL))
|
||||
`(SETQ ,(CAR TAIL)
|
||||
,(WALK-FORM-INTERNAL (CADR TAIL)))
|
||||
(PROGN (WARN "Variable ~S presumed special in UNDOABLY.. SETQ"
|
||||
(CAR TAIL))
|
||||
`(UNDOABLY-SET-SYMBOL ',(CAR TAIL)
|
||||
,(WALK-FORM-INTERNAL (CADR TAIL)))))
|
||||
(MULTIPLE-VALUE-BIND
|
||||
(FORMALS ACTUALS NEW-VALUE SETTER GETTER)
|
||||
(GET-UNDOABLE-SETF-METHOD (CAR TAIL))
|
||||
`(,'LET* (,@(MAPCAR #'(LAMBDA (X Y)
|
||||
(LIST X (WALK-FORM-INTERNAL Y)))
|
||||
FORMALS ACTUALS)
|
||||
(,(WALK-FORM-INTERNAL (CAR NEW-VALUE))
|
||||
,(CADR TAIL)))
|
||||
,SETTER)))))))
|
||||
T))
|
||||
(STOP-UNDOABLY (VALUES (IL:MKPROGN (CDR X))
|
||||
T))
|
||||
(T (LET ((UNDONAME (CDR (MEMBER (CAR X)
|
||||
IL:LISPXFNS :TEST #'EQ))))
|
||||
(IF UNDONAME
|
||||
(CONS UNDONAME (CDR X))
|
||||
(IF (AND (OR (GET (CAR X)
|
||||
':DEFINER-FOR)
|
||||
(GET (CAR X)
|
||||
'IL:DEFINER-FOR))
|
||||
(NOT *IN-DEFINER*))
|
||||
(LET ((*IN-DEFINER* T))
|
||||
(VALUES (WALK-FORM-INTERNAL (MACROEXPAND-1 X))
|
||||
T))
|
||||
X))))))))))
|
||||
(DEFMACRO UNDOABLY (&REST FORMS &ENVIRONMENT ENV) (IL:* IL:\; "Edited 18-Oct-2022 16:20 by lmm")
|
||||
(IL:* IL:\; "Edited 15-Oct-2022 11:47 by lmm")
|
||||
(IF (NULL IL:LISPXHIST)
|
||||
(IL:MKPROGN FORMS)
|
||||
(WALK-FORM
|
||||
(IL:MKPROGN FORMS)
|
||||
:ENVIRONMENT ENV :WALK-FUNCTION
|
||||
#'(LAMBDA
|
||||
(X CONTEXT)
|
||||
(COND
|
||||
((NOT (CONSP X))
|
||||
X)
|
||||
((NOT (SYMBOLP (CAR X)))
|
||||
X)
|
||||
(T
|
||||
(CASE (CAR X)
|
||||
((SETQ IL:SETQ SETF)
|
||||
(VALUES
|
||||
(IL:MKPROGN
|
||||
(WITH-COLLECTION
|
||||
(DO ((TAIL (CDR X)
|
||||
(CDDR TAIL)))
|
||||
((NULL TAIL))
|
||||
(COLLECT
|
||||
(IF (SYMBOLP (CAR TAIL))
|
||||
(IF (VARIABLE-LEXICAL-P (CAR TAIL))
|
||||
`(,(CAR X)
|
||||
,(CAR TAIL)
|
||||
,(WALK-FORM-INTERNAL (CADR TAIL)))
|
||||
(PROGN (COND
|
||||
((NOT (OR (VARIABLE-SPECIAL-P (CAR TAIL))
|
||||
(BOUNDP (CAR TAIL))))
|
||||
|
||||
(IL:* IL:|;;| "should possibly spelling correct? ")
|
||||
|
||||
(WHEN NIL
|
||||
|
||||
(IL:* IL:|;;| "this warning just seems uselsss; it doesn't proclaim anything or mark it as changed in FILEPKG or ...")
|
||||
|
||||
(WARN
|
||||
"Variable ~S proclaimed SPECIAL UNDOABLY.. SETQ"
|
||||
(CAR TAIL)))))
|
||||
`(UNDOABLY-SET-SYMBOL ',(CAR TAIL)
|
||||
,(WALK-FORM-INTERNAL (CADR TAIL)))))
|
||||
(MULTIPLE-VALUE-BIND
|
||||
(FORMALS ACTUALS NEW-VALUE SETTER GETTER)
|
||||
(GET-UNDOABLE-SETF-METHOD (CAR TAIL))
|
||||
`(,'LET* (,@(MAPCAR #'(LAMBDA (X Y)
|
||||
(LIST X (WALK-FORM-INTERNAL Y)))
|
||||
FORMALS ACTUALS)
|
||||
(,(WALK-FORM-INTERNAL (CAR NEW-VALUE))
|
||||
,(CADR TAIL)))
|
||||
,SETTER)))))))
|
||||
T))
|
||||
(STOP-UNDOABLY (VALUES (IL:MKPROGN (CDR X))
|
||||
T))
|
||||
(T (LET ((UNDONAME (CDR (ASSOC (CAR X)
|
||||
IL:LISPXFNS :TEST #'EQ))))
|
||||
(IF UNDONAME
|
||||
(CONS UNDONAME (CDR X))
|
||||
(IF (AND (OR (GET (CAR X)
|
||||
':DEFINER-FOR)
|
||||
(GET (CAR X)
|
||||
'IL:DEFINER-FOR))
|
||||
(NOT *IN-DEFINER*))
|
||||
(LET ((*IN-DEFINER* T))
|
||||
(VALUES (WALK-FORM-INTERNAL (MACROEXPAND-1 X))
|
||||
T))
|
||||
X)))))))))))
|
||||
|
||||
(DEFUN UNDOABLY-FMAKUNBOUND (SYMBOL)
|
||||
(IL:/PUTD SYMBOL NIL)
|
||||
@@ -137,11 +152,9 @@
|
||||
(IL:* IL:|;;| "Make a symbol unbound.")
|
||||
|
||||
(IL:SAVESET SYMBOL 'IL:NOBIND) (IL:* IL:\;
|
||||
" unbound symbols are set to IL:NOBIND")
|
||||
(IL:/PUTHASH SYMBOL NIL IL:COMPVARMACROHASH) (IL:* IL:\;
|
||||
"remove any constant entry")
|
||||
(IL:/REMPROP SYMBOL 'IL:GLOBALLY-SPECIAL) (IL:* IL:\;
|
||||
" left by PROCLAIM special")
|
||||
" unbound symbols are set to IL:NOBIND")
|
||||
(IL:/PUTHASH SYMBOL NIL IL:COMPVARMACROHASH) (IL:* IL:\; "remove any constant entry")
|
||||
(IL:/REMPROP SYMBOL 'IL:GLOBALLY-SPECIAL) (IL:* IL:\; " left by PROCLAIM special")
|
||||
(IL:/REMPROP SYMBOL 'IL:GLOBALVAR) (IL:* IL:\; "")
|
||||
SYMBOL)
|
||||
|
||||
@@ -155,19 +168,19 @@
|
||||
|
||||
(IL:* IL:|;;| "assumes variable is not lexical !")
|
||||
|
||||
`(UNDOABLY-SET-SYMBOL ',PLACE ,NEW-VALUE))
|
||||
`(UNDOABLY-SET-SYMBOL ',PLACE ,NEW-VALUE))
|
||||
(T (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER)
|
||||
(GET-UNDOABLE-SETF-METHOD PLACE ENV)
|
||||
(GET-UNDOABLE-SETF-METHOD PLACE ENV)
|
||||
`(,'LET* (,@(MAPCAR #'LIST DUMMIES VALS)
|
||||
(,(CAR NEWVAL)
|
||||
,NEW-VALUE))
|
||||
,SETTER)))))
|
||||
|
||||
(DEFUN UNDOHOOK (FORM ENV &AUX (*APPLYHOOK* NIL))
|
||||
(DEFUN UNDOHOOK (FORM ENV &AUX (*APPLYHOOK* NIL)) (IL:* IL:\; "Edited 14-Oct-2022 13:54 by lmm")
|
||||
(IF (ATOM FORM)
|
||||
(EVAL FORM ENV)
|
||||
(CASE (CAR FORM)
|
||||
((SETQ SETQ SETF)
|
||||
((SETQ IL:SETQ SETF)
|
||||
(DO ((TAIL (CDR FORM))
|
||||
VALUE)
|
||||
((NULL TAIL)
|
||||
@@ -175,8 +188,8 @@
|
||||
(SETQ
|
||||
VALUE
|
||||
(IF (SYMBOLP (CAR TAIL))
|
||||
(UNDOABLY-SET-SYMBOL (POP TAIL)
|
||||
(UNDOHOOK (POP TAIL)
|
||||
(UNDOABLY-SET-SYMBOL (POP TAIL)
|
||||
(UNDOHOOK (POP TAIL)
|
||||
ENV)
|
||||
ENV)
|
||||
(EVAL
|
||||
@@ -184,13 +197,13 @@
|
||||
|
||||
(MULTIPLE-VALUE-BIND
|
||||
(FORMALS VALS NEW-VALUE SETTER GETTER)
|
||||
(GET-UNDOABLE-SETF-METHOD (POP TAIL)
|
||||
(GET-UNDOABLE-SETF-METHOD (POP TAIL)
|
||||
ENV)
|
||||
`(,'LET* (,@(MAPCAR #'(LAMBDA (X Y)
|
||||
(LIST X (LIST 'UNDOABLY Y)))
|
||||
FORMALS VALS)
|
||||
(,(CAR NEW-VALUE)
|
||||
(UNDOABLY ,(POP TAIL))))
|
||||
(UNDOABLY ,(POP TAIL))))
|
||||
,SETTER))
|
||||
ENV)))))
|
||||
(STOP-UNDOABLY
|
||||
@@ -199,7 +212,7 @@
|
||||
|
||||
(IL:\\EVAL-PROGN (CDR FORM)
|
||||
ENV))
|
||||
(T (LET ((UNDONAME (CDR (MEMBER (CAR FORM)
|
||||
(T (LET ((UNDONAME (CDR (ASSOC (CAR FORM)
|
||||
IL:LISPXFNS :TEST #'EQ))))
|
||||
(IF UNDONAME
|
||||
(EVALHOOK (CONS UNDONAME (CDR FORM))
|
||||
@@ -215,16 +228,16 @@
|
||||
((NULL ARGS)
|
||||
NIL)
|
||||
(T `(PROG1 NIL
|
||||
(UNDOABLY-SETF ,(POP ARGS)
|
||||
(UNDOABLY-SETF ,(POP ARGS)
|
||||
(PROG1 ,(POP ARGS)
|
||||
(UNDOABLY-PSETF ,@ARGS)))))))
|
||||
(UNDOABLY-PSETF ,@ARGS)))))))
|
||||
|
||||
(DEFMACRO UNDOABLY-POP (PLACE &ENVIRONMENT ENV)
|
||||
(IF (SYMBOLP PLACE)
|
||||
`(PROG1 (CAR ,PLACE)
|
||||
(UNDOABLY-SETQ ,PLACE (CDR ,PLACE)))
|
||||
(MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER)
|
||||
(GET-UNDOABLE-SETF-METHOD PLACE ENV)
|
||||
(GET-UNDOABLE-SETF-METHOD PLACE ENV)
|
||||
`(,'LET* (,@(MAPCAR #'LIST DUMMIES VALS)
|
||||
,(LIST (CAR NEWVAL)
|
||||
GETTER))
|
||||
@@ -240,7 +253,7 @@
|
||||
(IF (SYMBOLP PLACE)
|
||||
`(UNDOABLY-SETQ ,PLACE (CONS ,OBJ ,PLACE))
|
||||
(MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER)
|
||||
(GET-UNDOABLE-SETF-METHOD PLACE ENV)
|
||||
(GET-UNDOABLE-SETF-METHOD PLACE ENV)
|
||||
`(,'LET* (,@(MAPCAR #'LIST DUMMIES VALS)
|
||||
(,(CAR NEWVAL)
|
||||
(CONS ,OBJ ,GETTER)))
|
||||
@@ -250,7 +263,7 @@
|
||||
(IF (SYMBOLP PLACE)
|
||||
`(UNDOABLY-SETQ ,PLACE (ADJOIN ,OBJ ,PLACE ,@KEYS))
|
||||
(MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER)
|
||||
(GET-UNDOABLE-SETF-METHOD PLACE ENV)
|
||||
(GET-UNDOABLE-SETF-METHOD PLACE ENV)
|
||||
`(,'LET* (,@(MAPCAR #'LIST DUMMIES VALS)
|
||||
(,(CAR NEWVAL)
|
||||
(ADJOIN ,OBJ ,GETTER ,@KEYS)))
|
||||
@@ -258,7 +271,7 @@
|
||||
|
||||
(DEFMACRO UNDOABLY-REMF (PLACE INDICATOR &ENVIRONMENT ENV)
|
||||
(MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER)
|
||||
(GET-UNDOABLE-SETF-METHOD PLACE ENV)
|
||||
(GET-UNDOABLE-SETF-METHOD PLACE ENV)
|
||||
(LET ((IND-TEMP (GENSYM))
|
||||
(LOCAL1 (GENSYM))
|
||||
(LOCAL2 (GENSYM)))
|
||||
@@ -303,7 +316,7 @@
|
||||
,@(REVERSE SETF-LIST)
|
||||
NIL))
|
||||
(MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER)
|
||||
(GET-UNDOABLE-SETF-METHOD (CAR A)
|
||||
(GET-UNDOABLE-SETF-METHOD (CAR A)
|
||||
ENV)
|
||||
(DO ((D DUMMIES (CDR D))
|
||||
(V VALS (CDR V)))
|
||||
@@ -335,7 +348,7 @@
|
||||
,@(REVERSE SETF-LIST)
|
||||
,RESULT))
|
||||
(MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER)
|
||||
(GET-UNDOABLE-SETF-METHOD (CAR A)
|
||||
(GET-UNDOABLE-SETF-METHOD (CAR A)
|
||||
ENV)
|
||||
(DO ((D DUMMIES (CDR D))
|
||||
(V VALS (CDR V)))
|
||||
@@ -348,8 +361,8 @@
|
||||
(PUSH SETTER SETF-LIST)
|
||||
(SETQ NEXT-VAR (CAR NEWVAL)))))))
|
||||
|
||||
(DEFDEFINER DEFINE-UNDOABLE-MODIFY-MACRO IL:FUNCTIONS (NAME LAMBDA-LIST FUNCTION &OPTIONAL
|
||||
DOC-STRING)
|
||||
(DEFDEFINER DEFINE-UNDOABLE-MODIFY-MACRO IL:FUNCTIONS (NAME LAMBDA-LIST FUNCTION &OPTIONAL DOC-STRING
|
||||
)
|
||||
(LET
|
||||
((OTHER-ARGS NIL)
|
||||
(REST-ARG NIL))
|
||||
@@ -371,7 +384,7 @@
|
||||
SI::%$$MODIFY-MACRO-ENVIRONMENT)
|
||||
,DOC-STRING (MULTIPLE-VALUE-BIND
|
||||
(DUMMIES VALS NEWVAL SETTER GETTER)
|
||||
(GET-UNDOABLE-SETF-METHOD SI::%$$MODIFY-MACRO-FORM
|
||||
(GET-UNDOABLE-SETF-METHOD SI::%$$MODIFY-MACRO-FORM
|
||||
SI::%$$MODIFY-MACRO-ENVIRONMENT)
|
||||
(MULTIPLE-VALUE-BIND
|
||||
(DUMMIES VALS NEWVALS SETTER GETTER)
|
||||
@@ -384,10 +397,10 @@
|
||||
,SETTER))))))
|
||||
|
||||
(DEFINE-UNDOABLE-MODIFY-MACRO UNDOABLY-DECF (&OPTIONAL (DELTA 1))
|
||||
-)
|
||||
-)
|
||||
|
||||
(DEFINE-UNDOABLE-MODIFY-MACRO UNDOABLY-INCF (&OPTIONAL (DELTA 1))
|
||||
+)
|
||||
+)
|
||||
|
||||
(DEFUN UNDOABLY-PROCLAIM (PROCLAMATION)
|
||||
|
||||
@@ -396,34 +409,34 @@
|
||||
(WHEN (CONSP PROCLAMATION)
|
||||
(CASE (CAR PROCLAMATION)
|
||||
(SPECIAL (DOLIST (X (CDR PROCLAMATION))
|
||||
(UNDOABLY (SETF (IL:VARIABLE-GLOBALLY-SPECIAL-P X)
|
||||
(UNDOABLY (SETF (IL:VARIABLE-GLOBALLY-SPECIAL-P X)
|
||||
T)
|
||||
(SETF (IL:VARIABLE-GLOBAL-P X)
|
||||
NIL)
|
||||
(SETF (CONSTANTP X)
|
||||
NIL))))
|
||||
(GLOBAL (DOLIST (X (CDR PROCLAMATION))
|
||||
(UNDOABLY (SETF (IL:VARIABLE-GLOBAL-P X)
|
||||
(UNDOABLY (SETF (IL:VARIABLE-GLOBAL-P X)
|
||||
T)
|
||||
(SETF (IL:VARIABLE-GLOBALLY-SPECIAL-P X)
|
||||
NIL)
|
||||
(SETF (CONSTANTP X)
|
||||
NIL))))
|
||||
(SI::CONSTANT (DOLIST (X (CDR PROCLAMATION))
|
||||
(UNDOABLY (SETF (CONSTANTP X)
|
||||
(UNDOABLY (SETF (CONSTANTP X)
|
||||
T)
|
||||
(SETF (IL:VARIABLE-GLOBAL-P X)
|
||||
NIL)
|
||||
(SETF (IL:VARIABLE-GLOBALLY-SPECIAL-P X)
|
||||
NIL))))
|
||||
(DECLARATION (DOLIST (X (CDR PROCLAMATION))
|
||||
(UNDOABLY (SETF (DECL-SPECIFIER-P X)
|
||||
(UNDOABLY (SETF (DECL-SPECIFIER-P X)
|
||||
T))))
|
||||
(NOTINLINE (DOLIST (X (CDR PROCLAMATION))
|
||||
(UNDOABLY (SETF (GLOBALLY-NOTINLINE-P X)
|
||||
(UNDOABLY (SETF (GLOBALLY-NOTINLINE-P X)
|
||||
T))))
|
||||
(INLINE (DOLIST (X (CDR PROCLAMATION))
|
||||
(UNDOABLY (SETF (GLOBALLY-NOTINLINE-P X)
|
||||
(UNDOABLY (SETF (GLOBALLY-NOTINLINE-P X)
|
||||
NIL)))))))
|
||||
|
||||
(DEFUN MAKE-UNDOABLE (FORM &OPTIONAL ENV)
|
||||
@@ -438,7 +451,7 @@
|
||||
(DEFUN UNDOABLY-SETF-SYMBOL-FUNCTION (SYMBOL DEFINITION)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"NOTE: If you change this version, be sure to change the not-undoable version on LLSYMBOL!")
|
||||
"NOTE: If you change this version, be sure to change the not-undoable version on LLSYMBOL!")
|
||||
|
||||
(IL:* IL:|;;| " undoable inverse of SYMBOL-FUNCTION")
|
||||
|
||||
@@ -449,9 +462,9 @@
|
||||
(IL:* IL:|;;| "Either it's a LAMBDA form or one of the special lists put together by SYMBOL-FUNCTION for macros and special forms.")
|
||||
|
||||
(CASE (CAR DEFINITION)
|
||||
(:MACRO (UNDOABLY-SETF (MACRO-FUNCTION SYMBOL)
|
||||
(:MACRO (UNDOABLY-SETF (MACRO-FUNCTION SYMBOL)
|
||||
(CDR DEFINITION)))
|
||||
(:SPECIAL-FORM (UNDOABLY-SETF (GET SYMBOL 'IL:SPECIAL-FORM)
|
||||
(:SPECIAL-FORM (UNDOABLY-SETF (GET SYMBOL 'IL:SPECIAL-FORM)
|
||||
(CDR DEFINITION)))
|
||||
(T (IL:/PUTD SYMBOL DEFINITION T))))
|
||||
|
||||
@@ -480,14 +493,14 @@
|
||||
(IL:* IL:|;;| "undoable setf of macro-function")
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"NOTE: If you change this, be sure to change the not-undoable version on CMLMACROS!")
|
||||
"NOTE: If you change this, be sure to change the not-undoable version on CMLMACROS!")
|
||||
|
||||
(PROG1 (UNDOABLY-SETF (GET X 'IL:MACRO-FN)
|
||||
(PROG1 (UNDOABLY-SETF (GET X 'IL:MACRO-FN)
|
||||
BODY)
|
||||
(AND (IL:GETD X)
|
||||
(CASE (IL:ARGTYPE X)
|
||||
((1 3) (IL:* IL:\;
|
||||
"Leave Interlisp nlambda definition alone")
|
||||
"Leave Interlisp nlambda definition alone")
|
||||
)
|
||||
(OTHERWISE (IL:/PUTD X NIL))))))
|
||||
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DONTEVAL@COMPILE IL:DOCOPY
|
||||
@@ -498,18 +511,18 @@
|
||||
)
|
||||
|
||||
(IL:ADDTOVAR IL:LISPXFNS (PROCLAIM . UNDOABLY-PROCLAIM)
|
||||
(POP . UNDOABLY-POP)
|
||||
(PSETF . UNDOABLY-PSETF)
|
||||
(PUSH . UNDOABLY-PUSH)
|
||||
(PUSHNEW . UNDOABLY-PUSHNEW)
|
||||
((REMF) . UNDOABLY-REMF)
|
||||
(ROTATEF . UNDOABLY-ROTATEF)
|
||||
(SHIFTF . UNDOABLY-SHIFTF)
|
||||
(DECF . UNDOABLY-DECF)
|
||||
(INCF . UNDOABLY-INCF)
|
||||
(SET . UNDOABLY-SET-SYMBOL)
|
||||
(MAKUNBOUND . UNDOABLY-MAKUNBOUND)
|
||||
(FMAKUNBOUND . UNDOABLY-FMAKUNBOUND))
|
||||
(POP . UNDOABLY-POP)
|
||||
(PSETF . UNDOABLY-PSETF)
|
||||
(PUSH . UNDOABLY-PUSH)
|
||||
(PUSHNEW . UNDOABLY-PUSHNEW)
|
||||
(REMF . UNDOABLY-REMF)
|
||||
(ROTATEF . UNDOABLY-ROTATEF)
|
||||
(SHIFTF . UNDOABLY-SHIFTF)
|
||||
(DECF . UNDOABLY-DECF)
|
||||
(INCF . UNDOABLY-INCF)
|
||||
(SET . UNDOABLY-SET-SYMBOL)
|
||||
(MAKUNBOUND . UNDOABLY-MAKUNBOUND)
|
||||
(FMAKUNBOUND . UNDOABLY-FMAKUNBOUND))
|
||||
|
||||
(DEFUN GET-UNDOABLE-SETF-METHOD (FORM &OPTIONAL ENVIRONMENT &AUX TEMP)
|
||||
(COND
|
||||
@@ -524,7 +537,7 @@
|
||||
|
||||
(IL:* IL:|;;| "always expand local macros")
|
||||
|
||||
(GET-UNDOABLE-SETF-METHOD (FUNCALL TEMP FORM ENVIRONMENT)
|
||||
(GET-UNDOABLE-SETF-METHOD (FUNCALL TEMP FORM ENVIRONMENT)
|
||||
ENVIRONMENT))
|
||||
((SETQ TEMP (GET (CAR FORM)
|
||||
':UNDOABLE-SETF-INVERSE))
|
||||
@@ -553,12 +566,12 @@
|
||||
(T (MULTIPLE-VALUE-BIND (MAC MORE)
|
||||
(MACROEXPAND-1 FORM ENVIRONMENT)
|
||||
(IF (AND MORE (NOT (EQ MAC FORM)))
|
||||
(RETURN-FROM DONE (GET-UNDOABLE-SETF-METHOD MAC ENVIRONMENT))
|
||||
(RETURN-FROM DONE (GET-UNDOABLE-SETF-METHOD MAC ENVIRONMENT))
|
||||
(ERROR "~S is not a known location specifier for SETF."
|
||||
(CAR FORM))))))
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"this is lexically correct, but doesn't work in bytecompiler, interlisp")
|
||||
"this is lexically correct, but doesn't work in bytecompiler, interlisp")
|
||||
|
||||
(IL:* IL:|;;| "(cl:values dummies vals newval `(cl:labels ((undostore (,@newval) (undosave (list #'undostore ,getter)) ,setter)) (undostore ,@newval)) getter)")
|
||||
|
||||
@@ -580,7 +593,7 @@
|
||||
(WHEN ENVIRONMENT
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"This function only saves undo info when there is no lexical binding for the variable.")
|
||||
"This function only saves undo info when there is no lexical binding for the variable.")
|
||||
|
||||
(SETQ ENVIRONMENT (IL:ENVIRONMENT-VARS ENVIRONMENT))
|
||||
(LOOP (IF (NULL ENVIRONMENT)
|
||||
@@ -593,7 +606,7 @@
|
||||
IL:*SPECIAL-BINDING-MARK*)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"it is a special binding, or a mark that we are using the special value")
|
||||
"it is a special binding, or a mark that we are using the special value")
|
||||
|
||||
(RETURN NIL) (IL:* IL:\; "return from WHILE")
|
||||
)
|
||||
@@ -634,26 +647,25 @@
|
||||
(IL:\\RPLPTR VP 0 VALUE))))))
|
||||
(IL:DEFINEQ
|
||||
|
||||
(undoably-setq
|
||||
(il:nlambda varvalue (il:* il:\; "Edited 8-Oct-87 18:54 by jop")
|
||||
(il:* il:\; "Interlisp version")
|
||||
|
||||
(undoably-set-symbol (car varvalue)
|
||||
(il:\\evprog1 (cdr varvalue)))))
|
||||
(UNDOABLY-SETQ
|
||||
(IL:NLAMBDA VARVALUE (IL:* IL:\; "Edited 8-Oct-87 18:54 by jop")
|
||||
(IL:* IL:\; "Interlisp version")
|
||||
(UNDOABLY-SET-SYMBOL (CAR VARVALUE)
|
||||
(IL:\\EVPROG1 (CDR VARVALUE)))))
|
||||
)
|
||||
|
||||
(DEFINE-SPECIAL-FORM UNDOABLY (&REST FORMS &ENVIRONMENT ENV)
|
||||
(LOOP (IF (NULL (CDR FORMS))
|
||||
(RETURN (UNDOHOOK (CAR FORMS)
|
||||
(RETURN (UNDOHOOK (CAR FORMS)
|
||||
ENV))
|
||||
(UNDOHOOK (POP FORMS)
|
||||
(UNDOHOOK (POP FORMS)
|
||||
ENV))))
|
||||
|
||||
(DEFINE-SPECIAL-FORM UNDOABLY-SETQ (&REST TAIL &ENVIRONMENT ENV)
|
||||
(LET (VALUE)
|
||||
(LOOP (IF (NULL TAIL)
|
||||
(RETURN NIL)
|
||||
(SETQ VALUE (UNDOABLY-SET-SYMBOL (POP TAIL)
|
||||
(SETQ VALUE (UNDOABLY-SET-SYMBOL (POP TAIL)
|
||||
(EVAL (POP TAIL)
|
||||
ENV)
|
||||
ENV))))
|
||||
@@ -678,7 +690,16 @@
|
||||
|
||||
(IL:ADDTOVAR IL:LAMA )
|
||||
)
|
||||
(IL:PUTPROPS IL:CMLUNDO IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990))
|
||||
(IL:PUTPROPS IL:CMLUNDO IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 2022))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (29112 29437 (UNDOABLY-SETQ 29125 . 29435)))))
|
||||
(IL:FILEMAP (NIL (4227 4310 (NOHOOK 4227 . 4310)) (4312 7992 (UNDOABLY 4312 . 7992)) (7994 8214 (
|
||||
UNDOABLY-FMAKUNBOUND 7994 . 8214)) (8216 8792 (UNDOABLY-MAKUNBOUND 8216 . 8792)) (8794 9521 (
|
||||
UNDOABLY-SETF 8794 . 9521)) (9523 11417 (UNDOHOOK 9523 . 11417)) (11419 11766 (UNDOABLY-PSETF 11419 .
|
||||
11766)) (11768 12368 (UNDOABLY-POP 11768 . 12368)) (12370 12930 (UNDOABLY-PUSH 12370 . 12930)) (12932
|
||||
13391 (UNDOABLY-PUSHNEW 12932 . 13391)) (13393 14759 (UNDOABLY-REMF 13393 . 14759)) (14761 15907 (
|
||||
UNDOABLY-ROTATEF 14761 . 15907)) (15909 17049 (UNDOABLY-SHIFTF 15909 . 17049)) (18845 20667 (
|
||||
UNDOABLY-PROCLAIM 18845 . 20667)) (20669 20740 (MAKE-UNDOABLE 20669 . 20740)) (20742 20888 (
|
||||
STOP-UNDOABLY 20742 . 20888)) (20890 22570 (UNDOABLY-SETF-SYMBOL-FUNCTION 20890 . 22570)) (22572 23161
|
||||
(UNDOABLY-SETF-MACRO-FUNCTION 22572 . 23161)) (24059 27459 (GET-UNDOABLE-SETF-METHOD 24059 . 27459))
|
||||
(27461 30185 (UNDOABLY-SET-SYMBOL 27461 . 30185)) (30186 30514 (UNDOABLY-SETQ 30199 . 30512)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Jul-2022 14:56:07"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;75 37244
|
||||
(FILECREATED "10-Oct-2022 18:10:56"
|
||||
{DSK}<cygdrive>c>Users>Larry>home>MEDLEY>SOURCES>EXTERNALFORMAT.;76 37395
|
||||
|
||||
:CHANGES-TO (MACROS \CHECKEOLC)
|
||||
(FNS \INCCODE.EOLC)
|
||||
:CHANGES-TO (FNS SYSTEM-EXTERNALFORMAT)
|
||||
|
||||
:PREVIOUS-DATE "24-Jul-2022 08:30:32"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;72)
|
||||
:PREVIOUS-DATE "24-Jul-2022 14:56:07"
|
||||
{DSK}<cygdrive>c>Users>Larry>home>MEDLEY>SOURCES>EXTERNALFORMAT.;75)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
|
||||
@@ -293,9 +292,10 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SYSTEM-EXTERNALFORMAT
|
||||
[LAMBDA NIL (* ; "Edited 7-Jul-2022 10:41 by rmk")
|
||||
(AND (STRPOS ".UTF-8" (UNIX-GETENV "LANG"))
|
||||
:UTF-8])
|
||||
[LAMBDA NIL (* ; "Edited 10-Oct-2022 11:55 by lmm")
|
||||
(* ; "Edited 7-Jul-2022 10:41 by rmk")
|
||||
(FOR X IN '("LC_CTYPE" "LC_ALL" "LANG") WHEN (STRPOS ".UTF-8" (UNIX-GETENV X))
|
||||
DO (RETURN :UTF-8) FINALLY (RETURN :THROUGH])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -712,13 +712,13 @@
|
||||
(\CREATE.THROUGH.EXTERNALFORMAT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6607 13242 (\EXTERNALFORMAT 6617 . 10395) (MAKE-EXTERNALFORMAT 10397 . 12769) (
|
||||
\EXTERNALFORMAT.DEFPRINT 12771 . 13240)) (13243 16284 (\INSTALL.EXTERNALFORMAT 13253 . 14702) (
|
||||
\REMOVE.EXTERNALFORMAT 14704 . 15535) (FIND-FORMAT 15537 . 16282)) (16285 16498 (SYSTEM-EXTERNALFORMAT
|
||||
16295 . 16496)) (16847 31667 (\OUTCHAR 16857 . 18074) (\INCCODE 18076 . 19229) (\BACKCCODE 19231 .
|
||||
20800) (\BACKCCODE.EOLC 20802 . 22992) (\PEEKCCODE 22994 . 23319) (\PEEKCCODE.EOLC 23321 . 23700) (
|
||||
\INCCODE.EOLC 23702 . 25501) (\FORMATBYTESTREAM 25503 . 27638) (\FORMATBYTESTRING 27640 . 29099) (
|
||||
\CHECKEOLC.CRLF 29101 . 31665)) (32945 35181 (\NULLDEVICE 32955 . 34857) (\NULL.OPENFILE 34859 . 35179
|
||||
)) (35321 37148 (\CREATE.THROUGH.EXTERNALFORMAT 35331 . 36117) (\THROUGHIN 36119 . 36539) (
|
||||
\THROUGHBACKCCODE 36541 . 36808) (\THROUGHOUTCHARFN 36810 . 37146)))))
|
||||
(FILEMAP (NIL (6559 13194 (\EXTERNALFORMAT 6569 . 10347) (MAKE-EXTERNALFORMAT 10349 . 12721) (
|
||||
\EXTERNALFORMAT.DEFPRINT 12723 . 13192)) (13195 16236 (\INSTALL.EXTERNALFORMAT 13205 . 14654) (
|
||||
\REMOVE.EXTERNALFORMAT 14656 . 15487) (FIND-FORMAT 15489 . 16234)) (16237 16649 (SYSTEM-EXTERNALFORMAT
|
||||
16247 . 16647)) (16998 31818 (\OUTCHAR 17008 . 18225) (\INCCODE 18227 . 19380) (\BACKCCODE 19382 .
|
||||
20951) (\BACKCCODE.EOLC 20953 . 23143) (\PEEKCCODE 23145 . 23470) (\PEEKCCODE.EOLC 23472 . 23851) (
|
||||
\INCCODE.EOLC 23853 . 25652) (\FORMATBYTESTREAM 25654 . 27789) (\FORMATBYTESTRING 27791 . 29250) (
|
||||
\CHECKEOLC.CRLF 29252 . 31816)) (33096 35332 (\NULLDEVICE 33106 . 35008) (\NULL.OPENFILE 35010 . 35330
|
||||
)) (35472 37299 (\CREATE.THROUGH.EXTERNALFORMAT 35482 . 36268) (\THROUGHIN 36270 . 36690) (
|
||||
\THROUGHBACKCCODE 36692 . 36959) (\THROUGHOUTCHARFN 36961 . 37297)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
129
sources/FILEIO
129
sources/FILEIO
@@ -1,12 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Jul-2022 09:28:20"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEIO.;116 160597
|
||||
(FILECREATED "11-Oct-2022 11:34:00" {DSK}<home>larry>medley>sources>FILEIO.;2 161841
|
||||
|
||||
:CHANGES-TO (VARS FILEIOCOMS)
|
||||
:CHANGES-TO (FNS \PRINT-REVALIDATION-RESULT)
|
||||
|
||||
:PREVIOUS-DATE "19-Jul-2022 23:23:39"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEIO.;115)
|
||||
:PREVIOUS-DATE "10-Oct-2022 15:58:01" {DSK}<home>larry>medley>sources>FILEIO.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -668,22 +666,30 @@ Copyright (c) 1981-1993, 1999, 2020-2022 by Venue & Xerox Corporation.
|
||||
T])
|
||||
|
||||
(\STREAM.DEFPRINT
|
||||
[LAMBDA (STRM OUTSTREAM) (* ; "Edited 19-Aug-88 14:01 by bvm")
|
||||
[LAMBDA (STRM OUTSTREAM) (* ; "Edited 10-Oct-2022 15:57 by lmm")
|
||||
(* ; "Edited 9-Oct-2022 08:58 by lmm")
|
||||
(* ; "Edited 19-Aug-88 14:01 by bvm")
|
||||
(LET ((TYPE (SELECTC (fetch ACCESSBITS of STRM)
|
||||
(ReadBit "Input")
|
||||
(OutputBits "Output")
|
||||
(BothBits "IO")
|
||||
(AppendBit "Append")
|
||||
"Closed")))
|
||||
(\DEFPRINT.BY.NAME STRM OUTSTREAM NIL
|
||||
(COND
|
||||
((fetch (STREAM NAMEDP) of STRM) (* ; "Use file name")
|
||||
(CONCAT TYPE " Stream on " (fetch (STREAM FULLFILENAME) of STRM)))
|
||||
(T (* ; "Name the device")
|
||||
(CONCAT TYPE " " [CL:STRING-CAPITALIZE (STRING (fetch (FDEV DEVICENAME)
|
||||
of (fetch DEVICE
|
||||
of STRM]
|
||||
" Stream"])
|
||||
(\DEFPRINT.BY.NAME STRM OUTSTREAM NIL (COND
|
||||
((fetch (STREAM NAMEDP) of STRM)
|
||||
(* ; "Use file name")
|
||||
(CONCAT TYPE " Stream on " (fetch (STREAM
|
||||
FULLFILENAME
|
||||
)
|
||||
of STRM)))
|
||||
((TYPE? FDEV (FETCH DEVICE OF STRM))
|
||||
(* ; "Name the device")
|
||||
(CONCAT TYPE " "
|
||||
[CL:STRING-CAPITALIZE
|
||||
(STRING (fetch (FDEV DEVICENAME)
|
||||
of (fetch DEVICE of STRM]
|
||||
" Stream"))
|
||||
(T (CONCAT TYPE " Stream"])
|
||||
|
||||
(\FDEV.DEFPRINT
|
||||
[LAMBDA (DEV STREAM) (* ; "Edited 8-May-87 15:55 by bvm")
|
||||
@@ -1664,12 +1670,23 @@ update the map")
|
||||
(FDEVOP 'OPENP DEVICE NIL NIL DEVICE])
|
||||
|
||||
(\PRINT-REVALIDATION-RESULT
|
||||
[LAMBDA (RESULT STREAM) (* hdj "26-May-86 15:46")
|
||||
(printout T T T "**** WARNING: The file " (fetch (STREAM FULLNAME) of STREAM))
|
||||
(SELECTQ RESULT
|
||||
(CHANGED (printout T " has been modified since you last accessed it!" T))
|
||||
(DELETED (printout T " was previously opened but has disappeared!" T))
|
||||
(SHOULDNT])
|
||||
[LAMBDA (RESULT STREAM) (* ; "Edited 29-Sep-2022 20:11 by lmm")
|
||||
(* hdj "26-May-86 15:46")
|
||||
|
||||
(* ;; "stack overflow if DRIBBLEFILE; use PROMPTWINDOW")
|
||||
|
||||
(FRESHLINE PROMPTWINDOW)
|
||||
(if [AND (DRIBBLEFILE)
|
||||
(NOT (OPENP (DRIBBLEFILE)
|
||||
'APPEND]
|
||||
THEN (PRINTOUT PROMPTWINDOW "Dribble file " (DRIBBLE)
|
||||
" ended" T))
|
||||
(printout PROMPTWINDOW "**** WARNING: The file " (fetch (STREAM FULLNAME) of STREAM)
|
||||
(SELECTQ RESULT
|
||||
(CHANGED " has been modified since you last accessed it!")
|
||||
(DELETED " was previously opened but has disappeared!")
|
||||
(SHOULDNT))
|
||||
T])
|
||||
|
||||
(\TRUNCATEFILE
|
||||
[LAMBDA (STREAM LASTPAGE LASTOFFSET) (* bvm%: " 8-MAY-82 16:11")
|
||||
@@ -3078,39 +3095,39 @@ update the map")
|
||||
(PUTPROPS FILEIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989
|
||||
1990 1991 1992 1993 1999 2020 2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (27848 31654 (STREAMPROP 27858 . 28292) (GETSTREAMPROP 28294 . 28889) (PUTSTREAMPROP
|
||||
28891 . 31502) (STREAMP 31504 . 31652)) (31697 34216 (\DEFPRINT.BY.NAME 31707 . 32859) (
|
||||
\STREAM.DEFPRINT 32861 . 33909) (\FDEV.DEFPRINT 33911 . 34214)) (34474 39515 (\GETACCESS 34484 . 34938
|
||||
) (\SETACCESS 34940 . 39513)) (59741 65710 (\DEFINEDEVICE 59751 . 62067) (\GETDEVICEFROMNAME 62069 .
|
||||
62542) (\GETDEVICEFROMHOSTNAME 62544 . 63588) (\REMOVEDEVICE 63590 . 64713) (\REMOVEDEVICE.NAMES 64715
|
||||
. 65708)) (65750 90641 (\CLOSEFILE 65760 . 66585) (\DELETEFILE 66587 . 66881) (\DEVICEEVENT 66883 .
|
||||
68653) (\GENERATEFILES 68655 . 69602) (\GENERATENEXTFILE 69604 . 70255) (\GENERATEFILEINFO 70257 .
|
||||
70718) (\GETFILENAME 70720 . 71109) (\GENERIC.OUTFILEP 71111 . 71581) (\OPENFILE 71583 . 74161) (
|
||||
\DO.PARAMS.AT.OPEN 74163 . 76478) (\RENAMEFILE 76480 . 76904) (\REVALIDATEFILE 76906 . 79508) (
|
||||
\PAGED.REVALIDATEFILELST 79510 . 81068) (\PAGED.REVALIDATEFILES 81070 . 82789) (\PAGED.REVALIDATEFILE
|
||||
82791 . 85074) (\BUFFERED.REVALIDATEFILE 85076 . 87362) (\BUFFERED.REVALIDATEFILELST 87364 . 88548) (
|
||||
\PRINT-REVALIDATION-RESULT 88550 . 88965) (\TRUNCATEFILE 88967 . 89358) (\FILE-CONFLICT 89360 . 90639)
|
||||
) (90677 95340 (\GENERATENOFILES 90687 . 92783) (\NULLFILEGENERATOR 92785 . 93029) (\NOFILESNEXTFILEFN
|
||||
93031 . 95022) (\NOFILESINFOFN 95024 . 95338)) (95459 97367 (\FILE.NOT.OPEN 95469 . 95982) (
|
||||
\FILE.WONT.OPEN 95984 . 96312) (\ILLEGAL.DEVICEOP 96314 . 96596) (\IS.NOT.RANDACCESSP 96598 . 97044) (
|
||||
\STREAM.NOT.OPEN 97046 . 97365)) (97502 99800 (\FDEVINSTANCE 97512 . 99798)) (101002 108376 (CNDIR
|
||||
101012 . 102317) (DIRECTORYNAME 102319 . 106502) (DIRECTORYNAMEP 106504 . 107120) (HOSTNAMEP 107122 .
|
||||
107929) (\ADD.CONNECTED.DIR 107931 . 108374)) (108421 136694 (\BACKFILEPTR 108431 . 108619) (
|
||||
\BACKPEEKBIN 108621 . 108982) (\BACKBIN 108984 . 109335) (BIN 109337 . 109554) (\BIN 109556 . 109833)
|
||||
(\BINS 109835 . 110121) (BOUT 110123 . 110485) (\BOUT 110487 . 110802) (\BOUTS 110804 . 111115) (
|
||||
COPYBYTES 111117 . 114449) (COPYCHARS 114451 . 118117) (COPYFILE 118119 . 119183) (\COPYOPENFILE
|
||||
119185 . 122384) (\INFER.FILE.TYPE 122386 . 123340) (EOFP 123342 . 123639) (FORCEOUTPUT 123641 .
|
||||
123888) (\FLUSH.OPEN.STREAMS 123890 . 124246) (CHARSET 124248 . 125912) (ACCESS-CHARSET 125914 .
|
||||
126131) (GETEOFPTR 126133 . 126383) (GETFILEINFO 126385 . 129578) (\TYPE.FROM.FILETYPE 129580 . 130050
|
||||
) (\FILETYPE.FROM.TYPE 130052 . 130231) (GETFILEPTR 130233 . 130485) (SETFILEINFO 130487 . 134593) (
|
||||
SETFILEPTR 134595 . 136314) (BOUT16 136316 . 136501) (BIN16 136503 . 136692)) (136797 142113 (
|
||||
\GENERIC.BINS 136807 . 137087) (\GENERIC.BOUTS 137089 . 137354) (\GENERIC.RENAMEFILE 137356 . 139187)
|
||||
(\GENERIC.OPENP 139189 . 140504) (\GENERIC.READP 140506 . 141658) (\GENERIC.CHARSET 141660 . 142111))
|
||||
(142114 142453 (\MAP-OPEN-STREAMS 142124 . 142451)) (144245 146325 (\EOF.ACTION 144255 . 144506) (
|
||||
\EOSERROR 144508 . 144701) (\GETEOFPTR 144703 . 144885) (\INCFILEPTR 144887 . 145237) (\PEEKBIN 145239
|
||||
. 145430) (\SETCLOSEDFILELENGTH 145432 . 145766) (\SETEOFPTR 145768 . 145956) (\SETFILEPTR 145958 .
|
||||
146323)) (146326 146868 (\FIXPOUT 146336 . 146636) (\FIXPIN 146638 . 146866)) (146869 147435 (\BOUTEOL
|
||||
146879 . 147433)) (150331 160195 (\BUFFERED.BIN 150341 . 151193) (\BUFFERED.PEEKBIN 151195 . 151977)
|
||||
(\BUFFERED.BOUT 151979 . 152839) (\BUFFERED.BINS 152841 . 156526) (\BUFFERED.BOUTS 156528 . 158329) (
|
||||
\BUFFERED.COPYBYTES 158331 . 160193)))))
|
||||
(FILEMAP (NIL (27805 31611 (STREAMPROP 27815 . 28249) (GETSTREAMPROP 28251 . 28846) (PUTSTREAMPROP
|
||||
28848 . 31459) (STREAMP 31461 . 31609)) (31654 35033 (\DEFPRINT.BY.NAME 31664 . 32816) (
|
||||
\STREAM.DEFPRINT 32818 . 34726) (\FDEV.DEFPRINT 34728 . 35031)) (35291 40332 (\GETACCESS 35301 . 35755
|
||||
) (\SETACCESS 35757 . 40330)) (60558 66527 (\DEFINEDEVICE 60568 . 62884) (\GETDEVICEFROMNAME 62886 .
|
||||
63359) (\GETDEVICEFROMHOSTNAME 63361 . 64405) (\REMOVEDEVICE 64407 . 65530) (\REMOVEDEVICE.NAMES 65532
|
||||
. 66525)) (66567 91885 (\CLOSEFILE 66577 . 67402) (\DELETEFILE 67404 . 67698) (\DEVICEEVENT 67700 .
|
||||
69470) (\GENERATEFILES 69472 . 70419) (\GENERATENEXTFILE 70421 . 71072) (\GENERATEFILEINFO 71074 .
|
||||
71535) (\GETFILENAME 71537 . 71926) (\GENERIC.OUTFILEP 71928 . 72398) (\OPENFILE 72400 . 74978) (
|
||||
\DO.PARAMS.AT.OPEN 74980 . 77295) (\RENAMEFILE 77297 . 77721) (\REVALIDATEFILE 77723 . 80325) (
|
||||
\PAGED.REVALIDATEFILELST 80327 . 81885) (\PAGED.REVALIDATEFILES 81887 . 83606) (\PAGED.REVALIDATEFILE
|
||||
83608 . 85891) (\BUFFERED.REVALIDATEFILE 85893 . 88179) (\BUFFERED.REVALIDATEFILELST 88181 . 89365) (
|
||||
\PRINT-REVALIDATION-RESULT 89367 . 90209) (\TRUNCATEFILE 90211 . 90602) (\FILE-CONFLICT 90604 . 91883)
|
||||
) (91921 96584 (\GENERATENOFILES 91931 . 94027) (\NULLFILEGENERATOR 94029 . 94273) (\NOFILESNEXTFILEFN
|
||||
94275 . 96266) (\NOFILESINFOFN 96268 . 96582)) (96703 98611 (\FILE.NOT.OPEN 96713 . 97226) (
|
||||
\FILE.WONT.OPEN 97228 . 97556) (\ILLEGAL.DEVICEOP 97558 . 97840) (\IS.NOT.RANDACCESSP 97842 . 98288) (
|
||||
\STREAM.NOT.OPEN 98290 . 98609)) (98746 101044 (\FDEVINSTANCE 98756 . 101042)) (102246 109620 (CNDIR
|
||||
102256 . 103561) (DIRECTORYNAME 103563 . 107746) (DIRECTORYNAMEP 107748 . 108364) (HOSTNAMEP 108366 .
|
||||
109173) (\ADD.CONNECTED.DIR 109175 . 109618)) (109665 137938 (\BACKFILEPTR 109675 . 109863) (
|
||||
\BACKPEEKBIN 109865 . 110226) (\BACKBIN 110228 . 110579) (BIN 110581 . 110798) (\BIN 110800 . 111077)
|
||||
(\BINS 111079 . 111365) (BOUT 111367 . 111729) (\BOUT 111731 . 112046) (\BOUTS 112048 . 112359) (
|
||||
COPYBYTES 112361 . 115693) (COPYCHARS 115695 . 119361) (COPYFILE 119363 . 120427) (\COPYOPENFILE
|
||||
120429 . 123628) (\INFER.FILE.TYPE 123630 . 124584) (EOFP 124586 . 124883) (FORCEOUTPUT 124885 .
|
||||
125132) (\FLUSH.OPEN.STREAMS 125134 . 125490) (CHARSET 125492 . 127156) (ACCESS-CHARSET 127158 .
|
||||
127375) (GETEOFPTR 127377 . 127627) (GETFILEINFO 127629 . 130822) (\TYPE.FROM.FILETYPE 130824 . 131294
|
||||
) (\FILETYPE.FROM.TYPE 131296 . 131475) (GETFILEPTR 131477 . 131729) (SETFILEINFO 131731 . 135837) (
|
||||
SETFILEPTR 135839 . 137558) (BOUT16 137560 . 137745) (BIN16 137747 . 137936)) (138041 143357 (
|
||||
\GENERIC.BINS 138051 . 138331) (\GENERIC.BOUTS 138333 . 138598) (\GENERIC.RENAMEFILE 138600 . 140431)
|
||||
(\GENERIC.OPENP 140433 . 141748) (\GENERIC.READP 141750 . 142902) (\GENERIC.CHARSET 142904 . 143355))
|
||||
(143358 143697 (\MAP-OPEN-STREAMS 143368 . 143695)) (145489 147569 (\EOF.ACTION 145499 . 145750) (
|
||||
\EOSERROR 145752 . 145945) (\GETEOFPTR 145947 . 146129) (\INCFILEPTR 146131 . 146481) (\PEEKBIN 146483
|
||||
. 146674) (\SETCLOSEDFILELENGTH 146676 . 147010) (\SETEOFPTR 147012 . 147200) (\SETFILEPTR 147202 .
|
||||
147567)) (147570 148112 (\FIXPOUT 147580 . 147880) (\FIXPIN 147882 . 148110)) (148113 148679 (\BOUTEOL
|
||||
148123 . 148677)) (151575 161439 (\BUFFERED.BIN 151585 . 152437) (\BUFFERED.PEEKBIN 152439 . 153221)
|
||||
(\BUFFERED.BOUT 153223 . 154083) (\BUFFERED.BINS 154085 . 157770) (\BUFFERED.BOUTS 157772 . 159573) (
|
||||
\BUFFERED.COPYBYTES 159575 . 161437)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,16 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Jul-2022 17:14:14"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>HARDCOPY.;7 103298
|
||||
(FILECREATED "18-Oct-2022 18:47:42" {DSK}<home>larry>ilisp>medley>sources>HARDCOPY.;2 103854
|
||||
|
||||
:CHANGES-TO (FNS COPY.TEXT.TO.IMAGE)
|
||||
:CHANGES-TO (FNS HARDCOPYIMAGEW.TOPRINTER)
|
||||
|
||||
:PREVIOUS-DATE "19-Jul-2022 23:40:21"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>HARDCOPY.;6)
|
||||
:PREVIOUS-DATE "20-Jul-2022 17:14:14" {DSK}<home>larry>ilisp>medley>sources>HARDCOPY.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT HARDCOPYCOMS)
|
||||
@@ -129,10 +127,18 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(CDR FILE&TYPE])
|
||||
|
||||
(HARDCOPYIMAGEW.TOPRINTER
|
||||
[LAMBDA (W) (* ; "Edited 22-Apr-98 16:19 by rmk:")
|
||||
(* ; "Edited 11-Jul-90 13:55 by jds")
|
||||
[LAMBDA (W) (* ; "Edited 18-Oct-2022 18:45 by lmm")
|
||||
(* ; "Edited 22-Apr-98 16:19 by rmk:")
|
||||
(* ; "Edited 11-Jul-90 13:55 by jds")
|
||||
(LET ((PRINTERCHOICE (GetPrinterName))
|
||||
PRINTERTYPE IMAGETYPE)
|
||||
[COND
|
||||
((LISTP PRINTERCHOICE) (* ;
|
||||
"Got back a list, which is (TYPE NAME). Break it apart.")
|
||||
(SETQ PRINTERTYPE (CAR PRINTERCHOICE))
|
||||
(SETQ PRINTERCHOICE (CADR PRINTERCHOICE)))
|
||||
(PRINTERCHOICE (* ; "Got back just a name.")
|
||||
(SETQ PRINTERTYPE (PRINTERTYPE PRINTERCHOICE]
|
||||
(SETQ PRINTERTYPE (PRINTERTYPE PRINTERCHOICE))
|
||||
(COND
|
||||
(PRINTERCHOICE (HARDCOPY.SOMEHOW W (CONCAT "{LPT}" PRINTERCHOICE)
|
||||
@@ -1075,42 +1081,42 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992
|
||||
1993 1999 2018 2021))
|
||||
1993 1999 2018 2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6199 10383 (HARDCOPY.SOMEHOW 6209 . 7567) (HARDCOPYIMAGEW 7569 . 7721) (
|
||||
HARDCOPYIMAGEW.TOFILE 7723 . 8031) (HARDCOPYIMAGEW.TOPRINTER 8033 . 8698) (HARDCOPYREGION.TOFILE 8700
|
||||
. 8998) (HARDCOPYREGION.TOPRINTER 9000 . 9622) (COPY.WINDOW.TO.BITMAP 9624 . 10381)) (10455 21005 (
|
||||
MakeMenuOfPrinters 10465 . 11690) (PRINTERS.WHENSELECTEDFN 11692 . 13434) (MakeMenuOfImageTypes 13436
|
||||
. 13954) (GetNewPrinterFromUser 13956 . 14384) (PopUpWindowAndGetAtom 14386 . 15771) (
|
||||
PopUpWindowAndGetList 15773 . 17339) (NewPrinter 17341 . 18289) (GetPrinterName 18291 . 18571) (
|
||||
GetImageFile 18573 . 20860) (FetchDefaultPrinter 20862 . 21003)) (21040 21578 (
|
||||
ExtensionForPrintFileType 21050 . 21243) (PRINTFILETYPE.FROM.EXTENSION 21245 . 21576)) (21633 38017 (
|
||||
DEFAULTPRINTER 21643 . 21803) (CAN.PRINT.DIRECTLY 21805 . 21961) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
|
||||
21963 . 23007) (EMPRESS 23009 . 23322) (HARDCOPYW 23324 . 26284) (LISTFILES1 26286 . 26459) (
|
||||
PRINTER.BITMAPFILE 26461 . 26708) (PRINTER.BITMAPSCALE 26710 . 26975) (PRINTER.SCRATCH.FILE 26977 .
|
||||
27100) (PRINTERPROP 27102 . 27285) (PRINTERSTATUS 27287 . 27476) (PRINTERTYPE 27478 . 29787) (
|
||||
PRINTERNAME 29789 . 30091) (PRINTFILEPROP 30093 . 30284) (PRINTFILETYPE 30286 . 32230) (
|
||||
\EXPECTED.FILE.TYPE 32232 . 33014) (SEND.FILE.TO.PRINTER 33016 . 38015)) (38018 43000 (PRINTERDEVICE
|
||||
38028 . 42998)) (43815 51573 (TEXTTOIMAGEFILE 43825 . 46015) (COPY.TEXT.TO.IMAGE 46017 . 51571)) (
|
||||
51574 52709 (\BLTSHADE.GENERICPRINTER 51584 . 52707)) (52837 71589 (MAKEHARDCOPYSTREAM 52847 . 53851)
|
||||
(UNMAKEHARDCOPYSTREAM 53853 . 54537) (HARDCOPYSTREAMTYPE 54539 . 54818) (\CHARWIDTH.HDCPYDISPLAY 54820
|
||||
. 55251) (\DSPFONT.HDCPYDISPLAY 55253 . 56658) (\DSPRIGHTMARGIN.HDCPYDISPLAY 56660 . 57237) (
|
||||
\DSPXPOSITION.HDCPYDISPLAY 57239 . 57500) (\DSPYPOSITION.HDCPYDISPLAY 57502 . 57763) (
|
||||
\STRINGWIDTH.HDCPYDISPLAY 57765 . 58272) (\STRINGWIDTH.HCPYDISPLAYAUX 58274 . 60606) (\HDCPYBLTCHAR
|
||||
60608 . 63143) (\HDCPYDISPLAY.FIX.XPOS 63145 . 63565) (\HDCPYDISPLAY.FIX.YPOS 63567 . 63987) (
|
||||
\HDCPYDISPLAYINIT 63989 . 64766) (\HDCPYDSPPRINTCHAR 64768 . 66928) (\SLOWHDCPYBLTCHAR 66930 . 70433)
|
||||
(\CHANGECHARSET.HDCPYDISPLAY 70435 . 71587)) (71999 72140 (\MICASTOPTS 71999 . 72140)) (72311 102608 (
|
||||
MAKEHARDCOPYMODESTREAM 72321 . 74230) (UNMAKEHARDCOPYMODESTREAM 74232 . 75310) (\BLTSHADE.HCPYMODE
|
||||
75312 . 75759) (\BITBLT.HCPYMODE 75761 . 76383) (\BRUSHCONVERT.HCPYMODE 76385 . 76622) (
|
||||
\CHANGECHARSET.HCPYMODE 76624 . 78391) (\DASHINGCONVERT.HCPYMODE 78393 . 78656) (\CHARWIDTH.HCPYMODE
|
||||
78658 . 78945) (\DRAWLINE.HCPYMODE 78947 . 79259) (\DRAWCURVE.HCPYMODE 79261 . 79690) (
|
||||
\DRAWCIRCLE.HCPYMODE 79692 . 80087) (\DRAWELLIPSE.HCPYMODE 80089 . 80601) (\DSPFONT.HCPYMODE 80603 .
|
||||
81759) (\DSPLEFTMARGIN.HCPYMODE 81761 . 82345) (\DSPLINEFEED.HCPYMODE 82347 . 82757) (
|
||||
\DSPRIGHTMARGIN.HCPYMODE 82759 . 83388) (\DSPSPACEFACTOR.HCPYMODE 83390 . 83911) (
|
||||
\DSPXPOSITION.HCPYMODE 83913 . 84494) (\DSPYPOSITION.HCPYMODE 84496 . 84901) (\MOVETO.HCPYMODE 84903
|
||||
. 85055) (\FONTCREATE.HCPYMODE.PRESS 85057 . 86069) (\CREATECHARSET.HCPYMODE.PRESS 86071 . 87042) (
|
||||
\FONTCREATE.HCPYMODE.INTERPRESS 87044 . 88078) (\CREATECHARSET.HCPYMODE.INTERPRESS 88080 . 89068) (
|
||||
\STRINGWIDTH.HCPYMODE 89070 . 89504) (\HCPYMODEBLTCHAR 89506 . 92475) (\HCPYMODEDISPLAYINIT 92477 .
|
||||
95408) (\HCPYMODEDSPPRINTCHAR 95410 . 97591) (\SLOWHCPYMODEBLTCHAR 97593 . 101107) (\SFFixY.HCPYMODE
|
||||
101109 . 102606)))))
|
||||
(FILEMAP (NIL (6168 10934 (HARDCOPY.SOMEHOW 6178 . 7536) (HARDCOPYIMAGEW 7538 . 7690) (
|
||||
HARDCOPYIMAGEW.TOFILE 7692 . 8000) (HARDCOPYIMAGEW.TOPRINTER 8002 . 9249) (HARDCOPYREGION.TOFILE 9251
|
||||
. 9549) (HARDCOPYREGION.TOPRINTER 9551 . 10173) (COPY.WINDOW.TO.BITMAP 10175 . 10932)) (11006 21556 (
|
||||
MakeMenuOfPrinters 11016 . 12241) (PRINTERS.WHENSELECTEDFN 12243 . 13985) (MakeMenuOfImageTypes 13987
|
||||
. 14505) (GetNewPrinterFromUser 14507 . 14935) (PopUpWindowAndGetAtom 14937 . 16322) (
|
||||
PopUpWindowAndGetList 16324 . 17890) (NewPrinter 17892 . 18840) (GetPrinterName 18842 . 19122) (
|
||||
GetImageFile 19124 . 21411) (FetchDefaultPrinter 21413 . 21554)) (21591 22129 (
|
||||
ExtensionForPrintFileType 21601 . 21794) (PRINTFILETYPE.FROM.EXTENSION 21796 . 22127)) (22184 38568 (
|
||||
DEFAULTPRINTER 22194 . 22354) (CAN.PRINT.DIRECTLY 22356 . 22512) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
|
||||
22514 . 23558) (EMPRESS 23560 . 23873) (HARDCOPYW 23875 . 26835) (LISTFILES1 26837 . 27010) (
|
||||
PRINTER.BITMAPFILE 27012 . 27259) (PRINTER.BITMAPSCALE 27261 . 27526) (PRINTER.SCRATCH.FILE 27528 .
|
||||
27651) (PRINTERPROP 27653 . 27836) (PRINTERSTATUS 27838 . 28027) (PRINTERTYPE 28029 . 30338) (
|
||||
PRINTERNAME 30340 . 30642) (PRINTFILEPROP 30644 . 30835) (PRINTFILETYPE 30837 . 32781) (
|
||||
\EXPECTED.FILE.TYPE 32783 . 33565) (SEND.FILE.TO.PRINTER 33567 . 38566)) (38569 43551 (PRINTERDEVICE
|
||||
38579 . 43549)) (44366 52124 (TEXTTOIMAGEFILE 44376 . 46566) (COPY.TEXT.TO.IMAGE 46568 . 52122)) (
|
||||
52125 53260 (\BLTSHADE.GENERICPRINTER 52135 . 53258)) (53388 72140 (MAKEHARDCOPYSTREAM 53398 . 54402)
|
||||
(UNMAKEHARDCOPYSTREAM 54404 . 55088) (HARDCOPYSTREAMTYPE 55090 . 55369) (\CHARWIDTH.HDCPYDISPLAY 55371
|
||||
. 55802) (\DSPFONT.HDCPYDISPLAY 55804 . 57209) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57211 . 57788) (
|
||||
\DSPXPOSITION.HDCPYDISPLAY 57790 . 58051) (\DSPYPOSITION.HDCPYDISPLAY 58053 . 58314) (
|
||||
\STRINGWIDTH.HDCPYDISPLAY 58316 . 58823) (\STRINGWIDTH.HCPYDISPLAYAUX 58825 . 61157) (\HDCPYBLTCHAR
|
||||
61159 . 63694) (\HDCPYDISPLAY.FIX.XPOS 63696 . 64116) (\HDCPYDISPLAY.FIX.YPOS 64118 . 64538) (
|
||||
\HDCPYDISPLAYINIT 64540 . 65317) (\HDCPYDSPPRINTCHAR 65319 . 67479) (\SLOWHDCPYBLTCHAR 67481 . 70984)
|
||||
(\CHANGECHARSET.HDCPYDISPLAY 70986 . 72138)) (72550 72691 (\MICASTOPTS 72550 . 72691)) (72862 103159 (
|
||||
MAKEHARDCOPYMODESTREAM 72872 . 74781) (UNMAKEHARDCOPYMODESTREAM 74783 . 75861) (\BLTSHADE.HCPYMODE
|
||||
75863 . 76310) (\BITBLT.HCPYMODE 76312 . 76934) (\BRUSHCONVERT.HCPYMODE 76936 . 77173) (
|
||||
\CHANGECHARSET.HCPYMODE 77175 . 78942) (\DASHINGCONVERT.HCPYMODE 78944 . 79207) (\CHARWIDTH.HCPYMODE
|
||||
79209 . 79496) (\DRAWLINE.HCPYMODE 79498 . 79810) (\DRAWCURVE.HCPYMODE 79812 . 80241) (
|
||||
\DRAWCIRCLE.HCPYMODE 80243 . 80638) (\DRAWELLIPSE.HCPYMODE 80640 . 81152) (\DSPFONT.HCPYMODE 81154 .
|
||||
82310) (\DSPLEFTMARGIN.HCPYMODE 82312 . 82896) (\DSPLINEFEED.HCPYMODE 82898 . 83308) (
|
||||
\DSPRIGHTMARGIN.HCPYMODE 83310 . 83939) (\DSPSPACEFACTOR.HCPYMODE 83941 . 84462) (
|
||||
\DSPXPOSITION.HCPYMODE 84464 . 85045) (\DSPYPOSITION.HCPYMODE 85047 . 85452) (\MOVETO.HCPYMODE 85454
|
||||
. 85606) (\FONTCREATE.HCPYMODE.PRESS 85608 . 86620) (\CREATECHARSET.HCPYMODE.PRESS 86622 . 87593) (
|
||||
\FONTCREATE.HCPYMODE.INTERPRESS 87595 . 88629) (\CREATECHARSET.HCPYMODE.INTERPRESS 88631 . 89619) (
|
||||
\STRINGWIDTH.HCPYMODE 89621 . 90055) (\HCPYMODEBLTCHAR 90057 . 93026) (\HCPYMODEDISPLAYINIT 93028 .
|
||||
95959) (\HCPYMODEDSPPRINTCHAR 95961 . 98142) (\SLOWHCPYMODEBLTCHAR 98144 . 101658) (\SFFixY.HCPYMODE
|
||||
101660 . 103157)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,6 +1,6 @@
|
||||
(* "make init files; this file is loaded as a 'greet' file by scripts/loadup-init.sh")
|
||||
|
||||
(LOAD? (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM"))
|
||||
(LOAD (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM"))
|
||||
(CNDIR (MEDLEYDIR "tmp"))
|
||||
(DRIBBLE "init.dribble")
|
||||
|
||||
|
||||
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "18-Jul-2022 12:12:11" {DSK}<home>larry>medley>sources>MEDLEYDIR.;2 6649
|
||||
(FILECREATED "25-Oct-2022 12:19:14" {DSK}<home>larry>ilisp>medley>sources>MEDLEYDIR.;11 9572
|
||||
|
||||
:CHANGES-TO (FNS MEDLEY-INIT-VARS)
|
||||
|
||||
:PREVIOUS-DATE "13-Jul-2022 15:34:07" {DSK}<home>larry>medley>sources>MEDLEYDIR.;1)
|
||||
:PREVIOUS-DATE "24-Oct-2022 22:35:01" {DSK}<home>larry>ilisp>medley>sources>MEDLEYDIR.;10)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIRCOMS)
|
||||
@@ -13,18 +13,16 @@
|
||||
[
|
||||
(* ;; "set up initialization for file paths relative to where Medley is installed. This assumes that the environment variable MEDLEYDIR is set (usually by the ./run-medley script) to the (unix path) and all of the other directories variables are set relative to that (by MEDLEY-INIT-VARS)")
|
||||
|
||||
(FNS MEDLEY-INIT-VARS MEDLEYDIR)
|
||||
(INITVARS (MEDLEYDIR))
|
||||
(ADDVARS (BEFORESYSOUTFORMS (SETQ MEDLEYDIR))
|
||||
(BEFOREMAKESYSFORMS (SETQ MEDLEYDIR))
|
||||
(AFTERSYSOUTFORMS (MEDLEY-INIT-VARS))
|
||||
(AFTERMAKESYSFORMS (MEDLEY-INIT-VARS)))
|
||||
(FNS MEDLEY-INIT-VARS MEDLEYDIR MEDLEYSUBSTDIR)
|
||||
(INITVARS (MEDLEYDIR)
|
||||
(\SAVE.MEDLEYDIR))
|
||||
(ADDVARS (AROUNDEXITFNS MEDLEY-INIT-VARS))
|
||||
|
||||
(* ;;
|
||||
"NOTE: Do not use backquote in the variable definitions. These get evaluated early in the loadup.")
|
||||
(* ;; "**WARNING** The EVALed expressions get run early in the lodup.")
|
||||
|
||||
(VARS MEDLEY-INIT-VARS)
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS])
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS
|
||||
\SAVE.MEDLEYDIR DIRECTORIES])
|
||||
|
||||
|
||||
|
||||
@@ -35,89 +33,129 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MEDLEY-INIT-VARS
|
||||
[LAMBDA (CLEAR) (* ; "Edited 18-Jul-2022 12:11 by larry")
|
||||
(* ; "Edited 21-Aug-2021 18:23 by larry")
|
||||
[LAMBDA (EVENT) (* ; "Edited 25-Oct-2022 12:18 by lmm")
|
||||
(* ; "Edited 18-Oct-2022 18:08 by lmm")
|
||||
|
||||
(* ;; "MEDLEY-INIT-VARS has variables that might need to get reset. ")
|
||||
(* ;; "Called on events including before & after loadup")
|
||||
|
||||
(if CLEAR
|
||||
then (SETQ MEDLEYDIR NIL)
|
||||
(SETQ XCL::*WHERE-IS-CASH-FILES* NIL)
|
||||
(for X in MEDLEY-INIT-VARS do (SET (CAR X)))
|
||||
elseif [OR (NOT (BOUNDP 'MEDLEYDIR))
|
||||
(AND (NULL MEDLEYDIR)
|
||||
(NULL (MEDLEYDIR]
|
||||
then (PRINTOUT T "WARNING: MEDLEYDIR not set correctly"
|
||||
" set it and call (MEDLEY-INIT-VARS) again" T)
|
||||
else [for X in MEDLEY-INIT-VARS do (SET (CAR X)
|
||||
(EVAL (CADR X]
|
||||
(SELECTQ EVENT
|
||||
((BEFOREMAKESYS T)
|
||||
(* ;; "Clear old values")
|
||||
|
||||
(* ;; "WHEREIS doesn't follow conventions")
|
||||
(FOR X IN MEDLEY-INIT-VARS DO (IF (CDDR X)
|
||||
THEN (SETTOPVAL (CAR X)
|
||||
NIL)))
|
||||
(SETQ \SAVE.MEDLEYDIR NIL))
|
||||
((BEFORESYSOUT BEFORELOGOUT BEFORESAVEVM)
|
||||
(* ;; "save old values")
|
||||
|
||||
[LET [(NEWSYS (STRPOS "tmp/" (UNIX-GETENV "LDESRCESYSOUT"]
|
||||
(if NEWSYS
|
||||
then (push DIRECTORIES (MEDLEYDIR "tmp")))
|
||||
(CL:WHEN (GETD 'XCL::ADD-WHERE-IS-DATABASE)
|
||||
(SETQ XCL::*WHERE-IS-CASH-FILES* NIL)
|
||||
(NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR (if NEWSYS
|
||||
then "tmp"
|
||||
else "loadups")
|
||||
"WHEREIS.HASH"))))]
|
||||
NIL])
|
||||
[SETQ \SAVE.MEDLEYDIR (CONS MEDLEYDIR (FOR X IN MEDLEY-INIT-VARS
|
||||
COLLECT (CONS (CAR X)
|
||||
(GETTOPVAL (CAR X])
|
||||
((AFTERSYSOUT AFTERMAKESYS AFTERLOGOUT AFTERSAVEVM RESTART INIT NIL)
|
||||
|
||||
(* ;;
|
||||
"Any old values, restore them, substituting the new MEDLEYDIR")
|
||||
|
||||
(PROG (OLDMD NEWMD SAME TMP)
|
||||
(IF (EQ \SAVE.MEDLEYDIR T)
|
||||
THEN (* ; " Already restored")
|
||||
(RETURN))
|
||||
(IF \SAVE.MEDLEYDIR
|
||||
THEN (SETQ OLDMD (U-CASE (CAR \SAVE.MEDLEYDIR)))
|
||||
(SETQ MEDLEYDIR)
|
||||
(SETQ NEWMD (MEDLEYDIR))
|
||||
(SETQ SAME (STRING-EQUAL OLDMD NEWMD)))
|
||||
[for X in MEDLEY-INIT-VARS
|
||||
do (/SETTOPVAL (CAR X)
|
||||
(IF [OR (EQ (CADDR X)
|
||||
'RESET)
|
||||
(NOT (SETQ TMP (ASSOC (CAR X)
|
||||
(CDR \SAVE.MEDLEYDIR]
|
||||
THEN
|
||||
(* ;; "either RESET or no saved value")
|
||||
|
||||
(EVAL (CADR X))
|
||||
ELSEIF SAME
|
||||
THEN (CDR TMP)
|
||||
ELSE (MEDLEYSUBSTDIR OLDMD NEWMD (CDR TMP]
|
||||
(SETQ \SAVE.MEDLEYDIR T) (* ; "only use once")
|
||||
))
|
||||
(PROGN (* ; "no changes")
|
||||
NIL])
|
||||
|
||||
(MEDLEYDIR
|
||||
[LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 5-Mar-2022 12:43 by larry")
|
||||
[LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 18-Oct-2022 17:49 by lmm")
|
||||
(* ; "Edited 5-Mar-2022 12:43 by larry")
|
||||
(* ; "Edited 2-Dec-2021 20:23 by kaplan")
|
||||
(DECLARE (GLOBALVARS MEDLEYDIR))
|
||||
(DECLARE (GLOBALVARS MEDLEYDIR))
|
||||
(if (NULL DIRNAME)
|
||||
then (if (OR (NOT (BOUNDP 'MEDLEYDIR))
|
||||
(NOT MEDLEYDIR))
|
||||
then (OR (SETQ MEDLEYDIR (DIRECTORYNAME (OR (UNIX-GETENV "MEDLEYDIR")
|
||||
T)))
|
||||
(DIRECTORYNAME T))
|
||||
elseif (STRPOS "/" MEDLEYDIR)
|
||||
then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR))
|
||||
else MEDLEYDIR)
|
||||
elseif (LISTP DIRNAME)
|
||||
then (for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) collect Y)
|
||||
elseif FILENAME
|
||||
then [if (NULL (SETQ DIRNAME (MEDLEYDIR DIRNAME NIL OUTPUT NOERROR)))
|
||||
then (OR NOERROR (SHOULDNT))
|
||||
NIL
|
||||
else (SETQ FILENAME (CONCAT DIRNAME FILENAME))
|
||||
(if OUTPUT
|
||||
then FILENAME
|
||||
else (OR (INFILEP FILENAME)
|
||||
(if NOERROR
|
||||
then NIL
|
||||
else (ERROR "No such medley file" FILENAME]
|
||||
else (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR)
|
||||
DIRNAME ">")
|
||||
NIL OUTPUT)
|
||||
(if NOERROR
|
||||
then NIL
|
||||
else (ERROR "No such medley directory" DIRNAME])
|
||||
(COND
|
||||
((NULL DIRNAME)
|
||||
(if (OR (NOT (BOUNDP 'MEDLEYDIR))
|
||||
(NOT MEDLEYDIR))
|
||||
then (OR (SETQ MEDLEYDIR (DIRECTORYNAME (OR (UNIX-GETENV "MEDLEYDIR")
|
||||
T)))
|
||||
(DIRECTORYNAME T))
|
||||
elseif (STRPOS "/" MEDLEYDIR)
|
||||
then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR))
|
||||
else MEDLEYDIR))
|
||||
[(EQUAL DIRNAME "login") (* ; "special case for login dir")
|
||||
(DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME"]
|
||||
((LISTP DIRNAME)
|
||||
(for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) collect Y))
|
||||
[FILENAME (if (NULL (SETQ DIRNAME (MEDLEYDIR DIRNAME NIL OUTPUT NOERROR)))
|
||||
then (OR NOERROR (SHOULDNT))
|
||||
NIL
|
||||
else (SETQ FILENAME (CONCAT DIRNAME FILENAME))
|
||||
(if OUTPUT
|
||||
then FILENAME
|
||||
else (OR (INFILEP FILENAME)
|
||||
(if NOERROR
|
||||
then NIL
|
||||
else (ERROR "No such medley file" FILENAME]
|
||||
(T (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR)
|
||||
DIRNAME ">")
|
||||
NIL OUTPUT)
|
||||
(if NOERROR
|
||||
then NIL
|
||||
else (ERROR "No such medley directory" DIRNAME])
|
||||
|
||||
(MEDLEYSUBSTDIR
|
||||
[LAMBDA (OLD NEW BODY) (* ;
|
||||
"Edited 18-Oct-2022 18:06 by lmm: assumes OLD is upper case")
|
||||
(IF (NULL BODY)
|
||||
THEN NIL
|
||||
ELSEIF (LISTP BODY)
|
||||
THEN (LET [(A (MEDLEYSUBSTDIR OLD NEW (CAR BODY)))
|
||||
(D (MEDLEYSUBSTDIR OLD NEW (CDR BODY]
|
||||
(IF (AND (EQ A (CAR BODY))
|
||||
(EQ D (CDR BODY)))
|
||||
THEN BODY
|
||||
ELSE (CONS A D)))
|
||||
ELSEIF (STRINGP BODY)
|
||||
THEN (IF (EQ 1 (STRPOS OLD (U-CASE BODY)
|
||||
1))
|
||||
THEN [CONCAT NEW (SUBSTRING BODY (ADD1 (NCHARS OLD]
|
||||
ELSE BODY)
|
||||
ELSEIF [AND (LITATOM BODY)
|
||||
(EQ 1 (STRPOS OLD (U-CASE (MKSTRING BODY]
|
||||
THEN [PACK* NEW (SUBSTRING BODY (ADD1 (NCHARS OLD]
|
||||
ELSE BODY])
|
||||
)
|
||||
|
||||
(RPAQ? MEDLEYDIR )
|
||||
|
||||
(ADDTOVAR BEFORESYSOUTFORMS (SETQ MEDLEYDIR))
|
||||
(RPAQ? \SAVE.MEDLEYDIR )
|
||||
|
||||
(ADDTOVAR BEFOREMAKESYSFORMS (SETQ MEDLEYDIR))
|
||||
|
||||
(ADDTOVAR AFTERSYSOUTFORMS (MEDLEY-INIT-VARS))
|
||||
|
||||
(ADDTOVAR AFTERMAKESYSFORMS (MEDLEY-INIT-VARS))
|
||||
(ADDTOVAR AROUNDEXITFNS MEDLEY-INIT-VARS)
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"NOTE: Do not use backquote in the variable definitions. These get evaluated early in the loadup.")
|
||||
(* ;; "**WARNING** The EVALed expressions get run early in the lodup.")
|
||||
|
||||
|
||||
(RPAQQ MEDLEY-INIT-VARS
|
||||
([LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
|
||||
[[LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
|
||||
[LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"]
|
||||
(LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES))
|
||||
(IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo"))
|
||||
@@ -136,11 +174,23 @@
|
||||
NIL NIL T))
|
||||
(UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox")
|
||||
NIL NIL T))
|
||||
(XCL::*WHERE-IS-CASH-FILES*)))
|
||||
(LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME")))
|
||||
RESET)
|
||||
(USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM))
|
||||
(CONS LOGINHOST/DIR '("INIT"]
|
||||
RESET)
|
||||
(XCL::*WHERE-IS-CASH-FILES* (COND ((GETD 'XCL::ADD-WHERE-IS-DATABASE)
|
||||
(SETQ XCL::*WHERE-IS-CASH-FILES* NIL)
|
||||
(NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR "loadups"
|
||||
"WHEREIS.HASH"
|
||||
NIL T)))
|
||||
XCL::*WHERE-IS-CASH-FILES*])
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY
|
||||
|
||||
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS)
|
||||
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1518 4925 (MEDLEY-INIT-VARS 1528 . 3139) (MEDLEYDIR 3141 . 4923)))))
|
||||
(FILEMAP (NIL (1459 7197 (MEDLEY-INIT-VARS 1469 . 4258) (MEDLEYDIR 4260 . 6215) (MEDLEYSUBSTDIR 6217
|
||||
. 7195)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user