-
-
Notifications
You must be signed in to change notification settings - Fork 25
/
Copy pathINSPECTCODE-TEDIT
321 lines (303 loc) · 16 KB
/
INSPECTCODE-TEDIT
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE (DEFPACKAGE "INSPECTCODE-TEDIT" (§USE "INTERLISP") (
§NICKNAMES "ICT") (§PREFIX-NAME "ICT")))
(FILECREATED " 4-May-87 11:52:50" {DSK}<LISPFILES>MATT>INSPECTCODE-TEDIT.;10 16087
changes to%: (ADVICE IL:OPENTEXTSTREAM-IN-\TEDIT.INSPECTCODE)
(FILEVARS IL:INSPECTCODE-TEDITCOMS)
(FNS TITLEMENU-FN OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE)
previous date%: " 7-Apr-87 16:03:12" IL:{DSK}<LISPFILES>MATT>INSPECTCODE-TEDIT.;9)
(* "
Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc.. All rights reserved.
")
(PRETTYCOMPRINT IL:INSPECTCODE-TEDITCOMS)
(RPAQQ IL:INSPECTCODE-TEDITCOMS ((FNS BUILD.TITLEMENU ICON-FN INSP.ERROR KILL.TEDIT.PROCESS NOSELFN
OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE TITLEMENU-FN)
(UGLYVARS ICON.TEMPLATE)
(P (CHANGENAME '\TEDIT.INSPECTCODE 'TEXTICON 'ICON-FN)
(CHANGENAME '\TEDIT.INSPECTCODE 'OPENTEXTSTREAM '
OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE))
(COMMANDS IC)
(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
INSPECTCODE-TEDIT)))
(DEFINEQ
(BUILD.TITLEMENU
[LAMBDA NIL (* ; "Edited 30-Mar-87 16:32 by Matt Heffron")
(DECLARE (GLOBALVARS TITLEMENU))
(SETQ TITLEMENU (create MENU
ITEMS _ '((GraphCalls 'GC "Invoke GRAPHCALLS on the current selection")
(InspectCode 'IC "INSPECTCODE the current selection")
(Inspect 'INSP "INSPECT the current selection"
(SUBITEMS (Freely 'INSP
"INSPECT the free-reference value of the selection"
)
(Globally 'INSP.GLOB
"INSPECT the Global (Top Level) value of the selection"
)
("In Process Context" 'INSP.PROC
"INSPECT the value of the selection in a process' context"
)))
("Pretty Print Value" 'PPV
"Pretty Print the value of the current selection"
(SUBITEMS (Freely 'PPV
"Pretty Print the free-reference value of the selection"
)
(Globally 'PPV.GLOB
"Pretty Print the Global (Top Level) value of the selection"
)
("In Process Context" 'PPV.PROC
"Pretty Print the value of the selection in a process' context"
)))
(Quit 'QUIT "Terminates this INSPECTCODE"])
(ICON-FN
[LAMBDA (W) (* ; "Edited 30-Mar-87 15:59 by Matt Heffron")
(DECLARE (GLOBALVARS ICON.TEMPLATE))
(LET ((ICON (TITLEDICONW ICON.TEMPLATE (WINDOWPROP W 'FNNAME)
(FONTCREATE 'HELVETICA 8 'MRR NIL NIL T)
NIL T)))
(WINDOWPROP W 'ICON ICON)
(WINDOWPROP W 'ICONWINDOW ICON)
(WINDOWPROP W 'ICONFN NIL)
ICON])
(INSP.ERROR
[LAMBDA (MESS1 MESS2 MESS3) (* ; "Edited 30-Mar-87 16:00 by Matt Heffron")
(CLRPROMPT)
(if (NOT MESS2)
then (PROMPTPRINT MESS1)
elseif (NOT MESS3)
then (PROMPTPRINT MESS1 MESS2)
else (PROMPTPRINT MESS1 MESS2 MESS3))
(RINGBELLS])
(KILL.TEDIT.PROCESS
[LAMBDA (W) (* ; "Edited 30-Mar-87 16:00 by Matt Heffron")
(DEL.PROCESS (WINDOWPROP W 'PROCESS])
(NOSELFN
[LAMBDA NIL (* ; "Edited 30-Mar-87 16:01 by Matt Heffron")
(CLRPROMPT)
(PROMPTPRINT "No current selection")
(RINGBELLS])
(OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE
[LAMBDA (TEXT WINDOW START END PROPS) (* ; "Edited 4-May-87 11:47 by ")
(PROG1 [OPENTEXTSTREAM TEXT WINDOW START END (APPEND PROPS '(QUITFN T TITLEMENUFN TITLEMENU-FN
NOTITLE T]
(WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION KILL.TEDIT.PROCESS))
(WINDOWPROP WINDOW 'FNNAME FN)
(WINDOWPROP WINDOW '*PACKAGE* *PACKAGE*)
(WINDOWPROP WINDOW '*READTABLE* *READTABLE*])
(TITLEMENU-FN
[LAMBDA (W) (* ; "Edited 4-May-87 11:32 by ")
(* ; "Edited 4-May-87 11:25 by ")
(* ; "Edited 4-May-87 11:19 by ")
(DECLARE (GLOBALVARS TITLEMENU))
(if (OR (NOT (BOUNDP 'TITLEMENU))
(NOT (type? MENU TITLEMENU)))
then (BUILD.TITLEMENU))
[LET*
((STREAM (TEXTSTREAM W))
(W*PACKAGE* (WINDOWPROP W '*PACKAGE*))
(W*READTABLE* (WINDOWPROP W '*READTABLE*))
(SELLEN (fetch (SELECTION DCH) of (TEDIT.GETSEL STREAM)))
(MENUCHOICE (MENU TITLEMENU))
(SpecifyRegionString "Specify a region for the value pretty print window")
INSPVAL SELSTR DISPLAYWINDOW)
(if (NOT MENUCHOICE)
then (* ;
"Nothing to do, clicked out of menu")
elseif (EQ MENUCHOICE 'QUIT)
then (TEDIT.QUIT STREAM)
(if (OPENWP W)
then (CLOSEW W))
else [if (EQ SELLEN 0)
then (NOSELFN)
elseif (GREATERP SELLEN 255)
then (INSP.ERROR "Selection is too long (> 255 characters)")
(TEDIT.SHOWSEL STREAM NIL NIL)
(TEDIT.SETSEL STREAM 0 0 'LEFT)
else (SETQ SELSTR (LET [(*PACKAGE* W*PACKAGE*)
(*READTABLE* W*READTABLE*)
(STRM (OPENSTRINGSTREAM (TEDIT.SEL.AS.STRING STREAM NIL)
'INPUT]
(READ STRM]
(SELECTQ MENUCHOICE
(IC (LET ((*PACKAGE* W*PACKAGE*)
(*READTABLE* W*READTABLE*))
(INSPECTCODE SELSTR)))
(GC (if (FGETD 'GRAPHCALLSW)
then (if (NOT (LET ((*PACKAGE* W*PACKAGE*)
(*READTABLE* W*READTABLE*))
(GRAPHCALLS SELSTR)))
then (INSP.ERROR "Nothing to graph!!"))
else (INSP.ERROR "The GRAPHCALLS package is not loaded. Cannot graph " SELSTR)
))
((INSP PPV)
(if (BOUNDP SELSTR)
then (if (EQ MENUCHOICE 'PPV)
then (PROMPTPRINT SpecifyRegionString)
(SETQ DISPLAYWINDOW (CREATEW (GETREGION (WIDTHIFWINDOW 72)
(HEIGHTIFWINDOW 72 T))
SELSTR))
(CLRPROMPT)
(printout DISPLAYWINDOW .PPV (EVAL SELSTR))
else (INSPECT (EVALV SELSTR)))
else (INSP.ERROR SELSTR " has no value to " (if (EQ MENUCHOICE 'PPV)
then "print"
else "inspect"))))
((INSP.GLOB PPV.GLOB)
(if (NEQ (SETQ INSPVAL (GETTOPVAL SELSTR))
'NOBIND)
then (if (EQ MENUCHOICE 'PPV.GLOB)
then (PROMPTPRINT SpecifyRegionString)
(SETQ DISPLAYWINDOW (CREATEW (GETREGION (WIDTHIFWINDOW 72)
(HEIGHTIFWINDOW 72 T))
SELSTR))
(CLRPROMPT)
(printout DISPLAYWINDOW .PPV INSPVAL)
else (INSPECT INSPVAL))
else (INSP.ERROR SELSTR " has no Global value to "
(if (EQ MENUCHOICE 'PPV.GLOB)
then "print"
else "inspect"))))
((INSP.PROC PPV.PROC)
(LET (PROCESSLIST PROC)
(DECLARE (SPECVARS PROCESSLIST))
[MAP.PROCESSES (FUNCTION (LAMBDA (PHANDLE PNAME PFORM)
(DECLARE (SPECVARS PROCESSLIST))
(push PROCESSLIST (LIST PNAME PHANDLE]
(SETQ PROC (MENU (create MENU
ITEMS _ PROCESSLIST
CENTERFLG _ T)))
(if PROC
then [if (NEQ (SETQ INSPVAL (PROCESS.EVALV PROC SELSTR))
'NOBIND)
then (if (EQ MENUCHOICE 'PPV.PROC)
then (PROMPTPRINT SpecifyRegionString)
(SETQ DISPLAYWINDOW
(CREATEW (GETREGION (WIDTHIFWINDOW 72)
(HEIGHTIFWINDOW 72 T))
SELSTR))
(CLRPROMPT)
(printout DISPLAYWINDOW .PPV INSPVAL)
else (INSPECT INSPVAL))
else (INSP.ERROR SELSTR (if (EQ MENUCHOICE 'PPV.PROC)
then
" has no value to print in process "
else
" has no value to inspect in process "
)
(PROCESSPROP PROC 'NAME]
else (INSP.ERROR "No process selected. Will not "
(if (EQ MENUCHOICE 'PPV.PROC)
then "print "
else "inspect ")
SELSTR))))
(PROGN (* ; "Shouldn't happen, but ignore it.")
]
NIL])
)
(READVAR-FROM-STRING 'ICON.TEMPLATE "({(READBITMAP)(87 91
%"OOOOOOOOOOOOOOOOOOOOON@@%"
%"OOOOOOOOOOOOOOOOOOOOON@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@COO@@@@@F@@%"
%"L@@@@@@@@@@@AOOON@@@@F@@%"
%"L@@@@@@@@@@@GN@AOH@@@F@@%"
%"L@@@@@@@@@@AO@@@CN@@@F@@%"
%"L@@@@@@@@@@CL@@@@O@@@F@@%"
%"L@@@@@@@@@@O@@@@@CL@@F@@%"
%"L@@@@@@@@@AN@@@@@AN@@F@@%"
%"L@@@@@@@@@CH@@@@@@G@@F@@%"
%"L@@@@@@@@@C@@@@@@@C@@F@@%"
%"L@@@@@@@@@G@@@@@@@CH@F@@%"
%"L@@@@@@@@@N@@@@@@@AL@F@@%"
%"L@@@@@@@@@L@@@@@@@@L@F@@%"
%"L@@@@@@@@AL@@@@@@@@N@F@@%"
%"L@@@@@@@@AH@@@@@@@@F@F@@%"
%"L@@@@@@@@CH@@@@@@@@G@F@@%"
%"L@@@@@@@@C@@@@@@@@@C@F@@%"
%"L@@@@@@@@C@@@@@@@@@C@F@@%"
%"L@@@@@@@@GGL@OHGO@OOHF@@%"
%"L@@@@@@@@GLFCHNFALLAHF@@%"
%"L@@@@@@@@GHCC@FF@LLAHF@@%"
%"L@@@@@@@@G@@F@CF@FLAHF@@%"
%"LBIGKMLNOO@@F@CF@FOOHF@@%"
%"LBMDBEA@BG@@F@CF@FLAHF@@%"
%"LBOGKMM@BG@@F@CF@FLAHF@@%"
%"LBK@JAA@BGHCC@FF@LLAHF@@%"
%"LBIGJALNBGLFCHNFALLAHF@@%"
%"L@@@@@@@@GGL@OHGO@OOHF@@%"
%"L@@@@@@@@C@@@@@@@@@C@F@@%"
%"L@@@@@@@@C@@@@@@@@@C@F@@%"
%"L@@@@@@@@CH@@@@@@@@G@F@@%"
%"L@@@@@@@@AH@@@@@@@@F@F@@%"
%"L@@@@@@@@AL@@@@@@@@N@F@@%"
%"L@@@@@@@@@L@@@@@@@@L@F@@%"
%"L@@@@@@@@@N@@@@@@@AL@F@@%"
%"L@@@@@@@@@G@@@@@@@CH@F@@%"
%"L@@@@@@@@@G@@@@@@@C@@F@@%"
%"L@@@@@@@@@OL@@@@@@G@@F@@%"
%"L@@@@@@@@@ON@@@@@AN@@F@@%"
%"L@@@@@@@@AGO@@@@@CL@@F@@%"
%"L@@@@@@@@CKCL@@@@O@@@F@@%"
%"L@@@@@@@@GLAO@@@CN@@@F@@%"
%"L@@@@@@@@OH@GN@AOH@@@F@@%"
%"L@@@@@@@AO@@AOOON@@@@F@@%"
%"L@@@@@@@FN@@@COO@@@@@F@@%"
%"L@@@@@@@OD@@@@@@@@@@@F@@%"
%"L@@@@@@AOH@@@@@@@@@@@F@@%"
%"L@@@@@@COH@@@@@@@@@@@F@@%"
%"L@@@@@@GO@@@@@@@@@@@@F@@%"
%"L@@@@@@ON@@@@@@@@@@@@F@@%"
%"L@@@@@AOL@@@@@@@@@@@@F@@%"
%"L@@@@@COH@@@@@@@@@@@@F@@%"
%"L@@@@@GO@@@@@@@@@@@@@F@@%"
%"L@@@@@ON@@@@@@@@@@@@@F@@%"
%"L@@@@AOL@@@@@@@@@@@@@F@@%"
%"L@@@@COH@@@@@@@@@@@@@F@@%"
%"L@@@@GO@@@@@@@@@@@@@@F@@%"
%"L@@@@ON@@@@@@@@@@@@@@F@@%"
%"L@@@AOL@@@@@@@@@@@@@@F@@%"
%"L@@@COH@@@@@@@@@@@@@@F@@%"
%"L@@@GO@@@@@@@@@@@@@@@F@@%"
%"L@@@GN@@@@@@@@@@@@@@@F@@%"
%"L@@@CL@@@@@@@@@@@@@@@F@@%"
%"L@@@AH@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"L@@@@@@@@@@@@@@@@@@@@F@@%"
%"OOOOOOOOOOOOOOOOOOOOON@@%"
%"OOOOOOOOOOOOOOOOOOOOON@@%")} NIL (4 5 79 18))
")
(CHANGENAME '\TEDIT.INSPECTCODE 'TEXTICON 'ICON-FN)
(CHANGENAME '\TEDIT.INSPECTCODE 'OPENTEXTSTREAM 'OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE)
(DEFCOMMAND IC (FN) (INSPECTCODE FN))
(PUTPROPS INSPECTCODE-TEDIT FILETYPE :TCOMPL)
(PUTPROPS INSPECTCODE-TEDIT MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE (DEFPACKAGE
"INSPECTCODE-TEDIT"
(:USE "INTERLISP")
(:NICKNAMES "ICT")
(:PREFIX-NAME
"ICT"))))
(PUTPROPS INSPECTCODE-TEDIT COPYRIGHT ("Beckman Instruments, Inc." 1985 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1353 12345 (BUILD.TITLEMENU 1363 . 3517) (ICON-FN 3519 . 3975) (INSP.ERROR 3977 . 4315)
(KILL.TEDIT.PROCESS 4317 . 4491) (NOSELFN 4493 . 4688) (OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE 4690 .
5238) (TITLEMENU-FN 5240 . 12343)))))
STOP