-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathtedit-process-killer
376 lines (265 loc) · 16.8 KB
/
tedit-process-killer
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
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Mar-2024 23:52:57" {WMEDLEY}<lispusers>tedit-process-killer.;4 16479
:EDIT-BY rmk
:CHANGES-TO (FNS KILL-TEDIT-PROCESS MAKE-NEW-TEDIT-PROCESS TEDIT-KILLER-CLEANUP)
:PREVIOUS-DATE "20-Oct-2023 00:11:10" {WMEDLEY}<lispusers>tedit-process-killer.;2)
(PRETTYCOMPRINT TEDIT-PROCESS-KILLERCOMS)
(RPAQQ TEDIT-PROCESS-KILLERCOMS
[
(* ;; "This package provides various ways to kill tedit processes. Using START-TEDIT-KILLER, one can keep the total number of tedit processes under the threshold TEDIT-PROCESS-LIMIT. One can also call KILL-PROCESS-OF-TEDIT-WINDOW to kill the Tedit processes for a given window and its attached windows.")
(GLOBALVARS TEDIT-PROCESS-LIMIT TEDIT-KILLER-WAIT-TIME TEDIT-PROCESSES TEDIT-CREATION-TIME)
(* ;;; "These two vars are advertised.")
(INITVARS (TEDIT-PROCESS-LIMIT 5)
(TEDIT-KILLER-WAIT-TIME 10000))
(VARS (TEDIT-PROCESSES NIL)
(TEDIT-CREATION-TIME NIL))
(* ;;; "Here are the advertised functions.")
(FNS START-TEDIT-KILLER STOP-TEDIT-KILLER KILL-PROCESS-OF-TEDIT-WINDOW
RESTART-PROCESS-OF-TEDIT-WINDOW WITHOUT-TEDIT-PROCESS)
(* ;;; "The rest of these are internal.")
(FNS TEDIT-KILLER \TEDIT.BUTTONEVENTFN-BEFORE-ADVICE)
(FNS MARK-AS-WITHOUT-PROCESS UNMARK-AS-WITHOUT-PROCESS WITHOUT-PROCESS)
(FNS ALL-TEDIT-PROCESSES TEDIT-PROCESS-P KILL-PROCESS-OF-TEDIT-WINDOW1 KILL-TEDIT-PROCESS
MAKE-NEW-TEDIT-PROCESS RESTART-PROCESS-OF-TEDIT-WINDOW1 TEDIT-KILLER-CLEANUP)
(* ;;; "NOTE: this advising smashes whatever advice was previously on these functions!")
(DECLARE%: DONTEVAL@LOAD DOCOPY (ADVISE \TEDIT.QUIT TEDIT \TEDIT.BUTTONEVENTFN
(* ;; "PROCESS.APPLY advice is mainly for NoteCards - fixes a misuse of this function that makes it impossible to use monitors inside a TEdit menu fn.")
(PROCESS.APPLY :IN \TEDIT.BUTTONEVENTFN)
(PROCESSP :IN TEDIT.DEACTIVATE.WINDOW)
(PROCESSP :IN \TEDIT.ACTIVE.WINDOWP))
(P (START-TEDIT-KILLER])
(* ;;
"This package provides various ways to kill tedit processes. Using START-TEDIT-KILLER, one can keep the total number of tedit processes under the threshold TEDIT-PROCESS-LIMIT. One can also call KILL-PROCESS-OF-TEDIT-WINDOW to kill the Tedit processes for a given window and its attached windows."
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT-PROCESS-LIMIT TEDIT-KILLER-WAIT-TIME TEDIT-PROCESSES TEDIT-CREATION-TIME)
)
(* ;;; "These two vars are advertised.")
(RPAQ? TEDIT-PROCESS-LIMIT 5)
(RPAQ? TEDIT-KILLER-WAIT-TIME 10000)
(RPAQQ TEDIT-PROCESSES NIL)
(RPAQQ TEDIT-CREATION-TIME NIL)
(* ;;; "Here are the advertised functions.")
(DEFINEQ
(START-TEDIT-KILLER
[LAMBDA NIL (* ; "Edited 11-Dec-87 19:43 by Randy.Gobbel")
(DECLARE (GLOBALVARS TEDIT-CREATION-TIME TEDIT-PROCESSES))
(* ;; "Kill off old killers.")
(STOP-TEDIT-KILLER)
(* ;; "Reset stuff and start er up.")
(SETQ TEDIT-CREATION-TIME (CLOCK 0))
(SETQ TEDIT-PROCESSES (ALL-TEDIT-PROCESSES))
(ADD.PROCESS '(TEDIT-KILLER) 'RESTARTABLE 'HARDRESET])
(STOP-TEDIT-KILLER
[LAMBDA NIL (* ; "Edited 2-Feb-88 14:08 by Randy.Gobbel")
(* ;; "Kill off old killers.")
(DECLARE (GLOBALVARS \PROCESSES))
(for P in \PROCESSES when [EQ 'TEDIT-KILLER (CAR (PROCESSPROP P 'FORM]
do (DEL.PROCESS P)
(until (NOT (PROCESSP P)) do (BLOCK])
(KILL-PROCESS-OF-TEDIT-WINDOW
[LAMBDA (WINDOW) (* ; "Edited 11-Dec-87 19:17 by Randy.Gobbel")
(* ;; "Kill the process of this window, and anybody who is attached to me (recursively).")
(KILL-PROCESS-OF-TEDIT-WINDOW1 (MAINWINDOW WINDOW])
(RESTART-PROCESS-OF-TEDIT-WINDOW
[LAMBDA (WINDOW) (* SCB%: " 2-May-86 10:41")
(* Move down the attached windows tree from the mainwindow, firing up a new
process for each TEdit.)
(RESTART-PROCESS-OF-TEDIT-WINDOW1 (MAINWINDOW WINDOW))
(TTY.PROCESS (WINDOWPROP (MAINWINDOW WINDOW)
'PROCESS])
(WITHOUT-TEDIT-PROCESS
[LAMBDA (WINDOW) (* SCB%: " 2-May-86 16:08")
(EQ 'TEDIT (WITHOUT-PROCESS WINDOW])
)
(* ;;; "The rest of these are internal.")
(DEFINEQ
(TEDIT-KILLER
[LAMBDA NIL (* ; "Edited 11-Dec-87 20:53 by Randy.Gobbel")
(DECLARE (GLOBALVARS TEDIT-PROCESSES TEDIT-KILLER-WAIT-TIME TEDIT-CREATION-TIME
TEDIT-PROCESS-LIMIT))
(while T bind (TO-KILL _ 0) do (DISMISS TEDIT-KILLER-WAIT-TIME)
(if (AND TEDIT-PROCESSES (ILESSP TEDIT-KILLER-WAIT-TIME
(IDIFFERENCE (CLOCK 0)
TEDIT-CREATION-TIME)))
then (SETQ TEDIT-PROCESSES (for P in TEDIT-PROCESSES
when (TEDIT-PROCESS-P P)
collect P))
(SETQ TO-KILL (IDIFFERENCE (LENGTH TEDIT-PROCESSES)
TEDIT-PROCESS-LIMIT))
(* ;; "Kill processes, starting from the least recently used.")
(until (ILEQ TO-KILL 0) for P in (REVERSE TEDIT-PROCESSES
)
do (COND
((AND (NEQ (TTY.PROCESS)
P)
(PROCESSP P))
(KILL-TEDIT-PROCESS P)
(SETQ TO-KILL (SUB1 TO-KILL])
(\TEDIT.BUTTONEVENTFN-BEFORE-ADVICE
[LAMBDA (W) (* ; "Edited 11-Dec-87 19:45 by Randy.Gobbel")
(DECLARE (GLOBALVARS TEDIT-PROCESSES))
(LET [(TEXTOBJ (TEXTOBJ W))
(PROCESS (WINDOWPROP W 'PROCESS]
(COND
([AND TEXTOBJ (NOT (PROCESSP PROCESS))
(MOUSESTATE (OR LEFT MIDDLE))
(NOT (TEXTPROP TEXTOBJ 'READONLY))
(NOT (SHIFTDOWNP 'SHIFT))
(NOT (SHIFTDOWNP 'CTRL))
(NOT (SHIFTDOWNP 'META))
(NOT (KEYDOWNP 'MOVE))
(NOT (KEYDOWNP 'COPY]
(SETQ PROCESS (MAKE-NEW-TEDIT-PROCESS W))
(SETQ TEDIT-PROCESSES (CONS PROCESS TEDIT-PROCESSES))
(TTY.PROCESS PROCESS))
([AND (PROCESSP PROCESS)
(NOT (EQ PROCESS (CAR TEDIT-PROCESSES] (* ;
"We're using the process, so move it to the front of the list.")
(SETQ TEDIT-PROCESSES (CONS PROCESS (DREMOVE PROCESS TEDIT-PROCESSES])
)
(DEFINEQ
(MARK-AS-WITHOUT-PROCESS
[LAMBDA (WINDOW PROCESS-TYPE) (* SCB%: " 2-May-86 15:44")
(WINDOWPROP WINDOW 'WITHOUT-PROCESS PROCESS-TYPE])
(UNMARK-AS-WITHOUT-PROCESS
[LAMBDA (WINDOW) (* SCB%: " 2-May-86 15:44")
(WINDOWPROP WINDOW 'WITHOUT-PROCESS NIL])
(WITHOUT-PROCESS
[LAMBDA (WINDOW) (* SCB%: " 2-May-86 15:43")
(WINDOWPROP WINDOW 'WITHOUT-PROCESS])
)
(DEFINEQ
(ALL-TEDIT-PROCESSES
[LAMBDA NIL (* rht%: "30-Jan-87 18:54")
(* * Gather all the extant tedit processes.)
(DECLARE (GLOBALVARS \PROCESSES))
(for P in \PROCESSES when (TEDIT-PROCESS-P P) collect P])
(TEDIT-PROCESS-P
[LAMBDA (PROCESS) (* ; "Edited 20-Oct-2023 00:11 by rmk")
(* ;
"Edited 2-Feb-88 14:15 by Randy.Gobbel")
(* ;; "rg 2/2/88: Now looks at process name instead of checking TTYENTRYFN = \TEDIT.PROCENTRYFN, which failed for TEdits that had never been given the TTY (look at \TEDIT.COMMAND.LOOP code). This will miss processes that have been given another name, but works in practice for all cases that I know of.")
(AND (PROCESSP PROCESS)
(EQ (STRPOS "TEdit" (PROCESSPROP PROCESS 'NAME))
1)
(EQ (CAR (PROCESSPROP PROCESS 'FORM))
'\TEDIT1])
(KILL-PROCESS-OF-TEDIT-WINDOW1
[LAMBDA (WINDOW) (* SCB%: " 1-May-86 17:37")
(LET [(PROCESS (WINDOWPROP WINDOW 'PROCESS]
(AND (TEDIT-PROCESS-P PROCESS)
(KILL-TEDIT-PROCESS PROCESS))
(for W in (ATTACHEDWINDOWS WINDOW) do (KILL-PROCESS-OF-TEDIT-WINDOW1 W])
(KILL-TEDIT-PROCESS
[LAMBDA (PROCESS) (* ; "Edited 27-Mar-2024 23:52 by rmk")
(* ;
"Edited 11-Dec-87 20:06 by Randy.Gobbel")
(* ;; "Save the state that TEdit bashes, and then kill the process. Only TEdits have TEXTOBJs, so this won't go killing other kinds of processes. Won't kill if the TEdit is in the middle of an operation.")
(* ;; "rrp 10/19/87: Now also saves TXTFILE property.")
(LET* ((WINDOW (PROCESSPROP PROCESS 'WINDOW))
(TEXTOBJ (TEXTOBJ WINDOW T)))
(CL:WHEN (AND (WINDOWP WINDOW)
TEXTOBJ
(NOT (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ)))
(WINDOWPROP WINDOW 'TXTHISTORY (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ))
(WINDOWPROP WINDOW 'TXTFILE (fetch (TEXTOBJ TXTFILE) of TEXTOBJ))
(WINDOWPROP WINDOW 'SELPANE (fetch (TEXTOBJ SELPANE) of TEXTOBJ))
(WINDOWPROP WINDOW 'SAVEDPROCFORM (PROCESSPROP PROCESS 'FORM))
(WINDOWPROP WINDOW 'SAVEDRESTARTFORM (PROCESSPROP PROCESS 'RESTARTFORM))
(WINDOWPROP WINDOW 'SAVEDRESTARTABLE (PROCESSPROP PROCESS 'RESTARTABLE))
(WINDOWPROP WINDOW 'SAVEDPROCNAME (PROCESSPROP PROCESS 'NAME))
(* ;;
"Mark the window so we know we can restart the process. Atomic action to turn off the process.")
(UNINTERRUPTABLY
(MARK-AS-WITHOUT-PROCESS WINDOW 'TEDIT)
(DEL.PROCESS PROCESS)))])
(MAKE-NEW-TEDIT-PROCESS
[LAMBDA (WINDOW) (* ; "Edited 27-Mar-2024 23:52 by rmk")
(* ;
"Edited 9-Mar-89 14:58 by Randy.Gobbel")
(* ;; "This assumes that WINDOW really is the window of a restartable TEdit.")
(* ;; "Build a new TEdit process recovering saved PROCESSPROPs from the window.")
(* ;;
"rht 2/9/87: Added a check that SAVEDPROCFORM of WINDOW is non-nil in case WINDOW just got smashed.")
(* ;;
"rht&sb 4/24/87: Now smashes windowprops after reading them by calling TEDIT-KILLER-CLEANUP.")
(* ;; "rrp 10/19/87: Now restores TXTFILE property as well.")
(LET ((TEXTOBJ (TEXTOBJ WINDOW))
(TXTFILE (WINDOWPROP WINDOW 'TXTFILE))
PROCESS SAVEDPROCFORM)
(replace (TEXTOBJ TXTHISTORY) of TEXTOBJ with (WINDOWPROP WINDOW 'TXTHISTORY))
(replace (TEXTOBJ SELPANE) of TEXTOBJ with (WINDOWPROP WINDOW 'SELPANE))
[if (AND TXTFILE (NOT (STREQUAL TXTFILE "")))
then (replace (TEXTOBJ TXTFILE) of TEXTOBJ with (OPENSTREAM (FULLNAME TXTFILE)
'INPUT
'OLD]
(* ;; "Atomic action to restore the process.")
(if (SETQ SAVEDPROCFORM (WINDOWPROP WINDOW 'SAVEDPROCFORM))
then (UNINTERRUPTABLY
[SETQ PROCESS (ADD.PROCESS SAVEDPROCFORM 'NAME
(LET* ((PROCNAME (WINDOWPROP WINDOW 'SAVEDPROCNAME))
(POS (STRPOS "#" PROCNAME)))
(OR (SUBSTRING PROCNAME 1 (AND POS (SUB1 POS)))
PROCNAME))
'RESTARTABLE
(WINDOWPROP WINDOW 'SAVEDRESTARTABLE)
'RESTARTFORM
(WINDOWPROP WINDOW 'SAVEDRESTARTFORM]
(TEDIT-KILLER-CLEANUP WINDOW)
(PROCESSPROP PROCESS 'WINDOW WINDOW)
(WINDOWPROP WINDOW 'PROCESS PROCESS)))
PROCESS])
(RESTART-PROCESS-OF-TEDIT-WINDOW1
[LAMBDA (WINDOW) (* SCB%: " 2-May-86 16:09")
(* Only restart this guy if he used to have a TEdit process.)
(AND (WITHOUT-TEDIT-PROCESS WINDOW)
(MAKE-NEW-TEDIT-PROCESS WINDOW))
(for W in (ATTACHEDWINDOWS WINDOW) do (RESTART-PROCESS-OF-TEDIT-WINDOW1 W])
(TEDIT-KILLER-CLEANUP
[LAMBDA (WINDOW) (* ; "Edited 27-Mar-2024 23:52 by rmk")
(* ;
"Edited 11-Dec-87 20:13 by Randy.Gobbel")
(* ;; "This unmarks the window and also throws away any cruft we left on windowprops.")
(* ;; "rrp 10/19/87: Now trashes TXTFILE property as well.")
(WINDOWPROP WINDOW 'TXTHISTORY NIL)
(WINDOWPROP WINDOW 'TXTFILE NIL)
(WINDOWPROP WINDOW 'SELPANE NIL)
(WINDOWPROP WINDOW 'SAVEDPROCFORM NIL)
(WINDOWPROP WINDOW 'SAVEDPROCNAME NIL)
(WINDOWPROP WINDOW 'SAVEDRESTARTABLE NIL)
(WINDOWPROP WINDOW 'SAVEDRESTARTFORM NIL)
(UNMARK-AS-WITHOUT-PROCESS WINDOW])
)
(* ;;; "NOTE: this advising smashes whatever advice was previously on these functions!")
(DECLARE%: DONTEVAL@LOAD DOCOPY
[XCL:REINSTALL-ADVICE '\TEDIT.QUIT :AFTER '((:LAST (UNMARK-AS-WITHOUT-PROCESS W]
[XCL:REINSTALL-ADVICE 'TEDIT :BEFORE '[(:LAST (SETQ TEDIT-CREATION-TIME (CLOCK 0]
:AFTER
'((:LAST (SETQ TEDIT-PROCESSES (CONS !VALUE TEDIT-PROCESSES]
[XCL:REINSTALL-ADVICE '\TEDIT.BUTTONEVENTFN :BEFORE '((:LAST (\TEDIT.BUTTONEVENTFN-BEFORE-ADVICE
W]
[XCL:REINSTALL-ADVICE '(PROCESS.APPLY :IN \TEDIT.BUTTONEVENTFN)
:AROUND
'((:LAST (ADD.PROCESS (LIST USERFN (KWOTE W]
[XCL:REINSTALL-ADVICE '(PROCESSP :IN TEDIT.DEACTIVATE.WINDOW)
:AFTER
'((:LAST (RETURN (OR !VALUE (WITHOUT-TEDIT-PROCESS (STKARG 'W 'TEDIT.DEACTIVATE.WINDOW]
[XCL:REINSTALL-ADVICE '(PROCESSP :IN \TEDIT.ACTIVE.WINDOWP)
:AFTER
'((:LAST (RETURN (OR !VALUE (WITHOUT-TEDIT-PROCESS (STKARG 'W '\TEDIT.ACTIVE.WINDOWP]
(READVISE \TEDIT.QUIT TEDIT \TEDIT.BUTTONEVENTFN (PROCESS.APPLY :IN \TEDIT.BUTTONEVENTFN)
(PROCESSP :IN TEDIT.DEACTIVATE.WINDOW)
(PROCESSP :IN \TEDIT.ACTIVE.WINDOWP))
(START-TEDIT-KILLER)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3073 4847 (START-TEDIT-KILLER 3083 . 3573) (STOP-TEDIT-KILLER 3575 . 3966) (
KILL-PROCESS-OF-TEDIT-WINDOW 3968 . 4275) (RESTART-PROCESS-OF-TEDIT-WINDOW 4277 . 4683) (
WITHOUT-TEDIT-PROCESS 4685 . 4845)) (4898 7823 (TEDIT-KILLER 4908 . 6724) (
\TEDIT.BUTTONEVENTFN-BEFORE-ADVICE 6726 . 7821)) (7824 8328 (MARK-AS-WITHOUT-PROCESS 7834 . 8006) (
UNMARK-AS-WITHOUT-PROCESS 8008 . 8173) (WITHOUT-PROCESS 8175 . 8326)) (8329 15217 (ALL-TEDIT-PROCESSES
8339 . 8643) (TEDIT-PROCESS-P 8645 . 9441) (KILL-PROCESS-OF-TEDIT-WINDOW1 9443 . 9804) (
KILL-TEDIT-PROCESS 9806 . 11513) (MAKE-NEW-TEDIT-PROCESS 11515 . 13999) (
RESTART-PROCESS-OF-TEDIT-WINDOW1 14001 . 14397) (TEDIT-KILLER-CLEANUP 14399 . 15215)))))
STOP