-
Notifications
You must be signed in to change notification settings - Fork 0
/
STRINGSCOPE
386 lines (333 loc) · 22.5 KB
/
STRINGSCOPE
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
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Apr-2023 08:23:02" {DSK}<home>medley>il>STRINGSCOPE.;56 22397
:EDIT-BY "PA"
:CHANGES-TO (FNS SSCMD.GET)
:PREVIOUS-DATE "29-Apr-2023 10:41:18" {DSK}<home>medley>il>STRINGSCOPE.;55)
(PRETTYCOMPRINT STRINGSCOPECOMS)
(RPAQQ STRINGSCOPECOMS
((FNS APPEND.CHAR ATLEASTNCHRSP CREATE.SSWINDOW EXTRACT.STRINGS HANDLE.SSMENU LIST.STRINGS
PRINTABLEP REPAINT.SSWINDOW RESHAPE.SSWINDOW SET.SSCWIN.TITLE SSCMD.EXIT SSCMD.FIND
SSCMD.GET SSCMD.INFO SSCMD.MINLEN SSCMD.RESET SSCMD.SORT STRINGS STRINGSCOPE)
(VARS)
(INITVARS (SSCOPE.MIN.LEN 4))
(COMMANDS STRINGS)
(FUNCTIONS WITH.INPUT.FILE)))
(DEFINEQ
(APPEND.CHAR
[LAMBDA (STRING CODE) (* ; "Edited 25-Jan-2023 09:48 by PA")
(* Return a copy of STRING with the character of code CODE appended to the end.)
(CONCAT STRING (CHARACTER CODE])
(ATLEASTNCHRSP
[LAMBDA (STRING MIN.LEN) (* ; "Edited 29-Jan-2023 11:25 by PA")
(* ; "Edited 25-Jan-2023 09:37 by PA")
(* Return STRING if it has a length of
at least MIN.LEN characters, NIL
otherwise.)
(AND (STRINGP STRING)
(SMALLP MIN.LEN)
(IGEQ (NCHARS STRING)
MIN.LEN])
(CREATE.SSWINDOW
[LAMBDA (FILE STRINGS MIN.LENGTH) (* ; "Edited 29-Apr-2023 08:42 by PA")
(* ; "Edited 28-Apr-2023 06:02 by PA")
(* ; "Edited 26-Apr-2023 04:42 by PA")
(* ; "Edited 22-Apr-2023 11:38 by PA")
(* ; "Edited 15-Apr-2023 12:56 by PA")
(* ; "Edited 1-Apr-2023 12:04 by PA")
(* ; "Edited 27-Jan-2023 10:55 by PA")
(* ; "Edited 26-Jan-2023 10:48 by PA")
(* Create and return a window containing the output of Stringscope.
Based on an example in IRM.)
(PROG (WINDOW)
(SETQ WINDOW (CREATEMENUEDWINDOW (create MENU
ITEMS _ '((Info INFO
"Show statistics about the strings"
)
(Get GET "Open new file")
(Find FIND
"Search for strings matching a specified text"
)
(Sort SORT "Sort strings"
(SUBITEMS (Ascending ASCENDING
"Sort strings in ascending order"
)
(Descending DESCENDING
"Sort strings in descending order"
)))
("Min Len" MINLEN
"Set minimum string length")
(Reset RESET
"Redisplay the strings as read from the file"
)
(Exit EXIT "Quit the program"))
CENTERFLG _ T
MENUFONT _ '(MODERN 12)
TITLE _ "Commands"
WHENSELECTEDFN _ (FUNCTION HANDLE.SSMENU))
(SET.SSCWIN.TITLE NIL FILE MIN.LENGTH)
'RIGHT))
(WINDOWPROP WINDOW 'PROMPTAREA (GETPROMPTWINDOW WINDOW))
(* Name of the current file from which
the strings are read.)
(WINDOWPROP WINDOW 'FILE FILE) (* List of strings read from the
current file.)
(WINDOWPROP WINDOW 'STRINGS STRINGS) (* List of processed strings output by
the latest command.)
(WINDOWPROP WINDOW 'STRINGS.CACHE STRINGS)
(WINDOWPROP WINDOW 'MIN.LENGTH MIN.LENGTH)
(WINDOWPROP WINDOW 'REPAINTFN (FUNCTION REPAINT.SSWINDOW))
(WINDOWPROP WINDOW 'RESHAPEFN (FUNCTION RESHAPE.SSWINDOW))
(WINDOWPROP WINDOW 'SCROLLFN (FUNCTION SCROLLBYREPAINTFN))
(RESHAPE.SSWINDOW WINDOW)
(RETURN WINDOW])
(EXTRACT.STRINGS
[LAMBDA (STREAM MIN.CHARS) (* ; "Edited 29-Jan-2023 10:25 by PA")
(* ; "Edited 27-Jan-2023 10:12 by PA")
(* ; "Edited 25-Jan-2023 09:43 by PA")
(* ; "Edited 22-Jan-2023 10:19 by PA")
(* ; "Edited 19-Jan-2023 10:28 by PA")
(* Return a list of the printable strings in STREAM in the same order in which
they appear. The strings must be at least SSCOPE.MIN.LEN characters in length.)
(PROG (MIN.LENGTH (STATE 'BINARY)
(CODE 0)
(BUFFER "")
(STRINGS NIL)) (* State machine that matches
printable strings.)
(SETQ MIN.LENGTH (OR MIN.CHARS SSCOPE.MIN.LEN))
(do (SETQ CODE (BIN STREAM))
(SELECTQ STATE
(BINARY (if (PRINTABLEP CODE)
then (SETQ BUFFER (APPEND.CHAR BUFFER CODE))
(SETQ STATE 'MAYBE.STRING)))
(MAYBE.STRING (if (PRINTABLEP CODE)
then (SETQ BUFFER (APPEND.CHAR BUFFER CODE))
(if (ATLEASTNCHRSP BUFFER MIN.LENGTH)
then (SETQ STATE 'STRING))
else (SETQ BUFFER "")
(SETQ STATE 'BINARY)))
(STRING (if (PRINTABLEP CODE)
then (SETQ BUFFER (APPEND.CHAR BUFFER CODE))
else (SETQ STRINGS (CONS BUFFER STRINGS))
(SETQ BUFFER "")
(SETQ STATE 'BINARY)))
(ERROR STATE "unknown State Machine state")) while (NOT (EOFP STREAM)))
(* The state machine doesn't handle the case of a printable string that ends at
the end of the file, so check if this is the case.)
(if (ATLEASTNCHRSP BUFFER MIN.LENGTH)
then (SETQ STRINGS (CONS BUFFER STRINGS)))
(RETURN (DREVERSE STRINGS])
(HANDLE.SSMENU
[LAMBDA (ITEM MENU KEY) (* ; "Edited 29-Apr-2023 09:04 by PA")
(* ; "Edited 22-Apr-2023 11:41 by PA")
(* ; "Edited 21-Apr-2023 11:12 by PA")
(* ; "Edited 20-Apr-2023 10:11 by PA")
(* ; "Edited 1-Apr-2023 12:04 by PA")
(* Main menu handler that dispatches based on the selected option and executes
the appropriate command.)
(LET* ((MENU.WINDOW (WFROMMENU MENU))
(MAIN.WINDOW (MAINWINDOW WINDOW T)))
(if (OR (EQ KEY 'MIDDLE)
(EQ KEY 'RIGHT))
then NIL
else (SELECTQ (CADR ITEM)
(INFO (SSCMD.INFO MAIN.WINDOW))
(GET (SSCMD.GET MAIN.WINDOW))
(FIND (SSCMD.FIND MAIN.WINDOW))
(SORT (SSCMD.SORT MAIN.WINDOW))
(ASCENDING (SSCMD.SORT MAIN.WINDOW))
(DESCENDING [SSCMD.SORT MAIN.WINDOW (FUNCTION (LAMBDA (S1 S2)
(ALPHORDER S2 S1])
(MINLEN (SSCMD.MINLEN MAIN.WINDOW))
(RESET (SSCMD.RESET MAIN.WINDOW))
(EXIT (SSCMD.EXIT MAIN.WINDOW))
(T (PROMPTPRINT "Unknown menu option"])
(LIST.STRINGS
[LAMBDA (STRINGS STREAM) (* ; "Edited 22-Jan-2023 10:29 by PA")
(* Print to STREAM a report with a list of the strings in the STRINGS list.)
(for STR in STRINGS do (PRIN1 STR STREAM)
(TERPRI STREAM])
(PRINTABLEP
[LAMBDA (CHARCODE) (* ; "Edited 21-Jan-2023 07:12 by PA")
(* ; "Edited 19-Jan-2023 10:00 by PA")
(* Return T if CHARCODE is a printable
ASCII code between SPACE and ~.)
(* ; "Edited 18-Jan-2023 11:52 by PA")
(AND (SMALLP CHARCODE)
(IGEQ CHARCODE 32)
(ILEQ CHARCODE 127])
(REPAINT.SSWINDOW
[LAMBDA (WINDOW REGION) (* ; "Edited 20-Apr-2023 10:21 by PA")
(* ; "Edited 29-Jan-2023 11:27 by PA")
(* ; "Edited 26-Jan-2023 10:26 by PA")
(* Repaint the Stringscope window.
Based on an example in IRM.)
(MOVETO (WINDOWPROP WINDOW 'SSORIGX)
(WINDOWPROP WINDOW 'SSORIGY)
WINDOW)
(LIST.STRINGS (WINDOWPROP WINDOW 'STRINGS.CACHE)
WINDOW])
(RESHAPE.SSWINDOW
[LAMBDA (WINDOW) (* ; "Edited 29-Jan-2023 11:28 by PA")
(* ; "Edited 26-Jan-2023 10:44 by PA")
(* Resize the Stringscope window.
Based on an example in IRM.)
(PROG (BTM)
(DSPRESET WINDOW)
(WINDOWPROP WINDOW 'SSORIGX (DSPXPOSITION NIL WINDOW))
(WINDOWPROP WINDOW 'SSORIGY (DSPYPOSITION NIL WINDOW))
(REPAINT.SSWINDOW WINDOW)
(WINDOWPROP WINDOW 'EXTENT (create REGION
LEFT _ 0
BOTTOM _ [SETQ BTM (IPLUS (DSPYPOSITION NIL WINDOW)
(FONTPROP WINDOW 'ASCENT]
WIDTH _ (WINDOWPROP WINDOW 'WIDTH)
HEIGHT _ (IDIFFERENCE (WINDOWPROP WINDOW 'HEIGHT)
BTM])
(SET.SSCWIN.TITLE
[LAMBDA (WINDOW FILENAME MINLEN) (* ; "Edited 28-Apr-2023 07:49 by PA")
(* If WINDOW is not NIL set the title of Stringscope's main window based on the
name FILENAME of the current file and the minimum length of strings MINLEN.
In either case return the title.)
(* ; "Edited 28-Apr-2023 07:47 by PA")
(LET ((TITLE (CONCAT "Stringscope " (MKATOM FILENAME)
" Min Len: " MINLEN)))
(AND WINDOW (WINDOWPROP WINDOW 'TITLE TITLE))
TITLE])
(SSCMD.EXIT
[LAMBDA (WINDOW) (* ; "Edited 22-Apr-2023 11:40 by PA")
(* Quits the program.)
(CLOSEW WINDOW])
(SSCMD.FIND
[LAMBDA (WINDOW) (* ; "Edited 29-Apr-2023 08:36 by PA")
(* Search for strings matching the
text input by the user and display
them.)
(LET* [(STREAM (WINDOWPROP WINDOW 'PROMPTAREA))
(STRINGS (WINDOWPROP WINDOW 'STRINGS.CACHE))
[SEARCH.PATTERN (PROGN (TERPRI STREAM)
(U-CASE (PROMPTFORWORD "Search for:" NIL NIL STREAM NIL NIL
(CHARCODE (EOL ESCAPE LF TAB]
(MATCHING.STRINGS (for STR in STRINGS collect STR when (STRPOS SEARCH.PATTERN (U-CASE
STR]
(if MATCHING.STRINGS
then (WINDOWPROP WINDOW 'STRINGS.CACHE MATCHING.STRINGS)
(RESHAPE.SSWINDOW WINDOW)
else (PRINTOUT STREAM T "No matching strings"])
(SSCMD.GET
[LAMBDA (WINDOW) (* ; "Edited 30-Apr-2023 08:22 by PA")
(* ; "Edited 28-Apr-2023 11:00 by PA")
(* Prompt the user for a file name, extract the strings from the filem and
refresh the view.)
(LET* [(STREAM (WINDOWPROP WINDOW 'PROMPTAREA))
(FILENAME (PROGN (TERPRI STREAM)
(PROMPTFORWORD "File name:" NIL NIL STREAM)))
(STRINGS (WITH.INPUT.FILE (STR FILENAME)
(EXTRACT.STRINGS STR (WINDOWPROP WINDOW 'MIN.LEN]
(if STRINGS
then (WINDOWPROP WINDOW 'FILE FILENAME)
(WINDOWPROP WINDOW 'STRINGS STRINGS)
(WINDOWPROP WINDOW 'STRINGS.CACHE STRINGS)
(RESHAPE.SSWINDOW WINDOW)
else (PRINTOUT STREAM T "No strings in" %, FILENAME %, "or can't open file"])
(SSCMD.INFO
[LAMBDA (WINDOW) (* ; "Edited 29-Apr-2023 09:05 by PA")
(* Display in the prompt area some
statistics about the strings.)
(LET* [(STREAM (WINDOWPROP WINDOW 'PROMPTAREA))
(STRINGS (WINDOWPROP WINDOW 'STRINGS.CACHE))
(NUM.STRINGS (LENGTH STRINGS))
(MINLEN (WINDOWPROP WINDOW 'MIN.LENGTH))
(MAXLEN (APPLY (FUNCTION MAX)
(MAPCAR STRINGS (FUNCTION (LAMBDA (S)
(NCHARS S]
(AND STRINGS (PRINTOUT STREAM T NUM.STRINGS %, "strings of" %, MINLEN %, "to" %, MAXLEN %,
"characters"])
(SSCMD.MINLEN
[LAMBDA (WINDOW) (* ; "Edited 28-Apr-2023 06:06 by PA")
(* Prompt the user for a minimum length, extract the strings with the new length
from the current file, and refresh the view.)
(LET* [(STREAM (WINDOWPROP WINDOW 'PROMPTAREA))
(CURLEN (WINDOWPROP WINDOW 'MIN.LENGTH))
(NEWLEN (PROGN (TERPRI STREAM)
(MKATOM (PROMPTFORWORD "Min Len:" 4 NIL STREAM]
(if (AND (SMALLP NEWLEN)
(GREATERP NEWLEN 0))
then (AND (NOT (EQ NEWLEN CURLEN))
(WINDOWPROP WINDOW 'MIN.LENGTH NEWLEN)
(LET [(NEWSTRINGS (WITH.INPUT.FILE (STR (WINDOWPROP WINDOW 'FILE))
(EXTRACT.STRINGS STR NEWLEN]
(WINDOWPROP WINDOW 'STRINGS NEWSTRINGS)
(WINDOWPROP WINDOW 'STRINGS.CACHE NEWSTRINGS)
(SET.SSCWIN.TITLE WINDOW (WINDOWPROP WINDOW 'FILE)
NEWLEN)
(RESHAPE.SSWINDOW WINDOW)))
else (PRINTOUT STREAM T "Invalid length" %, NEWLEN])
(SSCMD.RESET
[LAMBDA (WINDOW) (* ; "Edited 22-Apr-2023 11:35 by PA")
(* Displays the strings last read from the file in the same order they are in the
file.)
(WINDOWPROP WINDOW 'STRINGS.CACHE (WINDOWPROP WINDOW 'STRINGS))
(RESHAPE.SSWINDOW WINDOW])
(SSCMD.SORT
[LAMBDA (WINDOW COMPAREFN) (* ; "Edited 21-Apr-2023 11:23 by PA")
(* ; "Edited 20-Apr-2023 10:27 by PA")
(* ; "Edited 20-Apr-2023 10:08 by PA")
(* Sort the list of strings stored in WINDOW using the COMPAREFN comparison
function and update the view.)
[WINDOWPROP WINDOW 'STRINGS.CACHE (SORT (COPY (WINDOWPROP WINDOW 'STRINGS))
(OR COMPAREFN (FUNCTION ALPHORDER]
(RESHAPE.SSWINDOW WINDOW])
(STRINGS
[LAMBDA (FILE MIN.LENGTH NEWWIN) (* ; "Edited 29-Apr-2023 10:39 by PA")
(* ; "Edited 18-Feb-2023 10:21 by PA")
(* ; "Edited 17-Feb-2023 09:05 by PA")
(* ; "Edited 12-Feb-2023 10:48 by PA")
(AND FILE (LET [(STRINGS (WITH.INPUT.FILE (STREAM FILE)
(EXTRACT.STRINGS STREAM MIN.LENGTH]
(if STRINGS
then (if NEWWIN
then (CREATE.SSWINDOW FILE STRINGS (OR MIN.LENGTH SSCOPE.MIN.LEN))
else (LIST.STRINGS STRINGS)
(OUTPUT))
else (PROMPTPRINT (CONCAT "No strings in " FILE " or can't open file."))
NIL])
(STRINGSCOPE
[LAMBDA (FILE MIN.LENGTH) (* ; "Edited 18-Feb-2023 10:17 by PA")
(* ; "Edited 17-Feb-2023 10:04 by PA")
(* ; "Edited 13-Feb-2023 06:15 by PA")
(* ; "Edited 29-Jan-2023 10:25 by PA")
(* ; "Edited 27-Jan-2023 10:52 by PA")
(* ; "Edited 24-Jan-2023 06:27 by PA")
(* ; "Edited 22-Jan-2023 10:46 by PA")
(* ; "Edited 19-Jan-2023 10:35 by PA")
(* Lists in a new window the printable strings in binary file FILE.
The strings must be at least MIN.LENGTH characters in length.
Returns the new window if the file is processed with no issues, NIL otherwise.)
(STRINGS FILE MIN.LENGTH T])
)
(RPAQ? SSCOPE.MIN.LEN 4)
(DEFCOMMAND (STRINGS :EVAL) (FILE &OPTIONAL (MIN.LENGTH SSCOPE.MIN.LEN)) (STRINGS FILE MIN.LENGTH)
(CL:VALUES))
(DEFMACRO WITH.INPUT.FILE ((STREAM FILE)
&BODY BODY &AUX (RESULT (GENSYM))
(VALUE (GENSYM))) (* ; "Edited 3-Apr-2023 05:13 by PA")
(* ; "Edited 16-Feb-2023 10:50 by PA")
(* ;; "Opens an input stream to FILE and evaluates the forms in BODY with the stream bound to STREAM. Returns the value of the last form in BODY, or NIL if FILE can not be opened.")
(* ; "Edited 16-Feb-2023 10:38 by PA")
`(PROG NIL
[SETQ ,RESULT (NLSETQ (OPENSTREAM ,FILE 'INPUT]
(if ,RESULT
then (SETQ ,STREAM (CAR ,RESULT))
(SETQ ,VALUE (PROGN ,@BODY))
(CLOSEF ,STREAM)
(RETURN ,VALUE)
else (RETURN NIL))))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (768 21292 (APPEND.CHAR 778 . 1035) (ATLEASTNCHRSP 1037 . 1660) (CREATE.SSWINDOW 1662 .
5908) (EXTRACT.STRINGS 5910 . 8430) (HANDLE.SSMENU 8432 . 10058) (LIST.STRINGS 10060 . 10379) (
PRINTABLEP 10381 . 11004) (REPAINT.SSWINDOW 11006 . 11722) (RESHAPE.SSWINDOW 11724 . 12908) (
SET.SSCWIN.TITLE 12910 . 13555) (SSCMD.EXIT 13557 . 13789) (SSCMD.FIND 13791 . 14954) (SSCMD.GET 14956
. 15965) (SSCMD.INFO 15967 . 16809) (SSCMD.MINLEN 16811 . 18082) (SSCMD.RESET 18084 . 18429) (
SSCMD.SORT 18431 . 19100) (STRINGS 19102 . 20120) (STRINGSCOPE 20122 . 21290)) (21448 22374 (
WITH.INPUT.FILE 21448 . 22374)))))
STOP