(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
