Skip to content

Commit 27d4df4

Browse files
rmkaplanrmkaplan
authored
Merge pull request #645 from Interlisp/lmm15
Lmm15
2 parents fadf810 + 312e99b commit 27d4df4

File tree

10 files changed

+181
-164
lines changed

10 files changed

+181
-164
lines changed

‎internal/library/MEDLEY-UTILS‎

Lines changed: 49 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -1,43 +1,41 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
22

3-
(FILECREATED "25-Oct-2021 14:54:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;14| 9472
3+
(FILECREATED "26-Dec-2021 18:58:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;2| 9049
44

5-
|changes| |to:| (VARS MEDLEY-UTILSCOMS)
6-
(FNS GATHER-INFO)
5+
:CHANGES-TO (FNS GATHER-INFO)
76

8-
|previous| |date:| "23-Oct-2021 14:53:16"
9-
|{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;2|)
7+
:PREVIOUS-DATE "25-Oct-2021 14:54:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;1|
8+
)
109

1110

1211
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
1312

1413
(RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
15-
(VARS MEDLEY-FIX-DIRS)
16-
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
14+
(VARS MEDLEY-FIX-DIRS)
15+
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
1716
(DEFINEQ
1817

1918
(GATHER-INFO
2019
(LAMBDA (PHASE) (* \;
21-
 "Edited 24-Oct-2021 09:43 by larry")
20+
 "Edited 26-Dec-2021 18:56 by larry")
21+
(* \;
22+
 "Edited 24-Oct-2021 09:43 by larry")
2223
(SELECTQ PHASE
23-
(ALL (SETQ SYSFILES (UNION SYSFILES FILELST))
24-
(SETQ FILELST NIL)
25-
(FILESLOAD (SOURCE)
26-
SYSEDIT)
27-
(|for| I |from| 1 |to| 4 |do| (GATHER-INFO I)))
28-
(1 (SETQ LOADEDFILES (|for| X |in| LOADEDFILELST |collect| (FILENAMEFIELD
29-
X
30-
'NAME)))
24+
(ALL (|for| I |from| 0 |to| 4 |do| (GATHER-INFO I)))
25+
(0 (SETQ SYSFILES (UNION SYSFILES FILELST))
26+
(SETQ FILELST NIL)
27+
(FILESLOAD (SOURCE)
28+
SYSEDIT))
29+
(1 (SETQ LOADEDFILES (|for| X |in| LOADEDFILELST |collect| (FILENAMEFIELD X 'NAME)))
3130
(FILESLOAD FILESETS)
3231
(SETQ ALLFILESETSFILES (|for| X |in| FILESETS |join| (APPEND (EVAL X))))
3332
(SETQ SOURCES (|for| X |in| (DIRECTORY (MEDLEYDIR "sources" "*.*;" T))
3433
|when| (NOT (MEMB (FILENAMEFIELD X 'EXTENSION)
35-
'(LCOM DFASL TEDIT TXT)))
34+
'(LCOM DFASL TEDIT TXT)))
3635
|collect| (FILENAMEFIELD X 'NAME))))
3736
(-1 (PRINTOUT T " loaded files not in SYSFILES or FILELST: "
3837
(|for| X |in| LOADEDFILES |when| (NOT (OR (FMEMB X SYSFILES)
39-
(FMEMB X FILELST)))
40-
|collect| X)
38+
(FMEMB X FILELST))) |collect| X)
4139
T)
4240
(PRINTOUT T "Sources not loaded: " (CL:SET-DIFFERENCE SOURCES (APPEND ALLFILESETSFILES
4341
LOADEDFILES))
@@ -52,50 +50,45 @@
5250
DEFD))
5351
(|for| X |in| DEFINEDFNS |when| (CCODEP X)
5452
|do| (LET ((Y (PUTPROP X 'CCC (CALLSCCODE X))))
55-
(|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY)
56-
|as| VAL |in| Y
57-
|do| (|for| S |in| VAL
58-
|do| (PUTPROP S REV (CONS X (GETPROP S REV)))))))
53+
(|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY)
54+
|as| VAL |in| Y |do| (|for| S |in| VAL
55+
|do| (PUTPROP S REV (CONS X (GETPROP S REV)))))))
5956
(SETQ CALLEDFNS NIL)
6057
(MAPATOMS (FUNCTION (LAMBDA (X)
6158
(|if| (AND (NOT (GETD X))
62-
(GETPROP X 'CALLED-BY))
59+
(GETPROP X 'CALLED-BY))
6360
|then| (CL:PUSH X CALLEDFNS))))))
6461
(-2 (PRINTOUT T "Functions called and not defined" CALLEDFNS T))
6562
(3 (|for| X |in| SYSFILES
66-
|do|
67-
(LOAD X 'PROP)
68-
(PUTPROP X 'CONTENT (READFILE X))
69-
(|for| EXR |in| (GETPROP X 'CONTENT)
70-
|do| (SELECTQ (CAR EXR)
71-
(DEFINEQ (|for| DFN |in| (CDR EXR)
72-
|do| (|if| (EQUAL (CADR DFN)
73-
(GETPROP (CAR DFN)
74-
'EXPR))
75-
|then| (PRINTOUT T (CAR DFN)
76-
" ")
77-
(PUTPROP (CAR DFN)
78-
'EXPR
79-
(CADR DFN))
80-
|else| (PRINTOUT T (CAR DFN)
81-
"* "))))
82-
NIL)))
83-
(SETQ ALLCONTENT (|for| X |in| SYSFILES |collect| (CONS X (GETPROP
84-
X
85-
'CONTENT))))
63+
|do| (LOAD X 'PROP)
64+
(PUTPROP X 'CONTENT (READFILE X))
65+
(|for| EXR |in| (GETPROP X 'CONTENT)
66+
|do| (SELECTQ (CAR EXR)
67+
(DEFINEQ (|for| DFN |in| (CDR EXR)
68+
|do| (|if| (EQUAL (CADR DFN)
69+
(GETPROP (CAR DFN)
70+
'EXPR))
71+
|then| (PRINTOUT T (CAR DFN)
72+
" ")
73+
(PUTPROP (CAR DFN)
74+
'EXPR
75+
(CADR DFN))
76+
|else| (PRINTOUT T (CAR DFN)
77+
"* "))))
78+
NIL)))
79+
(SETQ ALLCONTENT (|for| X |in| SYSFILES |collect| (CONS X (GETPROP X 'CONTENT))))
8680
(* \; " don't edit with SEDIT")
8781
(LET (DUPS)
8882
(|for| X |in| SYSFILES
8983
|do| (|for| FN |in| (FILEFNSLST X)
90-
|do| (|if| (GETPROP FN 'WHEREIS)
91-
|then| (NCONC1 (GETPROP FN 'WHEREIS)
92-
X)
93-
(OR (FMEMB FN DUPS)
94-
(SETQ DUPS (CONS FN DUPS)))
95-
|else| (PUTPROP FN 'WHEREIS (LIST X)))))
84+
|do| (|if| (GETPROP FN 'WHEREIS)
85+
|then| (NCONC1 (GETPROP FN 'WHEREIS)
86+
X)
87+
(OR (FMEMB FN DUPS)
88+
(SETQ DUPS (CONS FN DUPS)))
89+
|else| (PUTPROP FN 'WHEREIS (LIST X)))))
9690
(SETQ DUPFNS DUPS))
97-
(SETQ NO-SOURCE (|for| X |in| DEFINEDFNS |when| (NOT (GETPROP X 'EXPR))
98-
|collect| X)))
91+
(SETQ NO-SOURCE (|for| X |in| DEFINEDFNS |when| (NOT (GETPROP X 'EXPR)) |collect| X)))
9992
(-3 (PRINTOUT T "Functions compiled but no expr" NO-SOURCE T)
10093
(PRINTOUT T "Functions on more than one file: " DUPFNS T))
10194
(4 (PRINTOUT T T "STARTING MASTERSCOPE PHASE ON " (DATE)
@@ -104,7 +97,7 @@
10497
SYSEDIT)
10598
(|for| X |in| SYSFILES |do| (MSNOTICEFILE X))
10699
(|for| X |in| SYSFILES |do| (PRINTOUT T T "Analyzing " X T)
107-
(MASTERSCOPE `(ANALYZE ON ,(KWOTE X)))))
100+
(MASTERSCOPE `(ANALYZE ON ,(KWOTE X)))))
108101
(-4 "No queries yet")
109102
(HELP))))
110103

@@ -124,7 +117,7 @@
124117
)
125118

126119
(RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal/library" "greetfiles"
127-
"docs>Documentation Tools"))
120+
"docs>Documentation Tools"))
128121
(DEFINEQ
129122

130123
(MAKE-EXPORTS-ALL
@@ -157,6 +150,6 @@
157150
(DRIBBLE))))
158151
)
159152
(DECLARE\: DONTCOPY
160-
(FILEMAP (NIL (618 7420 (GATHER-INFO 628 . 6522) (MEDLEY-FIX-LINKS 6524 . 7047) (MEDLEY-FIX-DATES 7049
161-
. 7418)) (7578 9449 (MAKE-EXPORTS-ALL 7588 . 8604) (MAKE-WHEREIS-HASH 8606 . 9447)))))
153+
(FILEMAP (NIL (553 7001 (GATHER-INFO 563 . 6103) (MEDLEY-FIX-LINKS 6105 . 6628) (MEDLEY-FIX-DATES 6630
154+
. 6999)) (7155 9026 (MAKE-EXPORTS-ALL 7165 . 8181) (MAKE-WHEREIS-HASH 8183 . 9024)))))
162155
STOP

‎internal/library/MEDLEY-UTILS.LCOM‎

-36 Bytes
Binary file not shown.

‎library/MSCOMMON‎

Lines changed: 45 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,17 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
2-
(FILECREATED " 4-May-92 13:10:53" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;3| 23489
32

4-
|changes| |to:| (TEMPLATES CL:DECF CL:INCF CL:PUSH)
3+
(FILECREATED "15-Jan-2022 20:17:21" |{DSK}<home>larry>medley>library>MSCOMMON.;4| 24053
54

6-
|previous| |date:| "12-Jun-90 10:17:31" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;2|)
5+
:CHANGES-TO (TEMPLATES ADD-EXEC CL:ASSOC CL:COMPILE-FILE EXEC CL:IN-PACKAGE CL:MAKE-STRING OPEN
6+
CL:PUSH CL:PUSHNEW CL:RASSOC CL:WRITE-LINE CL:WRITE-STRING CL:WHEN CL:UNLESS
7+
)
8+
(FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
9+
(VARS MSCOMMONCOMS)
710

11+
:PREVIOUS-DATE " 4-May-92 13:10:53" |{DSK}<home>larry>medley>library>MSCOMMON.;3|)
812

9-
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation. All rights reserved.
13+
14+
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation.
1015

1116
(PRETTYCOMPRINT MSCOMMONCOMS)
1217

@@ -37,16 +42,16 @@
3742
CL:STRING-LESSP CL:STRING-NOT-EQUAL CL:STRING-NOT-GREATERP CL:STRING-NOT-LESSP
3843
CL:STRING-UPCASE CL:STRING/= CL:STRING< CL:STRING<= CL:STRING= CL:STRING> CL:STRING>=
3944
CL:SUBLIS CL:SUBSETP CL:SUBST CL:SUBST-IF CL:SUBST-IF-NOT CL:SUBSTITUTE
40-
CL:SUBSTITUTE-IF CL:SUBSTITUTE-IF-NOT CL:TREE-EQUAL CL:UNION CL:VECTOR-PUSH
41-
CL:VECTOR-PUSH-EXTEND WRITE CL:WRITE-LINE CL:WRITE-STRING CL:WRITE-TO-STRING)
45+
CL:SUBSTITUTE-IF CL:SUBSTITUTE-IF-NOT CL:TREE-EQUAL CL:UNION CL:UNLESS CL:VECTOR-PUSH
46+
CL:VECTOR-PUSH-EXTEND CL:WHEN WRITE CL:WRITE-LINE CL:WRITE-STRING CL:WRITE-TO-STRING)
4247
(P
4348
(* |;;| "First tell Masterscope how to find FUNCTIONS and VARIABLES")
4449

4550
(MSADDANALYZE 'VARIABLES 'VARIABLE 'VARIABLES 'VARIABLESMSGETDEF)
4651
(MSADDANALYZE 'FUNCTIONS 'FUNCTION 'FUNCTIONS 'FUNCTIONSMSGETDEF 'FUNCTIONSMSMC)
4752

4853
(* |;;|
49-
 "Then add KEYWORD support. Templates may now contain the following as their last element:")
54+
 "Then add KEYWORD support. Templates may now contain the following as their last element:")
5055

5156

5257
(* |;;| "... KEYWORDS list of keywords accepted)")
@@ -65,7 +70,7 @@
6570
(MSADDMODIFIER 'SPECIFY 'KEYWORDS 'KEYSPECIFY)
6671

6772
(* |;;|
68-
 "Stuff for locally-defined things. We don't attempt to handle them (*sigh*), just record them.")
73+
 "Stuff for locally-defined things. We don't attempt to handle them (*sigh*), just record them.")
6974

7075
(MSADDRELATION '(FLET FLETS FLETTING FLET))
7176
(MSADDRELATION '(LABEL LABELS LABELLING LABELLED))
@@ -87,42 +92,48 @@
8792
(DEFINEQ
8893

8994
(FUNCTIONSMSGETDEF
90-
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 31-Mar-88 17:31 by jrb:")
95+
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 31-Mar-88 17:31 by jrb:")
9196
(LET ((BODY (REMOVE-COMMENTS (GETDEF NAME 'FUNCTIONS SOURCE OPTIONS))))
9297
(AND BODY (SELECTQ (CAR BODY)
9398
(DEFMACRO (OR (GETTEMPLATE NAME)
9499
(SETTEMPLATE NAME 'MACRO))
95100
NIL)
96101
(CL:DEFUN
97-
(* |;;| "Body is of the form:")
98-
(* |;;| "(DEFUN name (args...) bodies...)")
99-
(* |;;| "We want to hand Masterscope a massaged form it will understand.")
100-
(* |;;| "Which I believe is of this form:")
102+
(* |;;| "Body is of the form:")
103+
104+
(* |;;| "(DEFUN name (args...) bodies...)")
105+
106+
(* |;;|
107+
 "We want to hand Masterscope a massaged form it will understand.")
101108

102-
`(CL:LAMBDA ,(CADDR BODY) ,@(CDDDR BODY)))
109+
(* |;;| "Which I believe is of this form:")
110+
111+
`(CL:LAMBDA ,(CADDR BODY)
112+
,@(CDDDR BODY)))
103113
NIL)))))
104114

105115
(FUNCTIONSMSMC
106-
(LAMBDA (NAME TYPE REASON) (* \; "Edited 1-Apr-88 13:47 by jrb:")
107-
(* |;;| "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")
116+
(LAMBDA (NAME TYPE REASON) (* \; "Edited 1-Apr-88 13:47 by jrb:")
117+
118+
(* |;;| "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")
108119

109120
(|if| (EQ (CAR (GETDEF NAME 'FUNCTIONS NIL '(NOERROR)))
110-
'DEFMACRO)
121+
'DEFMACRO)
111122
|then| (CHANGEMACRO NAME TYPE REASON)
112123
NIL
113124
|else| T)))
114125

115126
(VARIABLESMSGETDEF
116-
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 19-Feb-88 19:46 by jrb:")
117-
127+
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 19-Feb-88 19:46 by jrb:")
118128
(LET ((BODY (GETDEF NAME 'VARIABLES SOURCE OPTIONS))
119129
SPECVARP)
120130
(AND BODY
121-
122-
(* |;;| "We have to return something here so Masterscope can get hold of the init form, and so It'll stop looking for other things")
131+
132+
(* |;;| "We have to return something here so Masterscope can get hold of the init form, and so It'll stop looking for other things")
123133

124134
`(CL:LAMBDA NIL ,(IF (CADDR BODY)
125-
THEN `(SETQ ,(CADR BODY) ,(CADDR BODY))))))))
135+
THEN `(SETQ ,(CADR BODY)
136+
,(CADDR BODY))))))))
126137
)
127138

128139

@@ -162,9 +173,9 @@
162173
:LOAD :FILE-MANAGER-FORMAT :PROCESS-ENTIRE-FILE))
163174

164175
(SETTEMPLATE 'CL:COMPILER-LET '(! NIL (BOTH (|..| (IF LISTP (NIL EVAL |..| EFFECT)
165-
NIL))
176+
NIL))
166177
(|..| (IF LISTP ((BOTH BIND COMPILER-LET))
167-
(BOTH BIND COMPILER-LET))))
178+
(BOTH BIND COMPILER-LET))))
168179
|..| EFFECT RETURN))
169180

170181
(SETTEMPLATE 'CL:COUNT '(EVAL EVAL KEYWORDS :FROM-END :TEST :TEST-NOT :START :END :KEY))
@@ -179,10 +190,10 @@
179190

180191
(SETTEMPLATE 'DECLARE '(|..| (@ EXPR (CONS NIL (SELECTQ (CAR (LISTP EXPR))
181192
(LOCALVARS '(IF LISTP (|..| LOCALVARS)
182-
LOCALVARS))
193+
LOCALVARS))
183194
((SPECVARS CL:SPECIAL)
184195
'(IF LISTP (|..| SPECVARS)
185-
SPECVARS))
196+
SPECVARS))
186197
NIL)))))
187198

188199
(SETTEMPLATE 'CL:DELETE '(EVAL SMASH KEYWORDS :FROM-END :TEST :TEST-NOT :START :END :COUNT :KEY))
@@ -391,7 +402,7 @@
391402
(SETTEMPLATE 'CL:REPLACE '(SMASH EVAL KEYWORDS :START1 :END1 :START2 :END2))
392403

393404
(SETTEMPLATE 'CL:ROTATEF '(|..| (IF (ATOM EXPR)
394-
SET SMASH)))
405+
SET SMASH)))
395406

396407
(SETTEMPLATE 'CL:SEARCH '(EVAL EVAL KEYWORDS :FROM-END :TEST :TEST-NOT :KEY :START1 :START2 :END1
397408
:END2))
@@ -401,7 +412,7 @@
401412
(SETTEMPLATE 'CL:SET-EXCLUSIVE-OR '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
402413

403414
(SETTEMPLATE 'CL:SHIFTF '(|..| (IF (ATOM EXPR)
404-
SET SMASH)
415+
SET SMASH)
405416
EVAL))
406417

407418
(SETTEMPLATE 'CL:SORT '(EVAL FUNCTION KEYWORDS :KEY))
@@ -459,10 +470,14 @@
459470

460471
(SETTEMPLATE 'CL:UNION '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
461472

473+
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFECT RETURN))
474+
462475
(SETTEMPLATE 'CL:VECTOR-PUSH '(EVAL SMASH))
463476

464477
(SETTEMPLATE 'CL:VECTOR-PUSH-EXTEND '(EVAL SMASH EVAL))
465478

479+
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFECT RETURN))
480+
466481
(SETTEMPLATE 'WRITE '(EVAL KEYWORDS :STREAM :ESCAPE :RADIX :BASE :CIRCLE :PRETTY :LEVEL :LENGTH :CASE
467482
:GENSYM :ARRAY))
468483

@@ -539,6 +554,6 @@
539554
(CLRHASH USERTEMPLATES)
540555
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992))
541556
(DECLARE\: DONTCOPY
542-
(FILEMAP (NIL (5000 6811 (FUNCTIONSMSGETDEF 5010 . 5804) (FUNCTIONSMSMC 5806 . 6286) (
543-
VARIABLESMSGETDEF 6288 . 6809)))))
557+
(FILEMAP (NIL (5280 7291 (FUNCTIONSMSGETDEF 5290 . 6258) (FUNCTIONSMSMC 6260 . 6731) (
558+
VARIABLESMSGETDEF 6733 . 7289)))))
544559
STOP

‎library/MSCOMMON.DFASL‎

154 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)