(FILECREATED "19-Oct-87 17:40:14" {ERINYES}<LISPUSERS>KOTO>TEDIT-PROCESS-KILLER.;2 15548
changes to: (FNS KILL-TEDIT-PROCESS MAKE-NEW-TEDIT-PROCESS TEDIT-KILLER-CLEANUP)
previous date: "24-Apr-87 15:40:50" {ERINYES}<LISPUSERS>KOTO>TEDIT-PROCESS-KILLER.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(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 WITHOUT-TEDIT-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)
(FNS TEDIT-KILLER-CLEANUP)
(* * NOTE: this advising smashes whatever advice was previously on
these functions!)
(ADVISE \TEDIT.QUIT TEDIT \TEDIT.BUTTONEVENTFN
TEDIT.DEACTIVATE.WINDOW (PROCESSP IN
TEDIT.DEACTIVATE.WINDOW)
(PROCESSP IN \TEDIT.ACTIVE.WINDOWP))))
(* * 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 (* rht: "31-Jan-87 16:28")
(* 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 (QUOTE (TEDIT-KILLER))
(QUOTE RESTARTABLE)
(QUOTE HARDRESET))))
(STOP-TEDIT-KILLER
(LAMBDA NIL (* rht: "30-Jan-87 18:26")
(* * Kill off old killers.)
(DECLARE (GLOBALVARS \PROCESSES))
(for P in \PROCESSES when (EQ (QUOTE TEDIT-KILLER)
(CAR (PROCESSPROP P (QUOTE FORM))))
do (DEL.PROCESS P))))
(KILL-PROCESS-OF-TEDIT-WINDOW
(LAMBDA (WINDOW) (* SCB: " 1-May-86 17:25")
(* 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)
(QUOTE PROCESS)))))
(WITHOUT-TEDIT-PROCESS
(LAMBDA (WINDOW) (* SCB: " 2-May-86 16:08")
(EQ (QUOTE TEDIT)
(WITHOUT-PROCESS WINDOW))))
)
(* * The rest of these are internal.)
(DEFINEQ
(TEDIT-KILLER
(LAMBDA NIL (* rht: "23-Apr-87 22:29")
(PROG (TO-KILL)
WAIT(DISMISS TEDIT-KILLER-WAIT-TIME)
(COND
((NULL TEDIT-PROCESSES)
(GO WAIT))
((ILESSP (IDIFFERENCE (CLOCK 0)
TEDIT-CREATION-TIME)
TEDIT-KILLER-WAIT-TIME)
(GO WAIT)))
(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)))))
(GO WAIT))))
(\TEDIT.BUTTONEVENTFN-BEFORE-ADVICE
(LAMBDA (W) (* rht: "30-Jan-87 23:32")
(LET ((TEXTOBJ (TEXTOBJ W))
(PROCESS (WINDOWPROP W (QUOTE PROCESS))))
(COND
((AND TEXTOBJ (NOT (PROCESSP PROCESS))
(MOUSESTATE (OR LEFT MIDDLE))
(NOT (TEXTPROP TEXTOBJ (QUOTE READONLY)))
(NOT (SHIFTDOWNP (QUOTE SHIFT)))
(NOT (SHIFTDOWNP (QUOTE CTRL)))
(NOT (SHIFTDOWNP (QUOTE META)))
(NOT (KEYDOWNP (QUOTE MOVE)))
(NOT (KEYDOWNP (QUOTE 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 (QUOTE WITHOUT-PROCESS)
PROCESS-TYPE)))
(UNMARK-AS-WITHOUT-PROCESS
(LAMBDA (WINDOW) (* SCB: " 2-May-86 15:44")
(WINDOWPROP WINDOW (QUOTE WITHOUT-PROCESS)
NIL)))
(WITHOUT-PROCESS
(LAMBDA (WINDOW) (* SCB: " 2-May-86 15:43")
(WINDOWPROP WINDOW (QUOTE WITHOUT-PROCESS))))
(WITHOUT-TEDIT-PROCESS
(LAMBDA (WINDOW) (* SCB: " 2-May-86 16:08")
(EQ (QUOTE TEDIT)
(WITHOUT-PROCESS WINDOW))))
)
(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) (* rht: "23-Apr-87 22:28")
(* * Isn't there a more trustworthy way to test if a process is a TEdit process? Does this hack cover all known
TEdit processes?)
(* * rht&rg 4/23/87: Now makes sure it's not some non-standard tedit, especially not lafite.)
(AND (PROCESSP PROCESS)
(EQ (QUOTE \TEDIT.PROCENTRYFN)
(PROCESSPROP PROCESS (QUOTE TTYENTRYFN)))
(EQ (CAR (PROCESSPROP PROCESS (QUOTE FORM)))
(QUOTE \TEDIT2)))))
(KILL-PROCESS-OF-TEDIT-WINDOW1
(LAMBDA (WINDOW) (* SCB: " 1-May-86 17:37")
(LET ((PROCESS (WINDOWPROP WINDOW (QUOTE 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) (* rht: "19-Oct-87 17:37")
(* 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 (QUOTE WINDOW)))
(TEXTOBJ (WINDOWPROP WINDOW (QUOTE TEXTOBJ))))
(COND
((AND (WINDOWP WINDOW)
TEXTOBJ
(NOT (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ)))
(WINDOWPROP WINDOW (QUOTE TXTHISTORY)
(fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ))
(WINDOWPROP WINDOW (QUOTE TXTFILE)
(fetch (TEXTOBJ TXTFILE) of TEXTOBJ))
(WINDOWPROP WINDOW (QUOTE SELWINDOW)
(fetch (TEXTOBJ SELWINDOW) of TEXTOBJ))
(WINDOWPROP WINDOW (QUOTE SAVEDPROCFORM)
(PROCESSPROP PROCESS (QUOTE FORM)))
(WINDOWPROP WINDOW (QUOTE SAVEDRESTARTFORM)
(PROCESSPROP PROCESS (QUOTE RESTARTFORM)))
(WINDOWPROP WINDOW (QUOTE SAVEDRESTARTABLE)
(PROCESSPROP PROCESS (QUOTE RESTARTABLE)))
(WINDOWPROP WINDOW (QUOTE SAVEDPROCNAME)
(PROCESSPROP PROCESS (QUOTE 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 (QUOTE TEDIT))
(DEL.PROCESS PROCESS)))))))
(MAKE-NEW-TEDIT-PROCESS
(LAMBDA (WINDOW) (* rht: "19-Oct-87 17:36")
(* 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))
PROCESS SAVEDPROCFORM)
(replace (TEXTOBJ TXTHISTORY) of TEXTOBJ with (WINDOWPROP WINDOW (QUOTE
TXTHISTORY)))
(replace (TEXTOBJ SELWINDOW) of TEXTOBJ with (WINDOWPROP WINDOW (QUOTE SELWINDOW)
))
(replace (TEXTOBJ TXTFILE) of TEXTOBJ with (OPENSTREAM (FULLNAME
(WINDOWPROP
WINDOW
(QUOTE TXTFILE)))
(QUOTE INPUT)
(QUOTE OLD)))
(* Atomic action to restore the process.)
(if (SETQ SAVEDPROCFORM (WINDOWPROP WINDOW (QUOTE SAVEDPROCFORM)))
then (UNINTERRUPTABLY
(SETQ PROCESS (ADD.PROCESS SAVEDPROCFORM (QUOTE NAME)
(LET* ((PROCNAME (WINDOWPROP WINDOW
(QUOTE
SAVEDPROCNAME)))
(POS (STRPOS "#" PROCNAME)))
(OR (SUBSTRING PROCNAME 1
(AND POS
(SUB1 POS)))
PROCNAME))
(QUOTE RESTARTABLE)
(WINDOWPROP WINDOW (QUOTE SAVEDRESTARTABLE)
)
(QUOTE RESTARTFORM)
(WINDOWPROP WINDOW (QUOTE SAVEDRESTARTFORM)
)))
(TEDIT-KILLER-CLEANUP WINDOW)
(PROCESSPROP PROCESS (QUOTE WINDOW)
WINDOW)
(WINDOWPROP WINDOW (QUOTE 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))))
)
(DEFINEQ
(TEDIT-KILLER-CLEANUP
(LAMBDA (WINDOW) (* rht: "19-Oct-87 17:36")
(* * 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 (QUOTE TXTHISTORY)
NIL)
(WINDOWPROP WINDOW (QUOTE TXTFILE)
NIL)
(WINDOWPROP WINDOW (QUOTE SELWINDOW)
NIL)
(WINDOWPROP WINDOW (QUOTE SAVEDPROCFORM)
NIL)
(WINDOWPROP WINDOW (QUOTE SAVEDPROCNAME)
NIL)
(WINDOWPROP WINDOW (QUOTE SAVEDRESTARTABLE)
NIL)
(WINDOWPROP WINDOW (QUOTE SAVEDRESTARTFORM)
NIL)
(UNMARK-AS-WITHOUT-PROCESS WINDOW)))
)
(* * NOTE: this advising smashes whatever advice was previously on these functions!)
(PUTPROPS \TEDIT.QUIT READVICE (NIL (AFTER NIL (if (WITHOUT-TEDIT-PROCESS W)
then
(TEDIT-KILLER-CLEANUP W)))))
(PUTPROPS TEDIT READVICE (NIL (BEFORE NIL (SETQ TEDIT-CREATION-TIME (CLOCK 0)))
(AFTER NIL (SETQ TEDIT-PROCESSES (CONS !VALUE TEDIT-PROCESSES)))))
(PUTPROPS \TEDIT.BUTTONEVENTFN READVICE (NIL (BEFORE NIL (\TEDIT.BUTTONEVENTFN-BEFORE-ADVICE W))))
(PUTPROPS TEDIT.DEACTIVATE.WINDOW READVICE (NIL (AFTER NIL (PROG1 !VALUE (if (WITHOUT-TEDIT-PROCESS
W)
then
(TEDIT-KILLER-CLEANUP
W))))))
(PUTPROPS PROCESSP-IN-TEDIT.DEACTIVATE.WINDOW READVICE ((TEDIT.DEACTIVATE.WINDOW . PROCESSP)
(AFTER NIL (RETURN (OR !VALUE (WITHOUT-TEDIT-PROCESS (STKARG (QUOTE W)
(QUOTE
TEDIT.DEACTIVATE.WINDOW)))))
)))
(PUTPROPS PROCESSP-IN-\TEDIT.ACTIVE.WINDOWP READVICE ((\TEDIT.ACTIVE.WINDOWP . PROCESSP)
(AFTER NIL (RETURN (OR !VALUE (WITHOUT-TEDIT-PROCESS (STKARG (QUOTE W)
(QUOTE \TEDIT.ACTIVE.WINDOWP))
))))))
(READVISE \TEDIT.QUIT TEDIT \TEDIT.BUTTONEVENTFN TEDIT.DEACTIVATE.WINDOW
PROCESSP-IN-TEDIT.DEACTIVATE.WINDOW PROCESSP-IN-\TEDIT.ACTIVE.WINDOWP)
(PUTPROPS TEDIT-PROCESS-KILLER COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2651 4575 (START-TEDIT-KILLER 2661 . 3184) (STOP-TEDIT-KILLER 3186 . 3558) (
KILL-PROCESS-OF-TEDIT-WINDOW 3560 . 3918) (RESTART-PROCESS-OF-TEDIT-WINDOW 3920 . 4388) (
WITHOUT-TEDIT-PROCESS 4390 . 4573)) (4620 6787 (TEDIT-KILLER 4630 . 5649) (
\TEDIT.BUTTONEVENTFN-BEFORE-ADVICE 5651 . 6785)) (6788 7542 (MARK-AS-WITHOUT-PROCESS 6798 . 6993) (
UNMARK-AS-WITHOUT-PROCESS 6995 . 7183) (WITHOUT-PROCESS 7185 . 7355) (WITHOUT-TEDIT-PROCESS 7357 .
7540)) (7543 13382 (ALL-TEDIT-PROCESSES 7553 . 7860) (TEDIT-PROCESS-P 7862 . 8464) (
KILL-PROCESS-OF-TEDIT-WINDOW1 8466 . 8846) (KILL-TEDIT-PROCESS 8848 . 10619) (MAKE-NEW-TEDIT-PROCESS
10621 . 12914) (RESTART-PROCESS-OF-TEDIT-WINDOW1 12916 . 13380)) (13383 14161 (TEDIT-KILLER-CLEANUP
13393 . 14159)))))
STOP