IMINDEX: The displayfn of index image objects sets AFTERHARDCOPYFN to…

… close the index file (#1649) * IMINDEX: The displayfn of index image objects sets AFTERHARDCOPYFN to close the index file Removes the need for advising the Tedit hardcopy function. This won't have an effect until a separate PR (after rmk7 is merged) that updates the hardcopy function. * Index image object explicitly uses OLD-INTERLISP-FILE for printing and reading (cf #1652)
Interlisp · Apr 30, 2024 · 931807e · 931807e
1 parent d79d5b3
commit 931807e
Show file tree

Hide file tree

Showing 2 changed files with 34 additions and 28 deletions.
diff --git a/doctools/IMINDEX b/doctools/IMINDEX
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED " 6-Mar-2024 21:19:25" {WMEDLEY}<doctools>IMINDEX.;2 36416  
+(FILECREATED " 7-Apr-2024 09:25:49" {WMEDLEY}<doctools>IMINDEX.;6 37064  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS IMINDEXCOMS)
+      :CHANGES-TO (FNS IM.INDEX.PUTFN IM.INDEX.GETFN)
 
-      :PREVIOUS-DATE "12-Feb-92 12:28:48" {WMEDLEY}<doctools>IMINDEX.;1)
+      :PREVIOUS-DATE " 4-Apr-2024 23:17:47" {WMEDLEY}<doctools>IMINDEX.;5)
 
 
 (PRETTYCOMPRINT IMINDEXCOMS)
