github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-13 15:37:38 +00:00
Code Issues Projects Releases Wiki Activity

Merge pull request #645 from Interlisp/lmm15

Browse Source 
Lmm15
This commit is contained in:
rmkaplan 2022-01-20 22:38:20 -08:00 committed by GitHub
commit 27d4df45e6
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 181 additions and 164 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

105
internal/library/MEDLEY-UTILS
View File

@ -1,43 +1,41 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "25-Oct-2021 14:54:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;14| 9472 (FILECREATED "26-Dec-2021 18:58:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;2| 9049
|changes| |to:| (VARS MEDLEY-UTILSCOMS) :CHANGES-TO (FNS GATHER-INFO)
(FNS GATHER-INFO)
|previous| |date:| "23-Oct-2021 14:53:16" :PREVIOUS-DATE "25-Oct-2021 14:54:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;1|
|{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;2|) )
(PRETTYCOMPRINT MEDLEY-UTILSCOMS) (PRETTYCOMPRINT MEDLEY-UTILSCOMS)
(RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MEDLEY-FIX-LINKS MEDLEY-FIX-DATES) (RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
(VARS MEDLEY-FIX-DIRS) (VARS MEDLEY-FIX-DIRS)
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH))) (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
(DEFINEQ (DEFINEQ
(GATHER-INFO (GATHER-INFO
(LAMBDA (PHASE) (* \; (LAMBDA (PHASE) (* \;
 "Edited 24-Oct-2021 09:43 by larry")  "Edited 26-Dec-2021 18:56 by larry")
(* \;
 "Edited 24-Oct-2021 09:43 by larry")
(SELECTQ PHASE (SELECTQ PHASE
(ALL (SETQ SYSFILES (UNION SYSFILES FILELST)) (ALL (|for| I |from| 0 |to| 4 |do| (GATHER-INFO I)))
(SETQ FILELST NIL) (0 (SETQ SYSFILES (UNION SYSFILES FILELST))
(FILESLOAD (SOURCE) (SETQ FILELST NIL)
SYSEDIT) (FILESLOAD (SOURCE)
(|for| I |from| 1 |to| 4 |do| (GATHER-INFO I))) SYSEDIT))
(1 (SETQ LOADEDFILES (|for| X |in| LOADEDFILELST |collect| (FILENAMEFIELD (1 (SETQ LOADEDFILES (|for| X |in| LOADEDFILELST |collect| (FILENAMEFIELD X 'NAME)))
X
'NAME)))
(FILESLOAD FILESETS) (FILESLOAD FILESETS)
(SETQ ALLFILESETSFILES (|for| X |in| FILESETS |join| (APPEND (EVAL X)))) (SETQ ALLFILESETSFILES (|for| X |in| FILESETS |join| (APPEND (EVAL X))))
(SETQ SOURCES (|for| X |in| (DIRECTORY (MEDLEYDIR "sources" "*.*;" T)) (SETQ SOURCES (|for| X |in| (DIRECTORY (MEDLEYDIR "sources" "*.*;" T))
|when| (NOT (MEMB (FILENAMEFIELD X 'EXTENSION) |when| (NOT (MEMB (FILENAMEFIELD X 'EXTENSION)
'(LCOM DFASL TEDIT TXT))) '(LCOM DFASL TEDIT TXT)))
|collect| (FILENAMEFIELD X 'NAME)))) |collect| (FILENAMEFIELD X 'NAME))))
(-1 (PRINTOUT T " loaded files not in SYSFILES or FILELST: " (-1 (PRINTOUT T " loaded files not in SYSFILES or FILELST: "
(|for| X |in| LOADEDFILES |when| (NOT (OR (FMEMB X SYSFILES) (|for| X |in| LOADEDFILES |when| (NOT (OR (FMEMB X SYSFILES)
(FMEMB X FILELST))) (FMEMB X FILELST))) |collect| X)
|collect| X)
T) T)
(PRINTOUT T "Sources not loaded: " (CL:SET-DIFFERENCE SOURCES (APPEND ALLFILESETSFILES (PRINTOUT T "Sources not loaded: " (CL:SET-DIFFERENCE SOURCES (APPEND ALLFILESETSFILES
LOADEDFILES)) LOADEDFILES))
@ -52,50 +50,45 @@
DEFD)) DEFD))
(|for| X |in| DEFINEDFNS |when| (CCODEP X) (|for| X |in| DEFINEDFNS |when| (CCODEP X)
|do| (LET ((Y (PUTPROP X 'CCC (CALLSCCODE X)))) |do| (LET ((Y (PUTPROP X 'CCC (CALLSCCODE X))))
(|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY) (|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY)
|as| VAL |in| Y |as| VAL |in| Y |do| (|for| S |in| VAL
|do| (|for| S |in| VAL |do| (PUTPROP S REV (CONS X (GETPROP S REV)))))))
|do| (PUTPROP S REV (CONS X (GETPROP S REV)))))))
(SETQ CALLEDFNS NIL) (SETQ CALLEDFNS NIL)
(MAPATOMS (FUNCTION (LAMBDA (X) (MAPATOMS (FUNCTION (LAMBDA (X)
(|if| (AND (NOT (GETD X)) (|if| (AND (NOT (GETD X))
(GETPROP X 'CALLED-BY)) (GETPROP X 'CALLED-BY))
|then| (CL:PUSH X CALLEDFNS)))))) |then| (CL:PUSH X CALLEDFNS))))))
(-2 (PRINTOUT T "Functions called and not defined" CALLEDFNS T)) (-2 (PRINTOUT T "Functions called and not defined" CALLEDFNS T))
(3 (|for| X |in| SYSFILES (3 (|for| X |in| SYSFILES
|do| |do| (LOAD X 'PROP)
(LOAD X 'PROP) (PUTPROP X 'CONTENT (READFILE X))
(PUTPROP X 'CONTENT (READFILE X)) (|for| EXR |in| (GETPROP X 'CONTENT)
(|for| EXR |in| (GETPROP X 'CONTENT) |do| (SELECTQ (CAR EXR)
|do| (SELECTQ (CAR EXR) (DEFINEQ (|for| DFN |in| (CDR EXR)
(DEFINEQ (|for| DFN |in| (CDR EXR) |do| (|if| (EQUAL (CADR DFN)
|do| (|if| (EQUAL (CADR DFN) (GETPROP (CAR DFN)
(GETPROP (CAR DFN) 'EXPR))
'EXPR)) |then| (PRINTOUT T (CAR DFN)
|then| (PRINTOUT T (CAR DFN) " ")
" ") (PUTPROP (CAR DFN)
(PUTPROP (CAR DFN) 'EXPR
'EXPR (CADR DFN))
(CADR DFN)) |else| (PRINTOUT T (CAR DFN)
|else| (PRINTOUT T (CAR DFN) "* "))))
"* ")))) NIL)))
NIL))) (SETQ ALLCONTENT (|for| X |in| SYSFILES |collect| (CONS X (GETPROP X 'CONTENT))))
(SETQ ALLCONTENT (|for| X |in| SYSFILES |collect| (CONS X (GETPROP
X
'CONTENT))))
(* \; " don't edit with SEDIT") (* \; " don't edit with SEDIT")
(LET (DUPS) (LET (DUPS)
(|for| X |in| SYSFILES (|for| X |in| SYSFILES
|do| (|for| FN |in| (FILEFNSLST X) |do| (|for| FN |in| (FILEFNSLST X)
|do| (|if| (GETPROP FN 'WHEREIS) |do| (|if| (GETPROP FN 'WHEREIS)
|then| (NCONC1 (GETPROP FN 'WHEREIS) |then| (NCONC1 (GETPROP FN 'WHEREIS)
X) X)
(OR (FMEMB FN DUPS) (OR (FMEMB FN DUPS)
(SETQ DUPS (CONS FN DUPS))) (SETQ DUPS (CONS FN DUPS)))
|else| (PUTPROP FN 'WHEREIS (LIST X))))) |else| (PUTPROP FN 'WHEREIS (LIST X)))))
(SETQ DUPFNS DUPS)) (SETQ DUPFNS DUPS))
(SETQ NO-SOURCE (|for| X |in| DEFINEDFNS |when| (NOT (GETPROP X 'EXPR)) (SETQ NO-SOURCE (|for| X |in| DEFINEDFNS |when| (NOT (GETPROP X 'EXPR)) |collect| X)))
|collect| X)))
(-3 (PRINTOUT T "Functions compiled but no expr" NO-SOURCE T) (-3 (PRINTOUT T "Functions compiled but no expr" NO-SOURCE T)
(PRINTOUT T "Functions on more than one file: " DUPFNS T)) (PRINTOUT T "Functions on more than one file: " DUPFNS T))
(4 (PRINTOUT T T "STARTING MASTERSCOPE PHASE ON " (DATE) (4 (PRINTOUT T T "STARTING MASTERSCOPE PHASE ON " (DATE)
@ -104,7 +97,7 @@
SYSEDIT) SYSEDIT)
(|for| X |in| SYSFILES |do| (MSNOTICEFILE X)) (|for| X |in| SYSFILES |do| (MSNOTICEFILE X))
(|for| X |in| SYSFILES |do| (PRINTOUT T T "Analyzing " X T) (|for| X |in| SYSFILES |do| (PRINTOUT T T "Analyzing " X T)
(MASTERSCOPE `(ANALYZE ON ,(KWOTE X))))) (MASTERSCOPE `(ANALYZE ON ,(KWOTE X)))))
(-4 "No queries yet") (-4 "No queries yet")
(HELP)))) (HELP))))
@ -124,7 +117,7 @@
) )
(RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal/library" "greetfiles" (RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal/library" "greetfiles"
"docs>Documentation Tools")) "docs>Documentation Tools"))
(DEFINEQ (DEFINEQ
(MAKE-EXPORTS-ALL (MAKE-EXPORTS-ALL
@ -157,6 +150,6 @@
(DRIBBLE)))) (DRIBBLE))))
) )
(DECLARE\: DONTCOPY (DECLARE\: DONTCOPY
(FILEMAP (NIL (618 7420 (GATHER-INFO 628 . 6522) (MEDLEY-FIX-LINKS 6524 . 7047) (MEDLEY-FIX-DATES 7049 (FILEMAP (NIL (553 7001 (GATHER-INFO 563 . 6103) (MEDLEY-FIX-LINKS 6105 . 6628) (MEDLEY-FIX-DATES 6630
. 7418)) (7578 9449 (MAKE-EXPORTS-ALL 7588 . 8604) (MAKE-WHEREIS-HASH 8606 . 9447))))) . 6999)) (7155 9026 (MAKE-EXPORTS-ALL 7165 . 8181) (MAKE-WHEREIS-HASH 8183 . 9024)))))
STOP STOP

BIN
internal/library/MEDLEY-UTILS.LCOM
View File

Binary file not shown.

75
library/MSCOMMON
View File

@ -1,12 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED " 4-May-92 13:10:53" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;3| 23489
|changes| |to:| (TEMPLATES CL:DECF CL:INCF CL:PUSH) (FILECREATED "15-Jan-2022 20:17:21" |{DSK}<home>larry>medley>library>MSCOMMON.;4| 24053
|previous| |date:| "12-Jun-90 10:17:31" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;2|) :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)
:PREVIOUS-DATE " 4-May-92 13:10:53" |{DSK}<home>larry>medley>library>MSCOMMON.;3|)
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation. All rights reserved. ; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation.
(PRETTYCOMPRINT MSCOMMONCOMS) (PRETTYCOMPRINT MSCOMMONCOMS)
@ -37,8 +42,8 @@
CL:STRING-LESSP CL:STRING-NOT-EQUAL CL:STRING-NOT-GREATERP CL:STRING-NOT-LESSP CL:STRING-LESSP CL:STRING-NOT-EQUAL CL:STRING-NOT-GREATERP CL:STRING-NOT-LESSP
CL:STRING-UPCASE CL:STRING/= CL:STRING< CL:STRING<= CL:STRING= CL:STRING> CL:STRING>= CL:STRING-UPCASE CL:STRING/= CL:STRING< CL:STRING<= CL:STRING= CL:STRING> CL:STRING>=
CL:SUBLIS CL:SUBSETP CL:SUBST CL:SUBST-IF CL:SUBST-IF-NOT CL:SUBSTITUTE CL:SUBLIS CL:SUBSETP CL:SUBST CL:SUBST-IF CL:SUBST-IF-NOT CL:SUBSTITUTE
CL:SUBSTITUTE-IF CL:SUBSTITUTE-IF-NOT CL:TREE-EQUAL CL:UNION CL:VECTOR-PUSH CL:SUBSTITUTE-IF CL:SUBSTITUTE-IF-NOT CL:TREE-EQUAL CL:UNION CL:UNLESS CL:VECTOR-PUSH
CL:VECTOR-PUSH-EXTEND WRITE CL:WRITE-LINE CL:WRITE-STRING CL:WRITE-TO-STRING) CL:VECTOR-PUSH-EXTEND CL:WHEN WRITE CL:WRITE-LINE CL:WRITE-STRING CL:WRITE-TO-STRING)
(P (P
(* |;;| "First tell Masterscope how to find FUNCTIONS and VARIABLES") (* |;;| "First tell Masterscope how to find FUNCTIONS and VARIABLES")
@ -46,7 +51,7 @@
(MSADDANALYZE 'FUNCTIONS 'FUNCTION 'FUNCTIONS 'FUNCTIONSMSGETDEF 'FUNCTIONSMSMC) (MSADDANALYZE 'FUNCTIONS 'FUNCTION 'FUNCTIONS 'FUNCTIONSMSGETDEF 'FUNCTIONSMSMC)
(* |;;| (* |;;|
 "Then add KEYWORD support. Templates may now contain the following as their last element:")  "Then add KEYWORD support. Templates may now contain the following as their last element:")
(* |;;| "... KEYWORDS list of keywords accepted)") (* |;;| "... KEYWORDS list of keywords accepted)")
@ -65,7 +70,7 @@
(MSADDMODIFIER 'SPECIFY 'KEYWORDS 'KEYSPECIFY) (MSADDMODIFIER 'SPECIFY 'KEYWORDS 'KEYSPECIFY)
(* |;;| (* |;;|
 "Stuff for locally-defined things. We don't attempt to handle them (*sigh*), just record them.")  "Stuff for locally-defined things. We don't attempt to handle them (*sigh*), just record them.")
(MSADDRELATION '(FLET FLETS FLETTING FLET)) (MSADDRELATION '(FLET FLETS FLETTING FLET))
(MSADDRELATION '(LABEL LABELS LABELLING LABELLED)) (MSADDRELATION '(LABEL LABELS LABELLING LABELLED))
@ -87,42 +92,48 @@
(DEFINEQ (DEFINEQ
(FUNCTIONSMSGETDEF (FUNCTIONSMSGETDEF
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 31-Mar-88 17:31 by jrb:") (LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 31-Mar-88 17:31 by jrb:")
(LET ((BODY (REMOVE-COMMENTS (GETDEF NAME 'FUNCTIONS SOURCE OPTIONS)))) (LET ((BODY (REMOVE-COMMENTS (GETDEF NAME 'FUNCTIONS SOURCE OPTIONS))))
(AND BODY (SELECTQ (CAR BODY) (AND BODY (SELECTQ (CAR BODY)
(DEFMACRO (OR (GETTEMPLATE NAME) (DEFMACRO (OR (GETTEMPLATE NAME)
(SETTEMPLATE NAME 'MACRO)) (SETTEMPLATE NAME 'MACRO))
NIL) NIL)
(CL:DEFUN (CL:DEFUN
(* |;;| "Body is of the form:") (* |;;| "Body is of the form:")
(* |;;| "(DEFUN name (args...) bodies...)")
(* |;;| "We want to hand Masterscope a massaged form it will understand.")
(* |;;| "Which I believe is of this form:")
`(CL:LAMBDA ,(CADDR BODY) ,@(CDDDR BODY))) (* |;;| "(DEFUN name (args...) bodies...)")
(* |;;|
 "We want to hand Masterscope a massaged form it will understand.")
(* |;;| "Which I believe is of this form:")
`(CL:LAMBDA ,(CADDR BODY)
,@(CDDDR BODY)))
NIL))))) NIL)))))
(FUNCTIONSMSMC (FUNCTIONSMSMC
(LAMBDA (NAME TYPE REASON) (* \; "Edited 1-Apr-88 13:47 by jrb:") (LAMBDA (NAME TYPE REASON) (* \; "Edited 1-Apr-88 13:47 by jrb:")
(* |;;| "Trick here is we don't want to mark FUNCTIONS macros as changed because they really don't get analyzed, but we do want to call CHANGEMACRO for them")
(* |;;| "Trick here is we don't want to mark FUNCTIONS macros as changed because they really don't get analyzed, but we do want to call CHANGEMACRO for them")
(|if| (EQ (CAR (GETDEF NAME 'FUNCTIONS NIL '(NOERROR))) (|if| (EQ (CAR (GETDEF NAME 'FUNCTIONS NIL '(NOERROR)))
'DEFMACRO) 'DEFMACRO)
|then| (CHANGEMACRO NAME TYPE REASON) |then| (CHANGEMACRO NAME TYPE REASON)
NIL NIL
|else| T))) |else| T)))
(VARIABLESMSGETDEF (VARIABLESMSGETDEF
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 19-Feb-88 19:46 by jrb:") (LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 19-Feb-88 19:46 by jrb:")
(LET ((BODY (GETDEF NAME 'VARIABLES SOURCE OPTIONS)) (LET ((BODY (GETDEF NAME 'VARIABLES SOURCE OPTIONS))
SPECVARP) SPECVARP)
(AND BODY (AND BODY
(* |;;| "We have to return something here so Masterscope can get hold of the init form, and so It'll stop looking for other things") (* |;;| "We have to return something here so Masterscope can get hold of the init form, and so It'll stop looking for other things")
`(CL:LAMBDA NIL ,(IF (CADDR BODY) `(CL:LAMBDA NIL ,(IF (CADDR BODY)
THEN `(SETQ ,(CADR BODY) ,(CADDR BODY)))))))) THEN `(SETQ ,(CADR BODY)
,(CADDR BODY))))))))
) )
@ -162,9 +173,9 @@
:LOAD :FILE-MANAGER-FORMAT :PROCESS-ENTIRE-FILE)) :LOAD :FILE-MANAGER-FORMAT :PROCESS-ENTIRE-FILE))
(SETTEMPLATE 'CL:COMPILER-LET '(! NIL (BOTH (|..| (IF LISTP (NIL EVAL |..| EFFECT) (SETTEMPLATE 'CL:COMPILER-LET '(! NIL (BOTH (|..| (IF LISTP (NIL EVAL |..| EFFECT)
NIL)) NIL))
(|..| (IF LISTP ((BOTH BIND COMPILER-LET)) (|..| (IF LISTP ((BOTH BIND COMPILER-LET))
(BOTH BIND COMPILER-LET)))) (BOTH BIND COMPILER-LET))))
|..| EFFECT RETURN)) |..| EFFECT RETURN))
(SETTEMPLATE 'CL:COUNT '(EVAL EVAL KEYWORDS :FROM-END :TEST :TEST-NOT :START :END :KEY)) (SETTEMPLATE 'CL:COUNT '(EVAL EVAL KEYWORDS :FROM-END :TEST :TEST-NOT :START :END :KEY))
@ -179,10 +190,10 @@
(SETTEMPLATE 'DECLARE '(|..| (@ EXPR (CONS NIL (SELECTQ (CAR (LISTP EXPR)) (SETTEMPLATE 'DECLARE '(|..| (@ EXPR (CONS NIL (SELECTQ (CAR (LISTP EXPR))
(LOCALVARS '(IF LISTP (|..| LOCALVARS) (LOCALVARS '(IF LISTP (|..| LOCALVARS)
LOCALVARS)) LOCALVARS))
((SPECVARS CL:SPECIAL) ((SPECVARS CL:SPECIAL)
'(IF LISTP (|..| SPECVARS) '(IF LISTP (|..| SPECVARS)
SPECVARS)) SPECVARS))
NIL))))) NIL)))))
(SETTEMPLATE 'CL:DELETE '(EVAL SMASH KEYWORDS :FROM-END :TEST :TEST-NOT :START :END :COUNT :KEY)) (SETTEMPLATE 'CL:DELETE '(EVAL SMASH KEYWORDS :FROM-END :TEST :TEST-NOT :START :END :COUNT :KEY))
@ -391,7 +402,7 @@
(SETTEMPLATE 'CL:REPLACE '(SMASH EVAL KEYWORDS :START1 :END1 :START2 :END2)) (SETTEMPLATE 'CL:REPLACE '(SMASH EVAL KEYWORDS :START1 :END1 :START2 :END2))
(SETTEMPLATE 'CL:ROTATEF '(|..| (IF (ATOM EXPR) (SETTEMPLATE 'CL:ROTATEF '(|..| (IF (ATOM EXPR)
SET SMASH))) SET SMASH)))
(SETTEMPLATE 'CL:SEARCH '(EVAL EVAL KEYWORDS :FROM-END :TEST :TEST-NOT :KEY :START1 :START2 :END1 (SETTEMPLATE 'CL:SEARCH '(EVAL EVAL KEYWORDS :FROM-END :TEST :TEST-NOT :KEY :START1 :START2 :END1
:END2)) :END2))
@ -401,7 +412,7 @@
(SETTEMPLATE 'CL:SET-EXCLUSIVE-OR '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY)) (SETTEMPLATE 'CL:SET-EXCLUSIVE-OR '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
(SETTEMPLATE 'CL:SHIFTF '(|..| (IF (ATOM EXPR) (SETTEMPLATE 'CL:SHIFTF '(|..| (IF (ATOM EXPR)
SET SMASH) SET SMASH)
EVAL)) EVAL))
(SETTEMPLATE 'CL:SORT '(EVAL FUNCTION KEYWORDS :KEY)) (SETTEMPLATE 'CL:SORT '(EVAL FUNCTION KEYWORDS :KEY))
@ -459,10 +470,14 @@
(SETTEMPLATE 'CL:UNION '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY)) (SETTEMPLATE 'CL:UNION '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFECT RETURN))
(SETTEMPLATE 'CL:VECTOR-PUSH '(EVAL SMASH)) (SETTEMPLATE 'CL:VECTOR-PUSH '(EVAL SMASH))
(SETTEMPLATE 'CL:VECTOR-PUSH-EXTEND '(EVAL SMASH EVAL)) (SETTEMPLATE 'CL:VECTOR-PUSH-EXTEND '(EVAL SMASH EVAL))
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFECT RETURN))
(SETTEMPLATE 'WRITE '(EVAL KEYWORDS :STREAM :ESCAPE :RADIX :BASE :CIRCLE :PRETTY :LEVEL :LENGTH :CASE (SETTEMPLATE 'WRITE '(EVAL KEYWORDS :STREAM :ESCAPE :RADIX :BASE :CIRCLE :PRETTY :LEVEL :LENGTH :CASE
:GENSYM :ARRAY)) :GENSYM :ARRAY))
@ -539,6 +554,6 @@
(CLRHASH USERTEMPLATES) (CLRHASH USERTEMPLATES)
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992)) (PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992))
(DECLARE\: DONTCOPY (DECLARE\: DONTCOPY
(FILEMAP (NIL (5000 6811 (FUNCTIONSMSGETDEF 5010 . 5804) (FUNCTIONSMSMC 5806 . 6286) ( (FILEMAP (NIL (5280 7291 (FUNCTIONSMSGETDEF 5290 . 6258) (FUNCTIONSMSMC 6260 . 6731) (
VARIABLESMSGETDEF 6288 . 6809))))) VARIABLESMSGETDEF 6733 . 7289)))))
STOP STOP

