1
0
mirror of synced 2026-01-25 20:06:44 +00:00

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)
This commit is contained in:
rmkaplan
2024-04-29 17:04:12 -07:00
committed by GitHub
parent d79d5b397b
commit 931807ef44
2 changed files with 34 additions and 28 deletions

View File

@@ -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

Binary file not shown.