github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-05 23:54:46 +00:00
Code Issues Projects Releases Wiki Activity

IMINDEX: The displayfn of index image objects sets AFTERHARDCOPYFN to close the index file (#1649)

Browse Source 
* 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
Download Patch File Download Diff File Expand all files Collapse all files

62
doctools/IMINDEX
View File

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

BIN
doctools/IMINDEX.LCOM
View File

Binary file not shown.