Move internal/library to internal, xerox font dirs, loadup and medleydir (#709)
* Move internal/library to internal, xerox font dirs, loadup and medleydir * and MEDLEYDIR too * mised some changes in 'promote/internal' * tiny typo
This commit is contained in:
Larry Masinter
GitHub
658
doctools/IMINDEX
Normal file
658
doctools/IMINDEX
Normal file
@@ -0,0 +1,658 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "12-Feb-92 12:28:48" {DSK}<users>sybalsky>PUBS>IMINDEX.;2 37264
|
||||
|
||||
changes to%: (FNS IM.CHAP.DISPLAYFN)
|
||||
|
||||
previous date%: " 8-Dec-91 15:46:22" {DSK}<users>sybalsky>PUBS>IMINDEX.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(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 (ADVISE 'TEDIT.FORMAT.HARDCOPY 'AROUND '(RESETLST
|
||||
(RESETSAVE NIL (LIST (FUNCTION IM.INDEX.CLOSEF
|
||||
)
|
||||
STREAM))
|
||||
*))
|
||||
(IM.INDEX.INIT))))
|
||||
|
||||
|
||||
|
||||
(* ;; "this file contains the functions used for creating and manipulating index image objects")
|
||||
|
||||
(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.)
|
||||
|
||||
(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 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 <code stolen from HELPSYS>")
|
||||
|
||||
(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)
|
||||
(SETQ PTRFILE (TEXTPROP HOSTSTREAM 'IM.INDEX.PTRFILE))
|
||||
(COND
|
||||
((NOT (AND PTRFILE (OPENP PTRFILE)))
|
||||
(SETQ PTRFILENAME (TEXTPROP HOSTSTREAM 'IM.INDEX.PTRFILENAME))
|
||||
[COND
|
||||
((NULL 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)))
|
||||
(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 18-Jul-88 14:10 by burns")
|
||||
|
||||
(PROG* ((W (FREEMENU IM.INDEX.OBJ.FREEMENU.SPECS))
|
||||
(REGION (WINDOWREGION W))
|
||||
[TEDIT.WINDOW (CAR (fetch \WINDOW of (TEXTOBJ 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-87 18:44 by jds")
|
||||
(PRIN4 (IMAGEOBJPROP OBJ 'OBJECTDATUM)
|
||||
STREAM])
|
||||
|
||||
(IM.INDEX.GETFN
|
||||
[LAMBDA (FILE TEXTSTREAM) (* mjs " 4-Aug-86 16:26")
|
||||
(IM.INDEX.CREATEOBJ (READ 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 <code stolen from HELPSYS>")
|
||||
|
||||
(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])
|
||||
)
|
||||
|
||||
(ADVISE 'TEDIT.FORMAT.HARDCOPY 'AROUND '(RESETLST
|
||||
(RESETSAVE NIL (LIST (FUNCTION IM.INDEX.CLOSEF)
|
||||
STREAM))
|
||||
*))
|
||||
|
||||
(IM.INDEX.INIT)
|
||||
(PUTPROPS IMINDEX COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1991 1992))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2160 15212 (IM.INDEX.CLOSEF 2170 . 2785) (IM.INDEX.COPYFN 2787 . 2972) (
|
||||
IM.INDEX.CREATEOBJ 2974 . 4320) (IM.INDEX.DISPLAY.STRING 4322 . 4743) (IM.INDEX.DISPLAYFN 4745 . 8588)
|
||||
(IM.INDEX.EDIT 8590 . 12058) (IM.INDEX.LIST.FROM.STRING 12060 . 13094) (IM.INDEX.SIZEFN 13096 . 13856
|
||||
) (IM.INDEX.STRING.FROM.LIST 13858 . 14103) (IM.INDEX.PUTFN 14105 . 14294) (IM.INDEX.GETFN 14296 .
|
||||
14451) (IM.INDEX.BUTTONEVENTFN 14453 . 15210)) (15213 17283 (IM.INDEX.INIT 15223 . 17281)) (17284
|
||||
29200 (IM.INDEX.MENU 17294 . 18982) (IM.INDEX.MENU.WHENSELECTEDFN 18984 . 25739) (
|
||||
IM.INDEX.OBJ.FREEMENU.SELECTEDFN 25741 . 29198)) (31736 36879 (IM.CHAP.COPYFN 31746 . 31926) (
|
||||
IM.CHAP.CREATEOBJ 31928 . 33354) (IM.CHAP.DISPLAYFN 33356 . 35316) (IM.CHAP.SIZEFN 35318 . 36320) (
|
||||
IM.CHAP.PUTFN 36322 . 36506) (IM.CHAP.GETFN 36508 . 36669) (IM.CHAP.BUTTONEVENTFN 36671 . 36877)))))
|
||||
STOP
|
||||
Reference in New Issue
Block a user