(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "24-Mar-2025 10:31:37" {WMEDLEY}IMINDEX.;10 37350 :EDIT-BY rmk :CHANGES-TO (FNS IM.INDEX.EDIT) :PREVIOUS-DATE "17-Mar-2025 12:07:55" {WMEDLEY}IMINDEX.;9) (PRETTYCOMPRINT IMINDEXCOMS) (RPAQQ IMINDEXCOMS ( (* ;;  "this file contains the functions used for creating and manipulating index image objects") (FNS IM.INDEX.CLOSEF IM.INDEX.COPYFN IM.INDEX.CREATEOBJ IM.INDEX.DISPLAY.STRING IM.INDEX.DISPLAYFN IM.INDEX.EDIT IM.INDEX.LIST.FROM.STRING IM.INDEX.SIZEFN IM.INDEX.STRING.FROM.LIST IM.INDEX.PUTFN IM.INDEX.GETFN IM.INDEX.BUTTONEVENTFN) (FNS IM.INDEX.INIT) (FNS IM.INDEX.MENU IM.INDEX.MENU.WHENSELECTEDFN IM.INDEX.OBJ.FREEMENU.SELECTEDFN) (INITVARS (IM.INDEX.OBJECT.IMAGEFNS NIL) (IM.CHAP.OBJECT.IMAGEFNS NIL) (IM.INDEX.BUTTONEVENTFN.MENU NIL) [IM.INDEX.OBJECT.DISPLAY.FONT (FONTCREATE '(MODERN 8 MRR 0 DISPLAY] (IM.INDEX.DEFAULT.SUBSEC)) (RECORDS IM.INDEX.DATA) (VARS IM.INDEX.OBJ.FREEMENU.SPECS) (COMS (* ; "An image object to set the chapter number, on the TEXTOBJ's proplist, on the INDEXING-CHAPTER property.") (FNS IM.CHAP.COPYFN IM.CHAP.CREATEOBJ IM.CHAP.DISPLAYFN IM.CHAP.SIZEFN IM.CHAP.PUTFN IM.CHAP.GETFN IM.CHAP.BUTTONEVENTFN)) (P (IM.INDEX.INIT)))) (* ;; "this file contains the functions used for creating and manipulating index image objects") (DEFINEQ (IM.INDEX.CLOSEF [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)) then (printout PROMPTWINDOW "Closing index pointer file: " (FULLNAME PTRFILE) "...") (CLOSEF PTRFILE) (printout PROMPTWINDOW "done" T]) (IM.INDEX.COPYFN [LAMBDA (OBJ SOURCE TARGET) (* mjs " 4-Aug-86 16:29") (IM.INDEX.CREATEOBJ (COPYALL (IMAGEOBJPROP OBJ 'OBJECTDATUM]) (IM.INDEX.CREATEOBJ [LAMBDA (DATA) (* mjs " 8-Aug-86 14:46") (IMAGEOBJCREATE (if (type? IM.INDEX.DATA DATA) then DATA else (create IM.INDEX.DATA)) (if IM.INDEX.OBJECT.IMAGEFNS else (SETQ IM.INDEX.OBJECT.IMAGEFNS (IMAGEFNSCREATE (FUNCTION IM.INDEX.DISPLAYFN) (FUNCTION IM.INDEX.SIZEFN) (FUNCTION IM.INDEX.PUTFN) (FUNCTION IM.INDEX.GETFN) (FUNCTION IM.INDEX.COPYFN) (FUNCTION IM.INDEX.BUTTONEVENTFN) 'NILL 'NILL 'NILL 'NILL 'NILL 'NILL 'NILL 'IM.INDEX.OBJECT]) (IM.INDEX.DISPLAY.STRING [LAMBDA (OBJ) (* mjs " 5-Aug-86 12:29") (PROG [(NAM (fetch (IM.INDEX.DATA NAME) of (IMAGEOBJPROP OBJ 'OBJECTDATUM] (RETURN (if (ILESSP (NCHARS NAM) 10) then NAM else (CONCAT (SUBATOM NAM 1 7) '|...|]) (IM.INDEX.DISPLAYFN [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") (COND ((DISPLAYSTREAMP STREAM) (* ;; "display index by printing name with box around it ") (DSPFONT IM.INDEX.OBJECT.DISPLAY.FONT STREAM) (LET* ((STRING (IM.INDEX.DISPLAY.STRING OBJ)) (STRING.REGION (STRINGREGION STRING STREAM)) (LEFT (ADD1 (fetch (REGION LEFT) of STRING.REGION))) (BOTTOM (ADD1 (fetch (REGION BOTTOM) of STRING.REGION))) (REGION (create REGION LEFT _ LEFT BOTTOM _ BOTTOM HEIGHT _ (IPLUS (fetch (REGION HEIGHT) of STRING.REGION) 2) WIDTH _ (IPLUS (fetch (REGION WIDTH) of STRING.REGION) 4))) (TOP (fetch (REGION TOP) of REGION)) (RIGHT (fetch (REGION RIGHT) of REGION))) (CENTERPRINTINREGION STRING REGION STREAM) (DRAWLINE LEFT BOTTOM LEFT (SUB1 TOP) 1 'INVERT STREAM) (DRAWLINE LEFT TOP (SUB1 RIGHT) TOP 1 'INVERT STREAM) (DRAWLINE RIGHT TOP RIGHT (ADD1 BOTTOM) 1 'INVERT STREAM) (DRAWLINE RIGHT BOTTOM (ADD1 LEFT) BOTTOM 1 'INVERT STREAM) (IMAGEOBJPROP OBJ 'REGION REGION))) ((AND (BOUNDP 'TEXTOBJ) (TYPENAMEP (SETQ HOSTSTREAM TEXTOBJ) 'TEXTOBJ)) (* ;;; "note: have to reset HOSTSTREAM above because Koto Tedit doesn't pass HOSTSTREAM to imageobj displayfn.") (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)) (CL:UNLESS (AND PTRFILE (OPENP PTRFILE)) (SETQ PTRFILENAME (TEXTPROP HOSTSTREAM 'IM.INDEX.PTRFILENAME)) (CL:UNLESS PTRFILENAME (SETQ TXTFILE (fetch (TEXTOBJ TXTFILE) of (TEXTOBJ HOSTSTREAM))) [SETQ PTRFILENAME (PACKFILENAME 'EXTENSION 'IMPTR 'VERSION NIL 'BODY (COND (TXTFILE (FULLNAME TXTFILE)) (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 'AFTERHARDCOPYFN (FUNCTION IM.INDEX.CLOSEF))) (replace (IM.INDEX.DATA PAGE#) of (IMAGEOBJPROP OBJ 'OBJECTDATUM) with (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE)) (* ;; "(OR (FETCH (IM.INDEX.DATA SUBSEC) OF (IMAGEOBJPROP OBJ 'OBJECTDATUM)) (REPLACE (IM.INDEX.DATA SUBSEC) OF (IMAGEOBJPROP OBJ 'OBJECTDATUM) WITH (LIST (TEXTPROP HOSTSTREAM 'INDEXING-CHAPTER)))") (* ;; "for now, always set the chapter/subsection from the document:") [REPLACE (IM.INDEX.DATA SUBSEC) OF (IMAGEOBJPROP OBJ 'OBJECTDATUM) WITH (LIST (TEXTPROP HOSTSTREAM 'INDEXING-CHAPTER] (PRIN4 (IMAGEOBJPROP OBJ 'OBJECTDATUM) PTRFILE) (TERPRI PTRFILE]) (IM.INDEX.EDIT [LAMBDA (OBJ TEXTSTREAM) (* ; "Edited 24-Mar-2025 10:30 by rmk") (* ; "Edited 17-Mar-2025 12:06 by rmk") (* ; "Edited 29-Jun-2024 00:14 by rmk") (* ; "Edited 18-Jul-88 14:10 by burns") (PROG* ((W (FREEMENU IM.INDEX.OBJ.FREEMENU.SPECS)) (REGION (WINDOWREGION W)) (TEDIT.WINDOW (TEDITWINDOWP TEXTSTREAM)) (TEDIT.REGION (AND TEDIT.WINDOW (WINDOWREGION TEDIT.WINDOW))) OBJ.DATA OBJ.DATA.PROPLIST) (WINDOWPROP W 'IM.INDEX.OBJ OBJ) (WINDOWPROP W 'IM.INDEX.TEXTSTREAM TEXTSTREAM) (SETQ OBJ.DATA (IMAGEOBJPROP OBJ 'OBJECTDATUM)) (SETQ OBJ.DATA.PROPLIST (fetch (IM.INDEX.DATA PROPLIST) of OBJ.DATA)) (for ITEM in (WINDOWPROP W 'FM.ITEMS) when (EQ (FM.ITEMPROP ITEM 'TYPE) 'EDIT) do (FM.CHANGESTATE ITEM (with IM.INDEX.DATA OBJ.DATA (SELECTQ (FM.ITEMPROP ITEM 'ID) (IM.INDEX.NAME NAME) (IM.INDEX.TYPE (IM.INDEX.STRING.FROM.LIST TYPE)) (IM.INDEX.TEXT SAV) (IM.INDEX.INFO (IM.INDEX.STRING.FROM.LIST INFO)) (IM.INDEX.SUBSEC (IM.INDEX.STRING.FROM.LIST SUBSEC)) (IM.INDEX.PAGE PAGE#) (IM.INDEX.SUBNAME (LISTGET OBJ.DATA.PROPLIST 'SUBNAME)) (IM.INDEX.SUBTYPE (IM.INDEX.STRING.FROM.LIST (LISTGET OBJ.DATA.PROPLIST 'SUBTYPE))) (IM.INDEX.SUBTEXT (LISTGET OBJ.DATA.PROPLIST 'SUBTEXT)) (IM.INDEX.SUBSUBNAME (LISTGET OBJ.DATA.PROPLIST 'SUBSUBNAME)) (IM.INDEX.SUBSUBTYPE (IM.INDEX.STRING.FROM.LIST (LISTGET OBJ.DATA.PROPLIST 'SUBSUBTYPE))) (IM.INDEX.SUBSUBTEXT (LISTGET OBJ.DATA.PROPLIST 'SUBSUBTEXT)) NIL)) W)) (AND TEDIT.WINDOW (MOVEW W (MAX (- (fetch (REGION LEFT) of TEDIT.REGION) (fetch (REGION WIDTH) of REGION)) 0) (MAX (- (fetch (REGION TOP) of TEDIT.REGION) (fetch (REGION HEIGHT) of REGION)) 0))) (OPENW W]) (IM.INDEX.LIST.FROM.STRING [LAMBDA (STR) (* mjs " 6-Aug-86 08:21") (if (OR (EQUAL STR "") (EQUAL STR NIL)) then NIL else (PROG ((ELIST NIL) (CLIST NIL) C) [for N from 1 to (NCHARS STR) do (SETQ C (NTHCHARCODE STR N)) (if (FMEMB C (CHARCODE (SP TAB CR))) then (if CLIST then (SETQ ELIST (CONS (PACKC (DREVERSE CLIST)) ELIST)) (SETQ CLIST NIL)) else (SETQ CLIST (CONS C CLIST] (RETURN (DREVERSE (if CLIST then (CONS (PACKC (DREVERSE CLIST)) ELIST) else ELIST]) (IM.INDEX.SIZEFN [LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* mjs " 5-Aug-86 14:49") (if (DISPLAYSTREAMP STREAM) then (create IMAGEBOX XSIZE _ (IPLUS (STRINGWIDTH (IM.INDEX.DISPLAY.STRING OBJ) IM.INDEX.OBJECT.DISPLAY.FONT) 6) YSIZE _ (IPLUS (FONTPROP IM.INDEX.OBJECT.DISPLAY.FONT 'HEIGHT) 4) YDESC _ (FONTPROP IM.INDEX.OBJECT.DISPLAY.FONT 'DESCENT) XKERN _ 0) else (create IMAGEBOX XSIZE _ 0 YSIZE _ 0 YDESC _ 0 XKERN _ 0]) (IM.INDEX.STRING.FROM.LIST [LAMBDA (LST) (* mjs " 5-Aug-86 16:50") (if (NULL LST) then "" else (CONCATLIST (CDR (for X in LST join (LIST " " X]) (IM.INDEX.PUTFN [LAMBDA (OBJ STREAM) (* ; "Edited 7-Apr-2024 09:14 by rmk") (* ; "Edited 7-Apr-87 18:44 by jds") (PRIN4 (IMAGEOBJPROP OBJ 'OBJECTDATUM) STREAM (FIND-READTABLE "OLD-INTERLISP-FILE"]) (IM.INDEX.GETFN [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) (* mjs " 8-Aug-86 15:23") (COND ([MENU (COND (IM.INDEX.BUTTONEVENTFN.MENU) (T (SETQ IM.INDEX.BUTTONEVENTFN.MENU (create MENU ITEMS _ '((Edit% Index 'Edit% Index "Selecting this item will create a window editing the contents of this index image object." )) MENUOFFSET _ (CREATEPOSITION -5 -5] (IM.INDEX.EDIT OBJ HOSTSTREAM]) ) (DEFINEQ (IM.INDEX.INIT [LAMBDA NIL (* ; "Edited 8-Dec-91 14:40 by jds") (* ;; "Set up the IMAGEFNS for index objects, so that TEdit will know about them.") [COND ((NOT IM.INDEX.OBJECT.IMAGEFNS) (SETQ IM.INDEX.OBJECT.IMAGEFNS (IMAGEFNSCREATE (FUNCTION IM.INDEX.DISPLAYFN) (FUNCTION IM.INDEX.SIZEFN) (FUNCTION IM.INDEX.PUTFN) (FUNCTION IM.INDEX.GETFN) (FUNCTION IM.INDEX.COPYFN) (FUNCTION IM.INDEX.BUTTONEVENTFN) 'NILL 'NILL 'NILL 'NILL 'NILL 'NILL 'NILL 'IM.INDEX.OBJECT] (COND ((NOT IM.CHAP.OBJECT.IMAGEFNS) (SETQ IM.CHAP.OBJECT.IMAGEFNS (IMAGEFNSCREATE (FUNCTION IM.CHAP.DISPLAYFN) (FUNCTION IM.CHAP.SIZEFN) (FUNCTION IM.CHAP.PUTFN) (FUNCTION IM.CHAP.GETFN) (FUNCTION IM.CHAP.COPYFN) (FUNCTION IM.CHAP.BUTTONEVENTFN) 'NILL 'NILL 'NILL 'NILL 'NILL 'NILL 'NILL 'IM.CHAP.OBJECT]) ) (DEFINEQ (IM.INDEX.MENU [LAMBDA (WINDOW.OR.REGION) (* ; "Edited 8-Dec-91 15:22 by jds") (PROG (MENU MENUW) (SETQ MENU (create MENU ITEMS _ '(("Index Selection as Term" NIL "Add an index object indexing the current selection as a term." ) (>>Add% Type<< NIL "Prompts the user to specify an IM Index type, and adds it to the menu" ) (|Set Chapter Number| NIL "Prompts you for the name or number of this chapter, then inserts an object to set the chapter number at hardcopy time." ) (>>Close% Menu<< NIL "Closes this menu.")) WHENSELECTEDFN _ (FUNCTION IM.INDEX.MENU.WHENSELECTEDFN) TITLE _ "IM Index menu")) (ADDMENU MENU NIL (COND ((REGIONP WINDOW.OR.REGION) (CREATEPOSITION (fetch (REGION LEFT) of WINDOW.OR.REGION) (fetch (REGION BOTTOM) of WINDOW.OR.REGION))) (T (GETBOXPOSITION (fetch (REGION WIDTH) of (MENUREGION MENU)) (fetch (REGION HEIGHT) of (MENUREGION MENU)) NIL NIL NIL "Please specify the position of the IM Index menu"]) (IM.INDEX.MENU.WHENSELECTEDFN [LAMBDA (ITEM MENU MOUSEKEY) (* ; "Edited 8-Dec-91 14:56 by jds") (* ;; "Handle requests from the INDEX MENU.") (PROG* [(MENUW (WFROMMENU MENU)) (DESTW (PROCESSPROP (TTY.PROCESS) 'WINDOW)) (TEXTSTREAM (WINDOWPROP DESTW 'TEXTSTREAM] (SELECTQ (CAR ITEM) (>>Close% Menu<< (CLOSEW MENUW)) (>>Add% Type<< [PROG ((WINDOW.REGION (WINDOWPROP MENUW 'REGION)) STR) (CLEARW PROMPTWINDOW) (SETQ STR (if (PROMPTFORWORD "IM Index Type: " NIL NIL PROMPTWINDOW NIL 'TTY (CHARCODE (EOL))) else "")) (CLOSEW MENUW) (ADDMENU (create MENU ITEMS _ (CONS (LIST (CONCAT "Index Selection as " STR) (IM.INDEX.LIST.FROM.STRING STR)) (fetch (MENU ITEMS) of MENU)) WHENSELECTEDFN _ (FUNCTION IM.INDEX.MENU.WHENSELECTEDFN) TITLE _ "IM Index menu") NIL (CREATEPOSITION (fetch (REGION LEFT) of WINDOW.REGION ) (fetch (REGION BOTTOM) of WINDOW.REGION]) (|Set Chapter Number| (* ;;  "Create a chapter-number image object, and insert at the caret in the edit stream.") (COND [TEXTSTREAM (PROG* ((SEL (TEDIT.GETSEL TEXTSTREAM)) (FIRSTCHAR (fetch (SELECTION CH#) of SEL)) (AFTERLASTCHAR (fetch (SELECTION CHLIM) of SEL)) (SELPOINT (fetch (SELECTION POINT) of SEL)) (NAM NIL) OBJ) (SETQ OBJ (IM.CHAP.CREATEOBJ (TEDIT.GETINPUT TEXTSTREAM "Chapter Number/Title:" ))) (* ; "turn off any pending deletion") (TEDIT.SETSEL TEXTSTREAM FIRSTCHAR (fetch (SELECTION DCH) of SEL) SELPOINT NIL) (TEDIT.INSERT.OBJECT OBJ TEXTSTREAM (COND ((EQ SELPOINT 'LEFT) FIRSTCHAR) (T AFTERLASTCHAR] (T (printout PROMPTWINDOW "Current window is not a Tedit textstream." T)))) (COND [TEXTSTREAM (PROG* ((SEL (TEDIT.GETSEL TEXTSTREAM)) (FIRSTCHAR (fetch (SELECTION CH#) of SEL)) (AFTERLASTCHAR (fetch (SELECTION CHLIM) of SEL)) (SELPOINT (fetch (SELECTION POINT) of SEL)) (NAM NIL) OBJ) [SETQ NAM (CAR (NLSETQ (MKATOM (TEDIT.SEL.AS.STRING TEXTSTREAM SEL] [SETQ OBJ (IM.INDEX.CREATEOBJ (create IM.INDEX.DATA NAME _ (U-CASE NAM) TYPE _ (CADR ITEM) SAV _ (COND ((U-CASEP NAM) NIL) (T NAM] (* ; "turn off any pending deletion") (TEDIT.SETSEL TEXTSTREAM FIRSTCHAR (fetch (SELECTION DCH) of SEL) SELPOINT NIL) (TEDIT.INSERT.OBJECT OBJ TEXTSTREAM (COND ((EQ SELPOINT 'LEFT) FIRSTCHAR) (T AFTERLASTCHAR))) (COND ((EQ MOUSEKEY 'MIDDLE) (IM.INDEX.EDIT OBJ TEXTSTREAM] (T (printout PROMPTWINDOW "Current window is not a Tedit textstream." T]) (IM.INDEX.OBJ.FREEMENU.SELECTEDFN [LAMBDA (ITEM WINDOW BUTTONS) (* ; "Edited 18-Jul-88 14:14 by burns") (SELECTQ (FM.ITEMPROP ITEM 'LABEL) (Close% Window (CLOSEW WINDOW)) (Store% Props (PROG* [(STATE (FM.GETSTATE WINDOW)) (OBJ (WINDOWPROP WINDOW 'IM.INDEX.OBJ)) (TEXTSTREAM (WINDOWPROP WINDOW 'IM.INDEX.TEXTSTREAM)) (OBJ.DATA (IMAGEOBJPROP OBJ 'OBJECTDATUM)) (OBJ.DATA.PROPLIST (fetch (IM.INDEX.DATA PROPLIST) of OBJ.DATA)) (NAME.CHANGED (NEQ (fetch (IM.INDEX.DATA NAME) of OBJ.DATA) (MKATOM (LISTGET STATE 'IM.INDEX.NAME] [with IM.INDEX.DATA OBJ.DATA [SETQ NAME (MKATOM (LISTGET STATE 'IM.INDEX.NAME] [SETQ TYPE (IM.INDEX.LIST.FROM.STRING (LISTGET STATE ' IM.INDEX.TYPE] [SETQ SAV (MKATOM (LISTGET STATE 'IM.INDEX.TEXT] [SETQ INFO (IM.INDEX.LIST.FROM.STRING (LISTGET STATE ' IM.INDEX.INFO] [SETQ SUBSEC (SETQ IM.INDEX.DEFAULT.SUBSEC (IM.INDEX.LIST.FROM.STRING (LISTGET STATE 'IM.INDEX.SUBSEC] [SETQ PAGE# (MKATOM (LISTGET STATE 'IM.INDEX.PAGE] [SETQ PROPLIST (LIST 'SUBNAME (MKATOM (LISTGET STATE ' IM.INDEX.SUBNAME)) 'SUBTYPE (IM.INDEX.LIST.FROM.STRING (LISTGET STATE 'IM.INDEX.SUBTYPE)) 'SUBTEXT (MKATOM (LISTGET STATE 'IM.INDEX.SUBTEXT)) 'SUBSUBNAME (MKATOM (LISTGET STATE 'IM.INDEX.SUBSUBNAME)) 'SUBSUBTYPE (IM.INDEX.LIST.FROM.STRING (LISTGET STATE 'IM.INDEX.SUBSUBTYPE)) 'SUBSUBTEXT (MKATOM (LISTGET STATE 'IM.INDEX.SUBSUBTEXT] (SETQ PROPLIST (for X on PROPLIST by (CDDR X) when (CADR X) join (LIST (CAR X) (CADR X] (if (AND NAME.CHANGED (TEXTSTREAMP TEXTSTREAM)) then (TEDIT.OBJECT.CHANGED TEXTSTREAM OBJ)))) NIL]) ) (RPAQ? IM.INDEX.OBJECT.IMAGEFNS NIL) (RPAQ? IM.CHAP.OBJECT.IMAGEFNS NIL) (RPAQ? IM.INDEX.BUTTONEVENTFN.MENU NIL) (RPAQ? IM.INDEX.OBJECT.DISPLAY.FONT (FONTCREATE '(MODERN 8 MRR 0 DISPLAY))) (RPAQ? IM.INDEX.DEFAULT.SUBSEC ) (DECLARE%: EVAL@COMPILE (RECORD IM.INDEX.DATA (NAME TYPE SAV INFO SUBSEC PAGE# . PROPLIST) SUBSEC _ IM.INDEX.DEFAULT.SUBSEC (TYPE? (AND (LISTP DATUM) (IGEQ (LENGTH DATUM) 6)))) ) (RPAQQ IM.INDEX.OBJ.FREEMENU.SPECS (((TYPE MOMENTARY LABEL Store% Props SELECTEDFN IM.INDEX.OBJ.FREEMENU.SELECTEDFN MESSAGE "Stores property values in index image object") (TYPE MOMENTARY LABEL Close% Window SELECTEDFN IM.INDEX.OBJ.FREEMENU.SELECTEDFN MESSAGE "Closes IM index editor window")) ((TYPE DISPLAY LABEL " ")) ((TYPE EDITSTART LABEL Name%: ITEMS (IM.INDEX.NAME)) (TYPE EDIT ID IM.INDEX.NAME LABEL "")) ((TYPE EDITSTART LABEL |Type():| ITEMS (IM.INDEX.TYPE)) (TYPE EDIT ID IM.INDEX.TYPE LABEL "")) ((TYPE EDITSTART LABEL Text%: ITEMS (IM.INDEX.TEXT)) (TYPE EDIT ID IM.INDEX.TEXT LABEL "")) ((TYPE EDITSTART LABEL |Info():| ITEMS (IM.INDEX.INFO)) (TYPE EDIT ID IM.INDEX.INFO LABEL "")) ((TYPE EDITSTART LABEL |SubSub():| ITEMS (IM.INDEX.SUBSEC)) (TYPE EDIT ID IM.INDEX.SUBSEC LABEL "")) ((TYPE EDITSTART LABEL Page#%: ITEMS (IM.INDEX.PAGE)) (TYPE EDIT ID IM.INDEX.PAGE LABEL "")) ((TYPE EDITSTART LABEL SubName%: ITEMS (IM.INDEX.SUBNAME)) (TYPE EDIT ID IM.INDEX.SUBNAME LABEL "")) ((TYPE EDITSTART LABEL |SubType():| ITEMS (IM.INDEX.SUBTYPE)) (TYPE EDIT ID IM.INDEX.SUBTYPE LABEL "")) ((TYPE EDITSTART LABEL SubText%: ITEMS (IM.INDEX.SUBTEXT)) (TYPE EDIT ID IM.INDEX.SUBTEXT LABEL "")) ((TYPE EDITSTART LABEL SubSubName%: ITEMS (IM.INDEX.SUBSUBNAME)) (TYPE EDIT ID IM.INDEX.SUBSUBNAME LABEL "")) ((TYPE EDITSTART LABEL |SubSubType():| ITEMS (IM.INDEX.SUBSUBTYPE)) (TYPE EDIT ID IM.INDEX.SUBSUBTYPE LABEL "")) ((TYPE EDITSTART LABEL SubSubText%: ITEMS (IM.INDEX.SUBSUBTEXT)) (TYPE EDIT ID IM.INDEX.SUBSUBTEXT LABEL "")))) (* ; "An image object to set the chapter number, on the TEXTOBJ's proplist, on the INDEXING-CHAPTER property." ) (DEFINEQ (IM.CHAP.COPYFN [LAMBDA (OBJ SOURCE TARGET) (* mjs " 4-Aug-86 16:29") (IM.INDEX.CREATEOBJ (COPYALL (IMAGEOBJPROP OBJ 'OBJECTDATUM]) (IM.CHAP.CREATEOBJ [LAMBDA (DATA) (* ; "Edited 8-Dec-91 14:40 by jds") (IMAGEOBJCREATE DATA (if IM.CHAP.OBJECT.IMAGEFNS else (SETQ IM.CHAP.OBJECT.IMAGEFNS (IMAGEFNSCREATE (FUNCTION IM.CHAP.DISPLAYFN) (FUNCTION IM.CHAP.SIZEFN) (FUNCTION IM.CHAP.PUTFN) (FUNCTION IM.CHAP.GETFN) (FUNCTION IM.CHAP.COPYFN) (FUNCTION IM.CHAP.BUTTONEVENTFN) 'NILL 'NILL 'NILL 'NILL 'NILL 'NILL 'NILL 'IM.CHAP.OBJECT]) (IM.CHAP.DISPLAYFN [LAMBDA (OBJ STREAM STREAMTYPE HOSTSTREAM) (* ; "Edited 12-Feb-92 12:28 by jds") (* ;; "only print CHAPTER MARKER if you are going to display") (COND ((DISPLAYSTREAMP STREAM) (* ;; "display index by printing name with box around it ") (DSPFONT IM.INDEX.OBJECT.DISPLAY.FONT STREAM) (LET* ([STRING (CONCAT "CHAPTER " (MKSTRING (IMAGEOBJPROP OBJ 'OBJECTDATUM] (STRING.REGION (STRINGREGION STRING STREAM)) (LEFT (ADD1 (fetch (REGION LEFT) of STRING.REGION))) (BOTTOM (ADD1 (fetch (REGION BOTTOM) of STRING.REGION))) (REGION (create REGION LEFT _ LEFT BOTTOM _ BOTTOM HEIGHT _ (IPLUS (fetch (REGION HEIGHT) of STRING.REGION) 2) WIDTH _ (IPLUS (fetch (REGION WIDTH) of STRING.REGION) 4))) (TOP (fetch (REGION TOP) of REGION)) (RIGHT (fetch (REGION RIGHT) of REGION))) (CENTERPRINTINREGION STRING REGION STREAM) (DRAWLINE LEFT BOTTOM LEFT (SUB1 TOP) 1 'INVERT STREAM) (DRAWLINE LEFT TOP (SUB1 RIGHT) TOP 1 'INVERT STREAM) (DRAWLINE RIGHT TOP RIGHT (ADD1 BOTTOM) 1 'INVERT STREAM) (DRAWLINE RIGHT BOTTOM (ADD1 LEFT) BOTTOM 1 'INVERT STREAM) (IMAGEOBJPROP OBJ 'REGION REGION))) (T (* ;; "HARDCOPYING; DO NOTHING BUT SET ") (TEXTPROP (TEXTOBJ (OR HOSTSTREAM TEXTOBJ)) 'INDEXING-CHAPTER (IMAGEOBJPROP OBJ 'OBJECTDATUM]) (IM.CHAP.SIZEFN [LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* ; "Edited 8-Dec-91 14:38 by jds") (if (DISPLAYSTREAMP STREAM) then (create IMAGEBOX XSIZE _ (IPLUS (STRINGWIDTH [CONCAT "CHAPTER " (MKSTRING (IMAGEOBJPROP OBJ 'OBJECTDATUM] IM.INDEX.OBJECT.DISPLAY.FONT) 6) YSIZE _ (IPLUS (FONTPROP IM.INDEX.OBJECT.DISPLAY.FONT 'HEIGHT) 4) YDESC _ (FONTPROP IM.INDEX.OBJECT.DISPLAY.FONT 'DESCENT) XKERN _ 0) else (create IMAGEBOX XSIZE _ 0 YSIZE _ 0 YDESC _ 0 XKERN _ 0]) (IM.CHAP.PUTFN [LAMBDA (OBJ STREAM) (* ; "Edited 7-Apr-87 18:44 by jds") (PRIN4 (IMAGEOBJPROP OBJ 'OBJECTDATUM) STREAM]) (IM.CHAP.GETFN [LAMBDA (FILE TEXTSTREAM) (* ; "Edited 8-Dec-91 14:40 by jds") (IM.CHAP.CREATEOBJ (READ FILE]) (IM.CHAP.BUTTONEVENTFN [LAMBDA (OBJ WINDOWSTREAM SEL RELX RELY WIN HOSTSTREAM BUTTON) (* ; "Edited 8-Dec-91 14:40 by jds") T]) ) (IM.INDEX.INIT) (DECLARE%: DONTCOPY (FILEMAP (NIL (1677 15659 (IM.INDEX.CLOSEF 1687 . 2378) (IM.INDEX.COPYFN 2380 . 2565) ( IM.INDEX.CREATEOBJ 2567 . 3913) (IM.INDEX.DISPLAY.STRING 3915 . 4336) (IM.INDEX.DISPLAYFN 4338 . 8435) (IM.INDEX.EDIT 8437 . 12206) (IM.INDEX.LIST.FROM.STRING 12208 . 13242) (IM.INDEX.SIZEFN 13244 . 14004 ) (IM.INDEX.STRING.FROM.LIST 14006 . 14251) (IM.INDEX.PUTFN 14253 . 14599) (IM.INDEX.GETFN 14601 . 14898) (IM.INDEX.BUTTONEVENTFN 14900 . 15657)) (15660 17730 (IM.INDEX.INIT 15670 . 17728)) (17731 29647 (IM.INDEX.MENU 17741 . 19429) (IM.INDEX.MENU.WHENSELECTEDFN 19431 . 26186) ( IM.INDEX.OBJ.FREEMENU.SELECTEDFN 26188 . 29645)) (32163 37306 (IM.CHAP.COPYFN 32173 . 32353) ( IM.CHAP.CREATEOBJ 32355 . 33781) (IM.CHAP.DISPLAYFN 33783 . 35743) (IM.CHAP.SIZEFN 35745 . 36747) ( IM.CHAP.PUTFN 36749 . 36933) (IM.CHAP.GETFN 36935 . 37096) (IM.CHAP.BUTTONEVENTFN 37098 . 37304))))) STOP