Lispusers package KINETIC: add CLOSEFN to Kinetic window so that kinetic activity stops and window closes when CLOSEW is called ..

lispusers/KINETIC

@@ -1,15 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Sep-2022 08:19:41" {DSK}<home>larry>medley>lispusers>KINETIC.;2
 1928   
+
(FILECREATED " 1-Nov-2025 20:26:43" {DSK}<home>frank>il>medley>lispusers>KINETIC.;5
 2264   
 
-      :CHANGES-TO (FNS KINETIC)
+      :EDIT-BY "FGH"
 
-      :PREVIOUS-DATE " 2-Apr-86 00:14:01" {DSK}<home>larry>medley>lispusers>KINETIC.;1)
+      :CHANGES-TO (FNS KINETIC)
 
+      :PREVIOUS-DATE "23-Sep-2022 08:19:41" {DSK}<home>frank>il>medley>lispusers>KINETIC.;1)
 
-(* ; "
-Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
-")
 
 (PRETTYCOMPRINT KINETICCOMS)
 
@@ -20,34 +18,38 @@ Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
 (DEFINEQ
 
 (KINETIC

-  [LAMBDA (WINDOW)
                                           (* ; "Edited 22-Sep-2022 22:07 by lmm")

+  [LAMBDA (WINDOW)
                                           (* ; "Edited  1-Nov-2025 20:23 by FGH")


+                                                             (* ; "Edited 22-Sep-2022 22:07 by lmm")

                                                              (* lmm " 3-Dec-85 14:16")

-                                                             (* test example (KINETICDEMO)
-
                                                             (SETQ CHECKSHADE (EDITSHADE CHECKSHADE)))

     [OR (WINDOWP WINDOW)
         (SETQ WINDOW (OR KINETICWINDOW (SETQ KINETICWINDOW (CREATEW NIL "Kinetic Window"]
+    [OR (WINDOWPROP WINDOW 'CLOSEFN)
+        (WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
+                                                (WINDOWPROP W 'CLOSE T]
+    [WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
+                                            (WINDOWPROP W 'CLOSE T]
     (PROG ((WD (WINDOWPROP WINDOW 'WIDTH))
            (HT (WINDOWPROP WINDOW 'HEIGHT))
            X Y)
-          (do
 (SETQ X (RAND 0 WD))
-              (SETQ Y (RAND 0 HT))
-              (BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X))
-                     (RAND 0 (IDIFFERENCE HT Y))
-                     X Y 'TEXTURE (SELECTQ (RAND 0 5)
-                                      (0 'PAINT)
-                                      'INVERT)
-                     (SELECTQ (AND CHECKSHADE (RAND 0 12))
-                         (0 CHECKSHADE)
-                         BLACKSHADE))
-              (BLOCK 100])
+          (while
 (NEQ (WINDOWPROP WINDOW 'CLOSE)
+                      T) do
 (SETQ X (RAND 0 WD))
+                            (SETQ Y (RAND 0 HT))
+                            (BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X))
+                                   (RAND 0 (IDIFFERENCE HT Y))
+                                   X Y 'TEXTURE (SELECTQ (RAND 0 5)
+                                                    (0 'PAINT)
+                                                    'INVERT)
+                                   (SELECTQ (AND CHECKSHADE (RAND 0 12))
+                                       (0 CHECKSHADE)
+                                       BLACKSHADE))
+                            (BLOCK 100) finally
 (WINDOWPROP WINDOW 'CLOSE NIL])
 )
 
 (RPAQQ CHECKSHADE
 63903)
 
 (RPAQQ KINETICWINDOW
 NIL)
 
 (ADDTOVAR IDLE.FUNCTIONS
 (Kinetic 'KINETIC))
-(PUTPROPS KINETIC COPYRIGHT ("Xerox Corporation" 1982 1985 1986 2022))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (573 1723 (KINETIC 583 . 1721)))))
+  (FILEMAP (NIL (534 2130 (KINETIC 544 . 2128)))))
 STOP