BIN
library/MSCOMMON.DFASL
View File

Binary file not shown.

82
lispusers/IDLEHAX
View File

@ -1,21 +1,21 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Sep-91 14:35:23" |{PELE:MV:ENVOS}<LISPUSERS>MEDLEY>IDLEHAX.;2| 22593
changes to%: (FNS CONNECTPOLYS RANDOMPT KAL.ORAND) (FILECREATED "15-Jan-2022 15:31:21" {DSK}<home>larry>medley>lispusers>IDLEHAX.;2 22517
(VARS IDLEHAXCOMS)
(RECORDS KALFIXP)
previous date%: "10-Jun-88 17:50:01" |{PELE:MV:ENVOS}<LISPUSERS>MEDLEY>IDLEHAX.;1|) :CHANGES-TO (FNS CONNECTPOLYS)
(VARS IDLEHAXCOMS)
:PREVIOUS-DATE "26-Sep-91 14:35:23" {DSK}<home>larry>medley>lispusers>IDLEHAX.;1)
(* ; " (* ; "
Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights reserved. Copyright (c) 1985-1988, 1991 by Xerox Corporation.
") ")
(PRETTYCOMPRINT IDLEHAXCOMS) (PRETTYCOMPRINT IDLEHAXCOMS)
(RPAQQ IDLEHAXCOMS (RPAQQ IDLEHAXCOMS
([COMS [ADDVARS (IDLE.FUNCTIONS (Lines 'LINES) ((COMS [ADDVARS (IDLE.FUNCTIONS (Lines 'LINES)
(Warp-Out 'WARP) (Warp-Out 'WARP)
(Radar 'WALKINGSPOKE) (Radar 'WALKINGSPOKE)
[Triangles (FUNCTION (LAMBDA (W) [Triangles (FUNCTION (LAMBDA (W)
@ -28,7 +28,8 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
(Bubbles 'BUBBLES) (Bubbles 'BUBBLES)
(Kaleidoscope 'KALDEMO) (Kaleidoscope 'KALDEMO)
(Windows 'IDLE-WINDOWS] (Windows 'IDLE-WINDOWS]
(VARS (IDLE.DEFAULTFN 'LINES] (VARS (IDLE.DEFAULTFN 'LINES)
(POLYGONWAIT3 250)))
(COMS (* ; "for drawing polygons") (COMS (* ; "for drawing polygons")
(FNS POLYGONSDEMO POLYGONS CONNECTPOLYS DRAWPOLY1 RANDOMPT) (FNS POLYGONSDEMO POLYGONS CONNECTPOLYS DRAWPOLY1 RANDOMPT)
(INITVARS (POLYGONSWINDOW)) (INITVARS (POLYGONSWINDOW))
@ -74,6 +75,8 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
(RPAQQ IDLE.DEFAULTFN LINES) (RPAQQ IDLE.DEFAULTFN LINES)
(RPAQQ POLYGONWAIT3 250)
(* ; "for drawing polygons") (* ; "for drawing polygons")
@ -89,39 +92,39 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
) )
(CONNECTPOLYS (CONNECTPOLYS
[LAMBDA (FROMS TOS NSTEPS W OPERATION) (* lmm "30-Jul-85 17:19") [LAMBDA (FROMS TOS NSTEPS W OPERATION) (* ; "Edited 12-Jan-2022 15:22 by larry")
(* lmm "30-Jul-85 17:19")
(PROG (DIFFS) (PROG (DIFFS)
(CLEARW W) (CLEARW W)
(LINES2 FROMS 3 W OPERATION) (LINES2 FROMS 3 W OPERATION)
(SETQ DIFFS (for FPT in FROMS as TPT in TOS bind DX DY (SETQ DIFFS (for FPT in FROMS as TPT in TOS bind DX DY
collect (SETQ DX (IQUOTIENT (IDIFFERENCE (fetch XC of TPT) collect (SETQ DX (IQUOTIENT (IDIFFERENCE (fetch XC of TPT)
(fetch XC of FPT)) (fetch XC of FPT))
POLYGONSTEPS)) POLYGONSTEPS))
(SETQ DY (IQUOTIENT (IDIFFERENCE (fetch YC of TPT) (SETQ DY (IQUOTIENT (IDIFFERENCE (fetch YC of TPT)
(fetch YC of FPT)) (fetch YC of FPT))
POLYGONSTEPS)) POLYGONSTEPS))
(replace XC of TPT with (IPLUS (fetch XC of FPT) (replace XC of TPT with (IPLUS (fetch XC of FPT)
(ITIMES POLYGONSTEPS DX))) (ITIMES POLYGONSTEPS DX)))
(replace YC of TPT with (IPLUS (fetch YC of FPT) (replace YC of TPT with (IPLUS (fetch YC of FPT)
(ITIMES POLYGONSTEPS DY))) (ITIMES POLYGONSTEPS DY)))
(CONS DX DY))) (CONS DX DY)))
(LINES2 TOS 3 W OPERATION) (LINES2 TOS 3 W OPERATION)
(for FPT in FROMS as TPT in TOS do (DRAWLINE (fetch XC of (for FPT in FROMS as TPT in TOS do (DRAWLINE (fetch XC of FPT)
FPT) (fetch YC of FPT)
(fetch YC of FPT) (fetch XC of TPT)
(fetch XC of TPT) (fetch YC of TPT)
(fetch YC of TPT) 1 OPERATION W))
1 OPERATION W))
(DISMISS POLYGONWAIT2) (DISMISS POLYGONWAIT2)
(CLEARW W) (CLEARW W)
(for I from 1 to POLYGONSTEPS (for I from 1 to POLYGONSTEPS do (DISMISS POLYGONWAIT3)
do (BLOCK) (LINES2 FROMS 1 W OPERATION)
(LINES2 FROMS 1 W OPERATION) (for PT in FROMS as DIF in DIFFS
(for PT in FROMS as DIF in DIFFS do (add (fetch XC of PT)
do (add (fetch XC of PT) (CAR DIF))
(CAR DIF)) (add (fetch YC of PT)
(add (fetch YC of PT) (CDR DIF)))
(CDR DIF))) finally (LINES2 FROMS 1 W OPERATION]) finally (LINES2 FROMS 1 W OPERATION])
(DRAWPOLY1 (DRAWPOLY1
(LAMBDA (PTLIST WIDTH OPERATION W NOBLOCK) (* edited%: "19-AUG-83 04:14") (* draws a closed polygon of the points given If OPERATION is not given, use the one from the default DS.) (COND (PTLIST (OR OPERATION (SETQ OPERATION (DSPOPERATION NIL W))) (PROG ((PTS PTLIST)) (while (CDR PTS) do (DRAWLINE (fetch XC of (CAR PTS)) (fetch YC of (CAR PTS)) (fetch XC of (CADR PTS)) (fetch YC of (CADR PTS)) WIDTH OPERATION W) (pop PTS) finally (DRAWLINE (fetch XC of (CAR PTS)) (fetch YC of (CAR PTS)) (fetch XC of (CAR PTLIST)) (fetch YC of (CAR PTLIST)) WIDTH OPERATION W))))) (COND (NOBLOCK (ALLOW.BUTTON.EVENTS)) (T (BLOCK)))) (LAMBDA (PTLIST WIDTH OPERATION W NOBLOCK) (* edited%: "19-AUG-83 04:14") (* draws a closed polygon of the points given If OPERATION is not given, use the one from the default DS.) (COND (PTLIST (OR OPERATION (SETQ OPERATION (DSPOPERATION NIL W))) (PROG ((PTS PTLIST)) (while (CDR PTS) do (DRAWLINE (fetch XC of (CAR PTS)) (fetch YC of (CAR PTS)) (fetch XC of (CADR PTS)) (fetch YC of (CADR PTS)) WIDTH OPERATION W) (pop PTS) finally (DRAWLINE (fetch XC of (CAR PTS)) (fetch YC of (CAR PTS)) (fetch XC of (CAR PTLIST)) (fetch YC of (CAR PTLIST)) WIDTH OPERATION W))))) (COND (NOBLOCK (ALLOW.BUTTON.EVENTS)) (T (BLOCK))))
@ -151,7 +154,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(DATATYPE NPOINT ((XC XPOINTER) (DATATYPE NPOINT ((XC XPOINTER)
(YC XPOINTER))) (YC XPOINTER)))
) )
(/DECLAREDATATYPE 'NPOINT '(XPOINTER XPOINTER) (/DECLAREDATATYPE 'NPOINT '(XPOINTER XPOINTER)
@ -363,7 +366,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
(RPAQQ MELT-BLOCK-SIZE 32) (RPAQQ MELT-BLOCK-SIZE 32)
(ADDTOVAR IDLE.FUNCTIONS ("Melt screen" 'IDLE-MELT) (ADDTOVAR IDLE.FUNCTIONS ("Melt screen" 'IDLE-MELT)
("Slide screen" 'IDLE-SLIDE)) ("Slide screen" 'IDLE-SLIDE))
@ -382,18 +385,17 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(PUTPROPS PERIODIC.BLOCK MACRO [(TIMER) (PUTPROPS PERIODIC.BLOCK MACRO [(TIMER)
(if (TIMEREXPIRED? TIMER 'TICKS) (if (TIMEREXPIRED? TIMER 'TICKS)
then (BLOCK) then (BLOCK)
(SETQ TIMER (SETUPTIMER 100 TIMER 'TICKS (SETQ TIMER (SETUPTIMER 100 TIMER 'TICKS 'MILLISECONDS])
'MILLISECONDS])
) )
(PUTPROPS IDLEHAX COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1991)) (PUTPROPS IDLEHAX COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1991))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (3587 7576 (POLYGONSDEMO 3597 . 3767) (POLYGONS 3769 . 4133) (CONNECTPOLYS 4135 . 6482) (FILEMAP (NIL (3562 7602 (POLYGONSDEMO 3572 . 3742) (POLYGONS 3744 . 4108) (CONNECTPOLYS 4110 . 6508)
(DRAWPOLY1 6484 . 7121) (RANDOMPT 7123 . 7574)) (8217 11199 (KALDEMO 8227 . 9638) (KAL.ADVANCE 9640 . (DRAWPOLY1 6510 . 7147) (RANDOMPT 7149 . 7600)) (8239 11221 (KALDEMO 8249 . 9660) (KAL.ADVANCE 9662 .
10041) (KAL.SPOTS 10043 . 10384) (KAL.BMS 10386 . 10873) (KAL.ORAND 10875 . 11197)) (11236 12722 ( 10063) (KAL.SPOTS 10065 . 10406) (KAL.BMS 10408 . 10895) (KAL.ORAND 10897 . 11219)) (11258 12744 (
BUBBLES 11246 . 12352) (BUBBLE.CREATE 12354 . 12720)) (12749 13734 (IDLE-WINDOWS 12759 . 13732)) ( BUBBLES 11268 . 12374) (BUBBLE.CREATE 12376 . 12742)) (12771 13756 (IDLE-WINDOWS 12781 . 13754)) (
13769 16040 (LINES 13779 . 14838) (LINES1 14840 . 15250) (LINES2 15252 . 15563) (LINES3 15565 . 16038) 13791 16062 (LINES 13801 . 14860) (LINES1 14862 . 15272) (LINES2 15274 . 15585) (LINES3 15587 . 16060)
) (16100 17313 (WALKINGSPOKE 16110 . 16891) (WARP 16893 . 17311)) (17338 21621 (IDLE-MELT 17348 . ) (16122 17335 (WALKINGSPOKE 16132 . 16913) (WARP 16915 . 17333)) (17360 21643 (IDLE-MELT 17370 .
19864) (IDLE-SLIDE 19866 . 21619)) (21796 22042 (DEMOWINDOW 21806 . 22040))))) 19886) (IDLE-SLIDE 19888 . 21641)) (21814 22060 (DEMOWINDOW 21824 . 22058)))))
STOP STOP

BIN
lispusers/IDLEHAX.LCOM
View File

Binary file not shown.

52
sources/LOADUP-FULL
View File

@ -1,23 +1,26 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Apr-2021 22:31:24" {DSK}<Users>larry>medley>SOURCES>LOADUP-FULL.;2 4691
changes to%: (VARS LOADUP-FULLCOMS) (FILECREATED "15-Jan-2022 15:49:06" {DSK}<home>larry>medley>sources>LOADUP-FULL.;2 4784
(FNS LOADUP-FULL)
previous date%: "26-Mar-2021 10:47:11" {DSK}<Users>larry>medley>SOURCES>LOADUP-FULL.;1) :CHANGES-TO (FNS LOADUP-FULL)
:PREVIOUS-DATE "29-Apr-2021 22:31:24" {DSK}<home>larry>medley>sources>LOADUP-FULL.;1)
(PRETTYCOMPRINT LOADUP-FULLCOMS) (PRETTYCOMPRINT LOADUP-FULLCOMS)
(RPAQQ LOADUP-FULLCOMS ((COMMANDS "cd" "pwd" "ls") (RPAQQ LOADUP-FULLCOMS ((COMMANDS "cd" "pwd" "ls")
(FNS LOADFULLFONTS LOADUP-FULL FIXMETA) (FNS LOADFULLFONTS LOADUP-FULL FIXMETA)
(P (FIXMETA)))) (P (FIXMETA))))
(DEFCOMMAND "cd" (DIR) (/CNDIR DIR)) (DEFCOMMAND "cd" (DIR)
(/CNDIR DIR))
(DEFCOMMAND "pwd" NIL (DIRECTORYNAME T)) (DEFCOMMAND "pwd" ()
(DIRECTORYNAME T))
(DEFCOMMAND "ls" (FIRST . REST) (DODIR (CONS FIRST REST))) (DEFCOMMAND "ls" (FIRST . REST)
(DODIR (CONS FIRST REST)))
(DEFINEQ (DEFINEQ
(LOADFULLFONTS (LOADFULLFONTS
@ -47,16 +50,18 @@
(PRINTOUT T "FULL fonts loaded" T]) (PRINTOUT T "FULL fonts loaded" T])
(LOADUP-FULL (LOADUP-FULL
[LAMBDA (DOIT) (* ; "Edited 29-Apr-2021 22:27 by rmk:") [LAMBDA (DOIT) (* ; "Edited 15-Jan-2022 15:48 by larry")
(* ; "Edited 14-May-2018 15:01 by kaplan") (* ; "Edited 29-Apr-2021 22:27 by rmk:")
(* ; "Edited 28-Sep-2020 12:35 by rmk:") (* ;
(* ; "Edited 21-Apr-2018 07:27 by rmk:")  "Edited 14-May-2018 15:01 by kaplan")
(* ; "Edited 28-Sep-2020 12:35 by rmk:")
(* ; "Edited 21-Apr-2018 07:27 by rmk:")
(* ; "Edited 23-Feb-94 15:04 by bvm") (* ; "Edited 23-Feb-94 15:04 by bvm")
(PROGN (SETQ MEDLEYDIR) (PROGN (SETQ MEDLEYDIR)
(CNDIR (MEDLEYDIR))) (CNDIR (MEDLEYDIR)))
(MEDLEY-INIT-VARS) (MEDLEY-INIT-VARS)
(SETQ MAKESYSFILENAME (MEDLEYDIR "tmp" "full.sysout" T)) (SETQ MAKESYSFILENAME (MEDLEYDIR "tmp" "full.sysout" T))
(SETQ MAKESYSNAME (CONCAT "Medley from Interlisp.org of " (DATE))) (SETQ MAKESYSNAME :MEDLEY)
(DRIBBLE (MEDLEYDIR "tmp" "full.dribble" T)) (DRIBBLE (MEDLEYDIR "tmp" "full.dribble" T))
(* ;; "BKSYSBUF stops page holding ") (* ;; "BKSYSBUF stops page holding ")
@ -67,16 +72,16 @@
(DIRECTORYNAME T) (DIRECTORYNAME T)
T T) T T)
(SETQ DEFAULTFILETYPE 'BINARY) (* ; (SETQ DEFAULTFILETYPE 'BINARY) (* ;
 "These prevent bits from being lost due to lack of knowledge")  "These prevent bits from being lost due to lack of knowledge")
(DREMOVE (ASSOC NIL DEFAULTFILETYPELIST) (DREMOVE (ASSOC NIL DEFAULTFILETYPELIST)
DEFAULTFILETYPELIST) DEFAULTFILETYPELIST)
(push DEFAULTFILETYPELIST '(DRIBBLE . TEXT) (push DEFAULTFILETYPELIST '(DRIBBLE . TEXT)
'(SH . TEXT) '(SH . TEXT)
'(TXT . TEXT) '(TXT . TEXT)
'(TEXT . TEXT) '(TEXT . TEXT)
'(TEX . TEXT) '(TEX . TEXT)
'(HTML . TEXT) '(HTML . TEXT)
'(HTM . TEXT)) '(HTM . TEXT))
(LOADUP '(POSTSCRIPTSTREAM)) (* ; " to get PSCFONT.READFONT") (LOADUP '(POSTSCRIPTSTREAM)) (* ; " to get PSCFONT.READFONT")
(LOADFULLFONTS) (LOADFULLFONTS)
(LISTPUT IDLE.PROFILE 'TIMEOUT 0) (LISTPUT IDLE.PROFILE 'TIMEOUT 0)
@ -100,6 +105,5 @@
(FIXMETA) (FIXMETA)
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (685 4653 (LOADFULLFONTS 695 . 2283) (LOADUP-FULL 2285 . 4407) (FIXMETA 4409 . 4651)))) (FILEMAP (NIL (659 4746 (LOADFULLFONTS 669 . 2257) (LOADUP-FULL 2259 . 4500) (FIXMETA 4502 . 4744)))))
)
STOP STOP

BIN
sources/LOADUP-FULL.LCOM
View File

Binary file not shown.

31
sources/LOADUP-LISP
View File

@ -1,27 +1,30 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "21-Aug-2021 18:03:35" |{DSK}<home>larry>medley>sources>LOADUP-LISP.;2| 4983
|changes| |to:| (VARS LOADUP-LISPCOMS) (FILECREATED "15-Jan-2022 15:47:28" |{DSK}<home>larry>medley>sources>LOADUP-LISP.;2| 5105
|previous| |date:| " 1-Aug-2021 13:16:06" |{DSK}<home>larry>medley>sources>LOADUP-LISP.;1|) :CHANGES-TO (FNS LOADUP-LISP)
:PREVIOUS-DATE "21-Aug-2021 18:03:35" |{DSK}<home>larry>medley>sources>LOADUP-LISP.;1|)
(PRETTYCOMPRINT LOADUP-LISPCOMS) (PRETTYCOMPRINT LOADUP-LISPCOMS)
(RPAQQ LOADUP-LISPCOMS ((FNS LOADUP-LISP) (RPAQQ LOADUP-LISPCOMS ((FNS LOADUP-LISP)
(INITVARS (FILING.ENUMERATION.DEPTH 1)) (INITVARS (FILING.ENUMERATION.DEPTH 1))
(FILES MEDLEYDIR) (FILES MEDLEYDIR)
(GLOBALVARS LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR (GLOBALVARS LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR
SYSTEMINITVARS USERRECLST))) SYSTEMINITVARS USERRECLST)))
(DEFINEQ (DEFINEQ
(LOADUP-LISP (LOADUP-LISP
(LAMBDA NIL (* \; "Edited 29-Apr-2021 22:30 by rmk:") (LAMBDA NIL (* \;
 "Edited 15-Jan-2022 15:47 by larry")
(* \; "Edited 29-Apr-2021 22:30 by rmk:")
(SETQQ COMPILE.EXT LCOM) (* \; "should be set earlier") (SETQQ COMPILE.EXT LCOM) (* \; "should be set earlier")
(DRIBBLE (MEDLEYDIR "tmp" "lisp.dribble" T)) (DRIBBLE (MEDLEYDIR "tmp" "lisp.dribble" T))
(FOR X IN BOOTLOADEDFILES DO (CL:UNLESS (MEMB X SYSFILES) (FOR X IN BOOTLOADEDFILES DO (CL:UNLESS (MEMB X SYSFILES)
(PRINTOUT T X " bootloaded" T) (PRINTOUT T X " bootloaded" T)
(SETQ SYSFILES (CONS X SYSFILES)))) (SETQ SYSFILES (CONS X SYSFILES))))
(SETQ BOOTLOADEDFILES NIL) (SETQ BOOTLOADEDFILES NIL)
(IF (NOT (BOUNDP 'DIRECTORIES)) (IF (NOT (BOUNDP 'DIRECTORIES))
THEN (SETQ DIRECTORIES LOADUPDIRECTORIES)) THEN (SETQ DIRECTORIES LOADUPDIRECTORIES))
@ -87,7 +90,7 @@
(LOADUP '(TIME)) (LOADUP '(TIME))
(LOADUP '(BRKDWN)) (LOADUP '(BRKDWN))
(LOADUP '(XCL-EXTRAS)) (* (LOADUP '(XCL-EXTRAS)) (*
 "CMLPACKAGE pushes onto INSPECTMACROS")  "CMLPACKAGE pushes onto INSPECTMACROS")
(LOADUP '(CMLPACKAGE)) (LOADUP '(CMLPACKAGE))
(* |;;| "Puts ARGNAME properties on CL and XCL functions that IL:SMARTARGLIST can't hack. Keep this last so everything will be defined when it runs") (* |;;| "Puts ARGNAME properties on CL and XCL functions that IL:SMARTARGLIST can't hack. Keep this last so everything will be defined when it runs")
@ -101,7 +104,7 @@
(LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP (LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP
NSPRINT AUTHENTICATION BSP CLEARINGHOUSE NSFILING MAIKOETHER)) NSPRINT AUTHENTICATION BSP CLEARINGHOUSE NSFILING MAIKOETHER))
(DRIBBLE) (DRIBBLE)
(SETQ MAKESYSNAME ':LISP))) (SETQ MAKESYSNAME :MEDLEY)))
) )
(RPAQ? FILING.ENUMERATION.DEPTH 1) (RPAQ? FILING.ENUMERATION.DEPTH 1)
@ -112,5 +115,5 @@
(GLOBALVARS LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST) (GLOBALVARS LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
) )
(DECLARE\: DONTCOPY (DECLARE\: DONTCOPY
(FILEMAP (NIL (671 4761 (LOADUP-LISP 681 . 4759))))) (FILEMAP (NIL (642 4883 (LOADUP-LISP 652 . 4881)))))
STOP STOP

BIN
sources/LOADUP-LISP.LCOM
View File

Binary file not shown.