@@ -40,10 +40,10 @@
 (DEFINEQ
 
 (IM.INDEX.CLOSEF
-  [LAMBDA (TEXTSTREAM)                                       (* mjs " 4-Aug-86 17:02")
-
-          (* * Closes the IMINDEX pointer file associated with the textstream TEXTSTREAM.
-          This is called by means of advice to TEDIT.HARDCOPY.)
+  [LAMBDA (TEXTSTREAM)                                       (* ; "Edited  4-Apr-2024 22:51 by rmk")
+                                                             (* mjs " 4-Aug-86 17:02")
+
+(* ;;; "Closes the IMINDEX pointer file associated with the textstream TEXTSTREAM.  This is called by means of advice to TEDIT.HARDCOPY.")
 
     (PROG [(PTRFILE (TEXTPROP TEXTSTREAM 'IM.INDEX.PTRFILE]
           (if (AND PTRFILE (OPENP PTRFILE))
@@ -87,7 +87,8 @@
                                 '|...|])
 
 (IM.INDEX.DISPLAYFN
-  [LAMBDA (OBJ STREAM STREAMTYPE HOSTSTREAM)             (* ; "Edited  8-Dec-91 15:12 by jds")
+  [LAMBDA (OBJ STREAM STREAMTYPE HOSTSTREAM)                 (* ; "Edited  4-Apr-2024 23:17 by rmk")
+                                                             (* ; "Edited  8-Dec-91 15:12 by jds")
 
     (* ;; "only print index if you are going to display")
 
@@ -130,22 +131,24 @@
 
         (PROG ((*READTABLE* *TEDIT-FILE-READTABLE*)
                PTRFILE PTRFILENAME TXTFILE)
+
+         (* ;; "RMK:  THIS SHOULD REALLY SAVE THE OPENSTREAM, NOT DEPEND ON ATOMIC FILENAME")
+
               (SETQ PTRFILE (TEXTPROP HOSTSTREAM 'IM.INDEX.PTRFILE))
-              (COND
-                 ((NOT (AND PTRFILE (OPENP PTRFILE)))
+              (CL:UNLESS (AND PTRFILE (OPENP PTRFILE))
                   (SETQ PTRFILENAME (TEXTPROP HOSTSTREAM 'IM.INDEX.PTRFILENAME))
-                  [COND
-                     ((NULL PTRFILENAME)
+                  (CL:UNLESS PTRFILENAME
                       (SETQ TXTFILE (fetch (TEXTOBJ TXTFILE) of (TEXTOBJ HOSTSTREAM)))
-                      (SETQ PTRFILENAME (PACKFILENAME 'EXTENSION 'IMPTR 'VERSION NIL 'BODY
+                      [SETQ PTRFILENAME (PACKFILENAME 'EXTENSION 'IMPTR 'VERSION NIL 'BODY
                                                (COND
                                                   (TXTFILE (FULLNAME TXTFILE))
-                                                  (T 'NONAME]
+                                                  (T 'NONAME])
                   (SETQ PTRFILENAME (PACKFILENAME 'BODY PTRFILENAME 'BODY (DIRECTORYNAME T)))
                   (printout PROMPTWINDOW "Opening index pointer file: " PTRFILENAME "...")
                   (SETQ PTRFILE (OPENSTREAM PTRFILENAME 'OUTPUT 'NEW))
                   (printout PROMPTWINDOW "done" T)
-                  (TEXTPROP HOSTSTREAM 'IM.INDEX.PTRFILE PTRFILE)))
+                  (TEXTPROP HOSTSTREAM 'IM.INDEX.PTRFILE PTRFILE)
+                  (TEXTPROP HOSTSTREAM 'AFTERHARDCOPYFN (FUNCTION IM.INDEX.CLOSEF)))
               (replace (IM.INDEX.DATA PAGE#) of (IMAGEOBJPROP OBJ 'OBJECTDATUM)
                  with (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE))
 
@@ -253,13 +256,16 @@
       else (CONCATLIST (CDR (for X in LST join (LIST " " X])
 
 (IM.INDEX.PUTFN
-  [LAMBDA (OBJ STREAM)                                       (* ; "Edited  7-Apr-87 18:44 by jds")
+  [LAMBDA (OBJ STREAM)                                       (* ; "Edited  7-Apr-2024 09:14 by rmk")
+                                                             (* ; "Edited  7-Apr-87 18:44 by jds")
     (PRIN4 (IMAGEOBJPROP OBJ 'OBJECTDATUM)
-           STREAM])
+           STREAM
+           (FIND-READTABLE "OLD-INTERLISP-FILE"])
 
 (IM.INDEX.GETFN
-  [LAMBDA (FILE TEXTSTREAM)                                  (* mjs " 4-Aug-86 16:26")
-    (IM.INDEX.CREATEOBJ (READ FILE])
+  [LAMBDA (FILE TEXTSTREAM)                                  (* ; "Edited  7-Apr-2024 09:14 by rmk")
+                                                             (* mjs " 4-Aug-86 16:26")
+    (IM.INDEX.CREATEOBJ (READ FILE (FIND-READTABLE "OLD-INTERLISP-FILE"])
 
 (IM.INDEX.BUTTONEVENTFN
   [LAMBDA (OBJ WINDOWSTREAM SEL RELX RELY WIN HOSTSTREAM BUTTON)
@@ -634,13 +640,13 @@
 
 (IM.INDEX.INIT)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1673 14725 (IM.INDEX.CLOSEF 1683 . 2298) (IM.INDEX.COPYFN 2300 . 2485) (
-IM.INDEX.CREATEOBJ 2487 . 3833) (IM.INDEX.DISPLAY.STRING 3835 . 4256) (IM.INDEX.DISPLAYFN 4258 . 8101)
- (IM.INDEX.EDIT 8103 . 11571) (IM.INDEX.LIST.FROM.STRING 11573 . 12607) (IM.INDEX.SIZEFN 12609 . 13369
-) (IM.INDEX.STRING.FROM.LIST 13371 . 13616) (IM.INDEX.PUTFN 13618 . 13807) (IM.INDEX.GETFN 13809 . 
-13964) (IM.INDEX.BUTTONEVENTFN 13966 . 14723)) (14726 16796 (IM.INDEX.INIT 14736 . 16794)) (16797 
-28713 (IM.INDEX.MENU 16807 . 18495) (IM.INDEX.MENU.WHENSELECTEDFN 18497 . 25252) (
-IM.INDEX.OBJ.FREEMENU.SELECTEDFN 25254 . 28711)) (31229 36372 (IM.CHAP.COPYFN 31239 . 31419) (
-IM.CHAP.CREATEOBJ 31421 . 32847) (IM.CHAP.DISPLAYFN 32849 . 34809) (IM.CHAP.SIZEFN 34811 . 35813) (
-IM.CHAP.PUTFN 35815 . 35999) (IM.CHAP.GETFN 36001 . 36162) (IM.CHAP.BUTTONEVENTFN 36164 . 36370)))))
+  (FILEMAP (NIL (1692 15373 (IM.INDEX.CLOSEF 1702 . 2393) (IM.INDEX.COPYFN 2395 . 2580) (
+IM.INDEX.CREATEOBJ 2582 . 3928) (IM.INDEX.DISPLAY.STRING 3930 . 4351) (IM.INDEX.DISPLAYFN 4353 . 8450)
+ (IM.INDEX.EDIT 8452 . 11920) (IM.INDEX.LIST.FROM.STRING 11922 . 12956) (IM.INDEX.SIZEFN 12958 . 13718
+) (IM.INDEX.STRING.FROM.LIST 13720 . 13965) (IM.INDEX.PUTFN 13967 . 14313) (IM.INDEX.GETFN 14315 . 
+14612) (IM.INDEX.BUTTONEVENTFN 14614 . 15371)) (15374 17444 (IM.INDEX.INIT 15384 . 17442)) (17445 
+29361 (IM.INDEX.MENU 17455 . 19143) (IM.INDEX.MENU.WHENSELECTEDFN 19145 . 25900) (
+IM.INDEX.OBJ.FREEMENU.SELECTEDFN 25902 . 29359)) (31877 37020 (IM.CHAP.COPYFN 31887 . 32067) (
+IM.CHAP.CREATEOBJ 32069 . 33495) (IM.CHAP.DISPLAYFN 33497 . 35457) (IM.CHAP.SIZEFN 35459 . 36461) (
+IM.CHAP.PUTFN 36463 . 36647) (IM.CHAP.GETFN 36649 . 36810) (IM.CHAP.BUTTONEVENTFN 36812 . 37018)))))
 STOP
diff --git a/doctools/IMINDEX.LCOM b/doctools/IMINDEX.LCOM