Tools to build the indexes
This commit is contained in:
Arun Welch
parent
5b384db4e1
commit
fde929a6d3
658
docs/Documentation Tools/IMINDEX
Normal file
658
docs/Documentation Tools/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
|
||||
BIN
docs/Documentation Tools/IMINDEX.LCOM
Normal file
BIN
docs/Documentation Tools/IMINDEX.LCOM
Normal file
Binary file not shown.
BIN
docs/Documentation Tools/IMINDEX.TEDIT
Normal file
BIN
docs/Documentation Tools/IMINDEX.TEDIT
Normal file
Binary file not shown.
754
docs/Documentation Tools/IMNAME
Normal file
754
docs/Documentation Tools/IMNAME
Normal file
@ -0,0 +1,754 @@
|
||||
(FILECREATED "14-Jul-86 14:48:47" {ERINYES}<LISPMANUAL>LISP>IMNAME.;2 36556
|
||||
|
||||
changes to: (VARS IMNAMECOMS)
|
||||
(FNS IMNAME.UPDATE.SEND.INFO)
|
||||
|
||||
previous date: "30-Sep-85 13:02:01" {ERINYES}<LISPMANUAL>LISP>IMNAME.;1)
|
||||
|
||||
|
||||
(* Copyright (c) 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
|
||||
|
||||
(PRETTYCOMPRINT IMNAMECOMS)
|
||||
|
||||
(RPAQQ IMNAMECOMS ((FNS DELETE.UNDER.MENUS DISPLAY.UNDER.MENU GET.IM.NAME.LIST IMNAME
|
||||
IMNAME.UPDATE.HASHFILE IMNAME.UPDATE.REF#TOPROG IMNAME.UPDATE.REFS
|
||||
IMNAME.UPDATE.SEND.INFO INSPECT.IM MAKE.IM.INSPECTOR MOVE.UNDER.MENUS
|
||||
OPEN.IM.NAME.HASHFILE REDISPLAY.IM.NAME.MENU REDISPLAY.IM.REF.MENU
|
||||
REDISPLAY.IM.TYPE.MENU SELECT.IM.MENU.ITEM TEDIT.IM.FILE)
|
||||
[INITVARS (IM.NAME.MAX.DISPLAY 5)
|
||||
(IM.NAME.DEFAULT.HASHFILE NIL)
|
||||
(IM.NAME.HASHFILE.ABBREVS (QUOTE ((INTERLISP .
|
||||
{ERINYES}<LISPMANUAL>INTERLISP.IMNAMEHASH)
|
||||
(LOOPS . {INDIGO}<LOOPS>MANUAL>LOOPS.IMNAMEHASH]
|
||||
(FILES HASH)
|
||||
(MACROS IMNAME.RESETSAVE.MOVD)))
|
||||
(DEFINEQ
|
||||
|
||||
(DELETE.UNDER.MENUS
|
||||
[LAMBDA (TOP.MENU.OR.WINDOW) (* mjs "27-OCT-83 10:53")
|
||||
(PROG (TOP.WINDOW UNDER.MENU UNDER.WINDOW)
|
||||
(if [AND (SETQ TOP.WINDOW (if (WINDOWP TOP.MENU.OR.WINDOW)
|
||||
else (WFROMMENU TOP.MENU.OR.WINDOW)))
|
||||
(SETQ UNDER.MENU (WINDOWPROP TOP.WINDOW (QUOTE UNDER.MENU]
|
||||
then (WINDOWPROP TOP.WINDOW (QUOTE UNDER.MENU)
|
||||
NIL)
|
||||
(DELETE.UNDER.MENUS UNDER.MENU)
|
||||
(DELETEMENU UNDER.MENU NIL (SETQ UNDER.WINDOW (WFROMMENU UNDER.MENU)))
|
||||
(CLOSEW UNDER.WINDOW])
|
||||
|
||||
(DISPLAY.UNDER.MENU
|
||||
[LAMBDA (TOP.MENU NEW.MENU) (* mjs "24-Jul-85 15:19")
|
||||
(PROG (NEW.WINDOW (TOP.WINDOW (WFROMMENU TOP.MENU)))
|
||||
(if TOP.WINDOW
|
||||
then (DELETE.UNDER.MENUS TOP.MENU)
|
||||
(SETQ NEW.WINDOW (CREATEW (CREATEREGION (fetch (REGION LEFT)
|
||||
of (WINDOWPROP TOP.WINDOW (QUOTE REGION)
|
||||
))
|
||||
(IDIFFERENCE (fetch (REGION BOTTOM)
|
||||
of (WINDOWPROP
|
||||
TOP.WINDOW
|
||||
(QUOTE REGION)))
|
||||
(fetch (MENU IMAGEHEIGHT)
|
||||
of NEW.MENU))
|
||||
(fetch (MENU IMAGEWIDTH) of NEW.MENU)
|
||||
(fetch (MENU IMAGEHEIGHT) of NEW.MENU))
|
||||
NIL 0))
|
||||
(WINDOWPROP NEW.WINDOW (QUOTE UNDER.MENU)
|
||||
NIL)
|
||||
(ADDMENU NEW.MENU NEW.WINDOW)
|
||||
(WINDOWADDPROP NEW.WINDOW (QUOTE CLOSEFN)
|
||||
(FUNCTION DELETE.UNDER.MENUS))
|
||||
(WINDOWADDPROP NEW.WINDOW (QUOTE MOVEFN)
|
||||
(FUNCTION MOVE.UNDER.MENUS))
|
||||
(WINDOWPROP TOP.WINDOW (QUOTE UNDER.MENU)
|
||||
NEW.MENU)
|
||||
else (MENU NEW.MENU])
|
||||
|
||||
(GET.IM.NAME.LIST
|
||||
[LAMBDA (HASHFILE.NAME) (* mjs "16-Dec-83 14:34")
|
||||
(PROG (NAME.LIST HASHFILE.PTR)
|
||||
(SETQ HASHFILE.PTR (OPEN.IM.NAME.HASHFILE HASHFILE.NAME))
|
||||
(if (NULL HASHFILE.PTR)
|
||||
then (RETURN))
|
||||
(SETQ NAME.LIST (GETHASHFILE (QUOTE namelist)
|
||||
HASHFILE.PTR))
|
||||
(CLOSEHASHFILE HASHFILE.PTR)
|
||||
(RETURN NAME.LIST])
|
||||
|
||||
(IMNAME
|
||||
[LAMBDA (HASHFILE.NAME) (* mjs "15-Jan-84 17:22")
|
||||
(MAKE.IM.INSPECTOR HASHFILE.NAME])
|
||||
|
||||
(IMNAME.UPDATE.HASHFILE
|
||||
[LAMBDA (OLD.HASHFILE.NAME ADD.FILES DELETE.FILES FLUSH.DISAPPEARED.FLG)
|
||||
(* mjs "29-Sep-85 14:08")
|
||||
|
||||
(* * this function updates an IMNAME database hashfile. First, it looks at the list of files referenced in the
|
||||
hashfile <saved under the hash name "file/date/info" >, and determines which of these files have been updated, by
|
||||
searching for the files, and checking creation dates. Next, for every updated file, IMTRAN is called with several of
|
||||
its subprocedures modified so it will not output anything, and only put index information into an in-core hasharray.
|
||||
Finally, the entries in the old hashfile are read in, merged with info from the in-core hasharray, and written out
|
||||
to a new hashfile.)
|
||||
|
||||
|
||||
|
||||
(* * OLD.HASHFILE.NAME is the name of the hashfile to be updated. <Note that this file must be named explicitely ---
|
||||
no file searches are done, so that the user will not inadvertantly start updating the main manual database>.
|
||||
The new hashfile will be created as the new version of the same file name. ADD.FILES is a list of files that will be
|
||||
analyzed, and added to the database. DELETE.FILES is a list of files that will be deleted from the database.
|
||||
ADD.FILES and DELETE.FILES can be used to "manage" a database, as new files are added to a document, and old ones
|
||||
are removed, split up,or renamed. FLUSH.DISAPPEARED.FLG determines what IMNAME.UPDATE.HASHFILE will do if it finds
|
||||
that some of the files in the database have disappeared <and they are not named on DELETE.FILES>.
|
||||
If FLUSH.DISAPPEARED.FLG = T, the info for those files will simply be deleted. If FLUSH.DISAPPEARED.FLG = ERROR,
|
||||
IMNAME.UPDATE.HASHFILE will return without doing anything if files have disappeared. If FLUSH.DISAPPEARED.FLG =
|
||||
<anything else>, the info on the disappeared files will simply be retained.)
|
||||
|
||||
|
||||
|
||||
(* * to create a new IMNAME hashfile, pass a non-existant file name as OLD.HASHFILE.NAME, and give a list of files
|
||||
as ADD.FILES. In this case, a new hashfile will be created just from the internal hasharray info.)
|
||||
|
||||
|
||||
(PROG ((DISAPPEARED.IM.FILES NIL)
|
||||
(REDO.IM.FILE.NAMES NIL)
|
||||
(FLUSH.FILES NIL)
|
||||
(OLD.HASHFILE NIL)
|
||||
(OLD.IM.NAME.LIST NIL)
|
||||
(OLD.IM.FILE.INFO NIL)
|
||||
(OLD.IM.FILE.NAMES NIL)
|
||||
NEW.HASHFILE.NAME NEW.HASHFILE NEW.IM.NAME.LIST NEW.IM.FILE.NAMES NEW.IM.FILE.INFO
|
||||
NEW.IM.HASH DELETE.FILE.NAMES ERRFILE ERRFILE.NAME)
|
||||
(DECLARE (SPECVARS ERRFILE ERRFILE.NAME)) (* make sure that IMTRAN is loaded, so that we can
|
||||
analyze updated files.)
|
||||
(FILESLOAD IMTRAN) (* U-CASE all file names, because we will be comparing
|
||||
them to database file names)
|
||||
(SETQ OLD.HASHFILE.NAME (U-CASE OLD.HASHFILE.NAME))
|
||||
(SETQ ADD.FILES (U-CASE ADD.FILES))
|
||||
(SETQ DELETE.FILES (U-CASE DELETE.FILES))
|
||||
(SETQ NEW.HASHFILE.NAME (PACKFILENAME (QUOTE VERSION)
|
||||
NIL
|
||||
(QUOTE BODY)
|
||||
OLD.HASHFILE.NAME))
|
||||
(SETQ ERRFILE.NAME (PACKFILENAME (QUOTE EXTENSION)
|
||||
(QUOTE IMERR)
|
||||
(QUOTE BODY)
|
||||
NEW.HASHFILE.NAME))
|
||||
[if (INFILEP OLD.HASHFILE.NAME)
|
||||
then (* if old hashfile exists, open it and get namelist and
|
||||
filelist)
|
||||
(IM.WARNING "Opening old hashfile " OLD.HASHFILE.NAME)
|
||||
(SETQ OLD.HASHFILE (OPENHASHFILE OLD.HASHFILE.NAME (QUOTE INPUT)))
|
||||
(SETQ OLD.IM.NAME.LIST (GETHASHFILE (QUOTE namelist)
|
||||
OLD.HASHFILE))
|
||||
(SETQ OLD.IM.FILE.INFO (GETHASHFILE (QUOTE fileinfo)
|
||||
OLD.HASHFILE))
|
||||
(SETQ OLD.IM.FILE.NAMES (for X in OLD.IM.FILE.INFO collect (CAR X]
|
||||
(if (NULL OLD.HASHFILE)
|
||||
then (IM.WARNING "Will construct new hashfile named: " NEW.HASHFILE.NAME))
|
||||
(* push on REDO.IM.FILE.NAMES the full names of all
|
||||
files on ADD.FILES that can be found.)
|
||||
(for FILE in ADD.FILES bind COMPLETEFILENAME
|
||||
do (SETQ COMPLETEFILENAME (FINDFILE FILE T))
|
||||
(if COMPLETEFILENAME
|
||||
then [SETQ FILE (PACKFILENAME (QUOTE NAME)
|
||||
(FILENAMEFIELD FILE (QUOTE NAME))
|
||||
(QUOTE EXTENSION)
|
||||
(FILENAMEFIELD FILE (QUOTE EXTENSION]
|
||||
(push REDO.IM.FILE.NAMES FILE)
|
||||
(IM.WARNING "Adding file " COMPLETEFILENAME)
|
||||
(if (MEMB FILE OLD.IM.FILE.NAMES)
|
||||
then (IM.WARNING "(updating version of file in old database)"))
|
||||
else (IM.WARNING "Can't find file " FILE " -- ignored")))
|
||||
(* collect the normal names of all deleted files, minus
|
||||
version numbers)
|
||||
[SETQ DELETE.FILE.NAMES (for FILE in DELETE.FILES collect (PACKFILENAME
|
||||
(QUOTE NAME)
|
||||
(FILENAMEFIELD FILE
|
||||
(QUOTE NAME))
|
||||
(QUOTE EXTENSION)
|
||||
(FILENAMEFIELD FILE
|
||||
(QUOTE EXTENSION]
|
||||
|
||||
(* analyze all of the files referenced in the old hashfile. There are four cases: <1> if the file is on
|
||||
DELETE.FILE.NAMES, all references to it should be flushed; otherwise <2> if the file does not exist, put it on
|
||||
DISAPPEARED.IM.FILES; otherwise <3> if the file DOES exist, but it has a different version number, flush the old
|
||||
version of the file, and reanalyze the new version; otherwise <4> the current version of the file is correct, so you
|
||||
don't have to do anything.)
|
||||
|
||||
|
||||
(for FILE in OLD.IM.FILE.NAMES bind STANDARD.FILE.NAME LATEST.VERSION.FILE
|
||||
do (if (MEMB FILE DELETE.FILE.NAMES)
|
||||
then (* if the file is on DELETE.FILE.NAMES, just flush it)
|
||||
(IM.WARNING "will delete info for: " FILE)
|
||||
(push FLUSH.FILES FILE)
|
||||
elseif (MEMB FILE REDO.IM.FILE.NAMES)
|
||||
then (* if an old file is already on the list to redo, flush
|
||||
it immediately. It must have been an added file)
|
||||
(push FLUSH.FILES FILE)
|
||||
elseif (NULL (SETQ LATEST.VERSION.FILE (FINDFILE FILE T)))
|
||||
then (* if this file does not exist, put it on
|
||||
DISAPPEARED.IM.FILES)
|
||||
(IM.WARNING "can't find old file " FILE)
|
||||
(push DISAPPEARED.IM.FILES FILE)
|
||||
elseif [NOT (EQUAL (GETFILEINFO LATEST.VERSION.FILE (QUOTE CREATIONDATE))
|
||||
(CDR (ASSOC FILE OLD.IM.FILE.INFO]
|
||||
then (* if this file DOES exist, but it has a different
|
||||
creationdate, flush the old version of the file, and
|
||||
reanalyze the new version)
|
||||
(IM.WARNING "old file " FILE " has been updated -- will re-analyze"
|
||||
" [author="
|
||||
(GETFILEINFO LATEST.VERSION.FILE (QUOTE AUTHOR))
|
||||
" , date="
|
||||
(GETFILEINFO LATEST.VERSION.FILE (QUOTE CREATIONDATE))
|
||||
"]")
|
||||
(push FLUSH.FILES FILE)
|
||||
(push REDO.IM.FILE.NAMES FILE)))
|
||||
|
||||
(* if any files referenced in the old hashfile have disappeared, take different actions depending on
|
||||
FLUSH.DISAPPEARED.FLG: If FLUSH.DISAPPEARED.FLG = T, just flush the file info. If FLUSH.DISAPPEARED.FLG = ERROR,
|
||||
close the hashfile and stop the program. Otherwise, just leave the disappeared file info intact.)
|
||||
|
||||
|
||||
(if DISAPPEARED.IM.FILES
|
||||
then (IM.WARNING "the following files have disappeared: " DISAPPEARED.IM.FILES)
|
||||
(SELECTQ FLUSH.DISAPPEARED.FLG
|
||||
(T (IM.WARNING "Will delete info for disappeared files")
|
||||
(SETQ FLUSH.FILES (APPEND DISAPPEARED.IM.FILES FLUSH.FILES)))
|
||||
(ERROR (IM.WARNING "--- returning ---")
|
||||
(CLOSEHASHFILE OLD.HASHFILE)
|
||||
(if (OPENP ERRFILE)
|
||||
then (CLOSEF ERRFILE)
|
||||
(IM.WARNING T "IMTRAN Error File: " (FULLNAME ERRFILE)
|
||||
T))
|
||||
(RETURN))
|
||||
(IM.WARNING "Will keep info for disappeared files")))
|
||||
(* initialize new file list and name list, and in-core
|
||||
hasharray for re-analyzed file info)
|
||||
(SETQ NEW.IM.FILE.NAMES (LDIFFERENCE OLD.IM.FILE.NAMES FLUSH.FILES))
|
||||
(SETQ NEW.IM.FILE.INFO (for X in OLD.IM.FILE.INFO when (MEMB (CAR X)
|
||||
NEW.IM.FILE.NAMES)
|
||||
collect X))
|
||||
(SETQ NEW.IM.NAME.LIST NIL)
|
||||
(SETQ NEW.IM.HASH (HASHARRAY 2000))
|
||||
|
||||
(* * analyze updated IM files, by running each one through IMTRAN)
|
||||
|
||||
|
||||
(RESETLST (* make sure that IMTRAN does not dump anything, or
|
||||
include any files.)
|
||||
(IMNAME.RESETSAVE.MOVD (FUNCTION NILL)
|
||||
(FUNCTION DUMP))
|
||||
(IMNAME.RESETSAVE.MOVD (FUNCTION NILL)
|
||||
(FUNCTION INCLUDE.FILE))
|
||||
(* use modified SEND.INFO program that will dump info
|
||||
in in-core hasharray)
|
||||
(IMNAME.RESETSAVE.MOVD (FUNCTION IMNAME.UPDATE.SEND.INFO)
|
||||
(FUNCTION SEND.INFO))
|
||||
(IMNAME.RESETSAVE.MOVD (FUNCTION IMNAME.UPDATE.REF#TOPROG)
|
||||
(FUNCTION REF#TOPROG))
|
||||
(PROG ((IMNAME.UPDATE.SEND.INFO.HASH NEW.IM.HASH)
|
||||
(IMNAME.UPDATE.SEND.INFO.NEW.WORDS NIL)
|
||||
IMNAME.UPDATE.SEND.INFO.FILENAME)
|
||||
(DECLARE (SPECVARS UPDATE.SEND.INFO.HASH UPDATE.SEND.INFO.FILENAME))
|
||||
|
||||
(* the single file ERRFILE is used to save error messages from all invokations of IMTRAN. UPDATE.SEND.INFO.HASH and
|
||||
UPDATE.SEND.INFO.FILENAME are SPECVARS used to communicate with the special version of SEND.INFO which puts index
|
||||
info in the in-core hash array)
|
||||
|
||||
|
||||
(for FILE in REDO.IM.FILE.NAMES bind COMPLETE.FILE.NAME
|
||||
do (SETQ COMPLETE.FILE.NAME (FINDFILE FILE T))
|
||||
(if (NULL COMPLETE.FILE.NAME)
|
||||
then (SHOULDNT "Could find file before, but not now"))
|
||||
(IM.WARNING "Retranslating file: " COMPLETE.FILE.NAME)
|
||||
(push NEW.IM.FILE.NAMES FILE)
|
||||
[push NEW.IM.FILE.INFO (CONS FILE (GETFILEINFO FILE (QUOTE
|
||||
CREATIONDATE]
|
||||
(* UPDATE.SEND.INFO.FILENAME is the file name in a
|
||||
standard format <name and ext only>)
|
||||
(SETQ IMNAME.UPDATE.SEND.INFO.FILENAME FILE)
|
||||
(PROG ((GLOBAL.CHAPTER.NUMBER 0)
|
||||
(IM.NOTE.FLG NIL)
|
||||
(IM.REF.FLG NIL)
|
||||
(IM.INDEX.FILE.FLG T))
|
||||
(DECLARE (SPECVARS GLOBAL.CHAPTER.NUMBER IM.NOTE.FLG IM.REF.FLG
|
||||
IM.INDEX.FILE.FLG))
|
||||
(IMTRAN COMPLETE.FILE.NAME)))
|
||||
(* set new word list to all words collected while
|
||||
reanalyzing files)
|
||||
(SETQ NEW.IM.NAME.LIST IMNAME.UPDATE.SEND.INFO.NEW.WORDS)))
|
||||
(SETQ NEW.IM.NAME.LIST (UNION NEW.IM.NAME.LIST OLD.IM.NAME.LIST))
|
||||
[SETQ NEW.HASHFILE (CREATEHASHFILE NEW.HASHFILE.NAME NIL NIL (TIMES 1.3 (LENGTH
|
||||
NEW.IM.NAME.LIST]
|
||||
(for NAM in NEW.IM.NAME.LIST bind NEW.REFS (FLUSH.IM.NAMES _ NIL)
|
||||
do (if (SETQ NEW.REFS (IMNAME.UPDATE.REFS (if OLD.HASHFILE
|
||||
then (GETHASHFILE NAM OLD.HASHFILE)
|
||||
else NIL)
|
||||
(GETHASH NAM NEW.IM.HASH)
|
||||
FLUSH.FILES))
|
||||
then (PUTHASHFILE NAM NEW.REFS NEW.HASHFILE)
|
||||
else (push FLUSH.IM.NAMES NAM))
|
||||
finally (SETQ NEW.IM.NAME.LIST (LDIFFERENCE NEW.IM.NAME.LIST FLUSH.IM.NAMES)))
|
||||
(PUTHASHFILE (QUOTE namelist)
|
||||
NEW.IM.NAME.LIST NEW.HASHFILE)
|
||||
(PUTHASHFILE (QUOTE fileinfo)
|
||||
NEW.IM.FILE.INFO NEW.HASHFILE)
|
||||
(if OLD.HASHFILE
|
||||
then (CLOSEHASHFILE OLD.HASHFILE))
|
||||
(CLOSEHASHFILE NEW.HASHFILE)
|
||||
(if (OPENP ERRFILE)
|
||||
then (IM.WARNING "IMTRAN Error File: " (FULLNAME ERRFILE))
|
||||
(CLOSEF ERRFILE))
|
||||
(RETURN NEW.HASHFILE.NAME])
|
||||
|
||||
(IMNAME.UPDATE.REF#TOPROG
|
||||
[LAMBDA NIL (* mjs "30-Sep-85 13:01")
|
||||
(PROG (FILEPTR SAV REF.STRING TYPE ARGS TEMP NAME TYPE.AS.STRING INFO.WORD NEW.HASH.INFO)
|
||||
(SETQ FILEPTR (GETFILEPTR IM.INFILE))
|
||||
(SETQ SAV (SAVE.ARG))
|
||||
(SETQ TEMP (PARSE.INDEX.SPEC SAV NIL))
|
||||
(if (OR (NULL TEMP)
|
||||
(NULL (CAR TEMP)))
|
||||
then (IM.WARNING "null index --- ignored")
|
||||
(RETURN))
|
||||
(SETQ ARGS (CAR TEMP))
|
||||
[SETQ TYPE (if (EQ TO.NAME (QUOTE FIGUREREF))
|
||||
then (* for FIGUREREF, ignore specified type --- use TAG)
|
||||
(QUOTE TAG)
|
||||
else (U-CASE (CDR TEMP]
|
||||
[SETQ TYPE.AS.STRING (if (NLISTP TYPE)
|
||||
then (MKSTRING (L-CASE TYPE T))
|
||||
else (LIST.TO.STRING (L-CASE TYPE T]
|
||||
[SETQ NAME (U-CASE (MKATOM (LIST.TO.STRING ARGS]
|
||||
(SETQ INFO.WORD (L-CASE TO.NAME T))
|
||||
(SETQ NEW.HASH.INFO (GETHASH NAME IMNAME.UPDATE.SEND.INFO.HASH))
|
||||
(if (NULL NEW.HASH.INFO)
|
||||
then (push IMNAME.UPDATE.SEND.INFO.NEW.WORDS NAME))
|
||||
(PUTHASH NAME (CONS (LIST TYPE.AS.STRING (LIST IMNAME.UPDATE.SEND.INFO.FILENAME INFO.WORD
|
||||
FILEPTR))
|
||||
NEW.HASH.INFO)
|
||||
IMNAME.UPDATE.SEND.INFO.HASH])
|
||||
|
||||
(IMNAME.UPDATE.REFS
|
||||
[LAMBDA (OLD.REFS NEW.REFS FLUSH.FILES) (* mjs "15-Jan-84 17:18")
|
||||
(* merge the refs in OLD.REFS with the refs in NEW.REFS,
|
||||
flushing any references to files on FLUSH.FILES)
|
||||
(PROG [(NEW.REF NIL)
|
||||
(TYPES (for X in OLD.REFS collect (CAR X]
|
||||
(for X in NEW.REFS unless (MEMBER (CAR X)
|
||||
TYPES)
|
||||
do (push TYPES (CAR X)))
|
||||
|
||||
(* * now, TYPES contains a list of all of the types in both the old and new refs)
|
||||
|
||||
|
||||
[for TYPE in TYPES bind OLD.FILEREFS NEW.FILEREFS
|
||||
do (* first, collect file refs from OLD.REFS, flushing
|
||||
files on FLUSH.FILES)
|
||||
(SETQ OLD.FILEREFS (for X in (CDR (SASSOC TYPE OLD.REFS)) unless (MEMB (CAR X)
|
||||
FLUSH.FILES)
|
||||
collect X)) (* next, collect all file refs in NEW.REFS for this
|
||||
type. Note that each ref in NEW.REFS contains exactly
|
||||
one file ref)
|
||||
(* implicite assumption: the files in OLD.REFS and
|
||||
NEW.REFS are completely disjoint)
|
||||
(SETQ NEW.FILEREFS (for X in NEW.REFS when (EQUAL TYPE (CAR X)) collect (CADR X)))
|
||||
[SETQ NEW.FILEREFS (for FILEREFS in (PARTITION.LIST NEW.FILEREFS NIL
|
||||
(FUNCTION CAR))
|
||||
collect (* FILEREFS is a list of the filerefs for a single file)
|
||||
(* sort FILEREFS by file pointers)
|
||||
[SORT FILEREFS (FUNCTION (LAMBDA (A B)
|
||||
(ILESSP (CADDR A)
|
||||
(CADDR B]
|
||||
(* put all of the file refs in one list, headed by the
|
||||
file name)
|
||||
(CONS (CAAR FILEREFS)
|
||||
(for X in FILEREFS join (CDR X]
|
||||
(SETQ NEW.FILEREFS (SORT (NCONC NEW.FILEREFS OLD.FILEREFS)
|
||||
T))
|
||||
(if NEW.FILEREFS
|
||||
then (SETQ NEW.REF (CONS (CONS TYPE NEW.FILEREFS)
|
||||
NEW.REF] (* finally, sort all of the references by type)
|
||||
(RETURN (SORT NEW.REF T])
|
||||
|
||||
(IMNAME.UPDATE.SEND.INFO
|
||||
[LAMBDA (NAME TYPE SAV INFO PLIST) (* mjs "14-Jul-86 14:42")
|
||||
|
||||
(* * substitute version of SEND.INFO that puts index info into IMNAME.UPDATE.SEND.INFO.HASH instead of spitting out
|
||||
an index object.)
|
||||
|
||||
|
||||
(PROG ((FILEPTR (GETFILEPTR IM.INFILE))
|
||||
(INFO.WORD (if (MEMB (QUOTE *PRIMARY*)
|
||||
INFO)
|
||||
then (QUOTE Primary)
|
||||
elseif (MEMB (QUOTE *DEF*)
|
||||
INFO)
|
||||
then (QUOTE Definition)
|
||||
else NIL))
|
||||
[TYPE.AS.STRING (if (NLISTP TYPE)
|
||||
then (MKSTRING (L-CASE TYPE T))
|
||||
else (LIST.TO.STRING (L-CASE TYPE T]
|
||||
(NEW.HASH.INFO (GETHASH NAME IMNAME.UPDATE.SEND.INFO.HASH)))
|
||||
|
||||
(* * pack index subentries and subsubentries)
|
||||
|
||||
|
||||
(if (LISTGET PLIST (QUOTE SUBNAME))
|
||||
then (if (LISTGET PLIST (QUOTE SUBSUBNAME))
|
||||
then (SETQ INFO.WORD (PACK* " -> " (LISTGET PLIST (QUOTE
|
||||
SUBSUBNAME))
|
||||
"/"
|
||||
(LISTGET PLIST (QUOTE SUBSUBTYPE))
|
||||
"/" INFO.WORD)))
|
||||
(SETQ INFO.WORD (PACK* "sub -> " (LISTGET PLIST (QUOTE SUBNAME))
|
||||
"/"
|
||||
(LISTGET PLIST (QUOTE SUBTYPE))
|
||||
"/" INFO.WORD)))
|
||||
(if (MEMB (QUOTE *BEGIN*)
|
||||
INFO)
|
||||
then (SETQ INFO.WORD (PACK* INFO.WORD "/begin")))
|
||||
(if (MEMB (QUOTE *END*)
|
||||
INFO)
|
||||
then (SETQ INFO.WORD (PACK* INFO.WORD "/end")))
|
||||
(if (NULL NEW.HASH.INFO)
|
||||
then (push IMNAME.UPDATE.SEND.INFO.NEW.WORDS NAME))
|
||||
(PUTHASH NAME (CONS (LIST TYPE.AS.STRING (LIST IMNAME.UPDATE.SEND.INFO.FILENAME
|
||||
INFO.WORD FILEPTR))
|
||||
NEW.HASH.INFO)
|
||||
IMNAME.UPDATE.SEND.INFO.HASH])
|
||||
|
||||
(INSPECT.IM
|
||||
[LAMBDA (NAM HASHFILE.NAME) (* mjs "27-OCT-83 18:54")
|
||||
(PROG (REFS HASHFILE.PTR HASHFILE.DEFAULT.DIRECTORY TYP FILE.POS.PTR)
|
||||
(SETQ HASHFILE.PTR (OPEN.IM.NAME.HASHFILE HASHFILE.NAME))
|
||||
(if (NULL HASHFILE.PTR)
|
||||
then (RETURN))
|
||||
[SETQ HASHFILE.DEFAULT.DIRECTORY (PACKFILENAME (QUOTE HOST)
|
||||
(FILENAMEFIELD (HASHFILENAME HASHFILE.PTR)
|
||||
(QUOTE HOST))
|
||||
(QUOTE DIRECTORY)
|
||||
(FILENAMEFIELD (HASHFILENAME HASHFILE.PTR)
|
||||
(QUOTE DIRECTORY]
|
||||
(SETQ REFS (GETHASHFILE (U-CASE NAM)
|
||||
HASHFILE.PTR))
|
||||
(CLOSEHASHFILE HASHFILE.PTR)
|
||||
(if (NULL REFS)
|
||||
then (CLRPROMPT)
|
||||
(PROMPTPRINT (CONCAT NAM " has no references"))
|
||||
(RETURN))
|
||||
(REDISPLAY.IM.TYPE.MENU NIL (LIST NAM HASHFILE.DEFAULT.DIRECTORY REFS])
|
||||
|
||||
(MAKE.IM.INSPECTOR
|
||||
[LAMBDA (HASHFILE.NAME MENU.REGION) (* mjs "24-Jul-85 16:55")
|
||||
(PROG (HASHFILE.PTR HASHFILE.WINDOW.STRING HASHFILE.DEFAULT.DIRECTORY WINDOW MENU)
|
||||
(SETQ HASHFILE.PTR (OPEN.IM.NAME.HASHFILE HASHFILE.NAME))
|
||||
(if (NULL HASHFILE.PTR)
|
||||
then (RETURN))
|
||||
[SETQ HASHFILE.WINDOW.STRING (U-CASE (FILENAMEFIELD (HASHFILENAME HASHFILE.PTR)
|
||||
(QUOTE NAME]
|
||||
[SETQ HASHFILE.DEFAULT.DIRECTORY (PACKFILENAME (QUOTE HOST)
|
||||
(FILENAMEFIELD (HASHFILENAME HASHFILE.PTR)
|
||||
(QUOTE HOST))
|
||||
(QUOTE DIRECTORY)
|
||||
(FILENAMEFIELD (HASHFILENAME HASHFILE.PTR)
|
||||
(QUOTE DIRECTORY]
|
||||
(SETQ WINDOW (CREATEW (if MENU.REGION
|
||||
else (GETBOXREGION 106 37 NIL NIL NIL (CONCAT
|
||||
"Please position the IM Name Inspector Window for "
|
||||
|
||||
HASHFILE.WINDOW.STRING)))
|
||||
NIL 0))
|
||||
(WINDOWPROP WINDOW (QUOTE UNDER.MENU)
|
||||
NIL)
|
||||
(WINDOWPROP WINDOW (QUOTE IM.NAME.ASSOC)
|
||||
NIL)
|
||||
(WINDOWPROP WINDOW (QUOTE IM.NAME.HASHFILE)
|
||||
HASHFILE.PTR)
|
||||
(WINDOWPROP WINDOW (QUOTE IM.NAME.HASHFILE.WINDOW.STRING)
|
||||
HASHFILE.WINDOW.STRING)
|
||||
(WINDOWPROP WINDOW (QUOTE IM.NAME.DEFAULT.DIRECTORY)
|
||||
HASHFILE.DEFAULT.DIRECTORY)
|
||||
[WINDOWADDPROP WINDOW (QUOTE CLOSEFN)
|
||||
(FUNCTION (LAMBDA (WINDOW)
|
||||
(CLOSEHASHFILE (WINDOWPROP WINDOW (QUOTE IM.NAME.HASHFILE]
|
||||
(WINDOWADDPROP WINDOW (QUOTE CLOSEFN)
|
||||
(FUNCTION DELETE.UNDER.MENUS))
|
||||
(WINDOWADDPROP WINDOW (QUOTE MOVEFN)
|
||||
(FUNCTION MOVE.UNDER.MENUS))
|
||||
(SETQ MENU (create MENU))
|
||||
(ADDMENU MENU WINDOW)
|
||||
(REDISPLAY.IM.NAME.MENU MENU])
|
||||
|
||||
(MOVE.UNDER.MENUS
|
||||
[LAMBDA (TOP.MENU.OR.WINDOW NEW.POS) (* mjs "28-OCT-83 13:21")
|
||||
(PROG (TOP.WINDOW UNDER.MENU UNDER.WINDOW UNDER.WINDOW.NEW.POS)
|
||||
(COND
|
||||
([AND (SETQ TOP.WINDOW (if (WINDOWP TOP.MENU.OR.WINDOW)
|
||||
else (WFROMMENU TOP.MENU.OR.WINDOW)))
|
||||
(SETQ UNDER.MENU (WINDOWPROP TOP.WINDOW (QUOTE UNDER.MENU]
|
||||
(SETQ UNDER.WINDOW (WFROMMENU UNDER.MENU))
|
||||
[SETQ UNDER.WINDOW.NEW.POS (create POSITION
|
||||
XCOORD _(fetch (POSITION XCOORD) of NEW.POS)
|
||||
YCOORD _(IDIFFERENCE (fetch (POSITION YCOORD)
|
||||
of NEW.POS)
|
||||
(fetch (REGION HEIGHT)
|
||||
of (WINDOWPROP UNDER.WINDOW
|
||||
(QUOTE REGION]
|
||||
(MOVEW UNDER.WINDOW UNDER.WINDOW.NEW.POS])
|
||||
|
||||
(OPEN.IM.NAME.HASHFILE
|
||||
[LAMBDA (HASHFILE.NAME) (* edited: "11-Jul-84 14:51")
|
||||
(PROG ([DEFAULT.HASHFILE.NAME (if IM.NAME.DEFAULT.HASHFILE
|
||||
elseif (EQ (FILENAMEFIELD LOGINHOST/DIR (QUOTE HOST))
|
||||
(QUOTE IVY))
|
||||
then (CDR (ASSOC (QUOTE LOOPS)
|
||||
IM.NAME.HASHFILE.ABBREVS))
|
||||
else (CDR (ASSOC (QUOTE INTERLISP)
|
||||
IM.NAME.HASHFILE.ABBREVS]
|
||||
(ABBREV.HASHFILE.NAME (CDR (ASSOC HASHFILE.NAME IM.NAME.HASHFILE.ABBREVS)))
|
||||
FULL.HASHFILE.NAME)
|
||||
[SETQ FULL.HASHFILE.NAME (if ABBREV.HASHFILE.NAME
|
||||
elseif (NULL HASHFILE.NAME)
|
||||
then (INFILEP DEFAULT.HASHFILE.NAME)
|
||||
elseif (FINDFILE HASHFILE.NAME T)
|
||||
elseif (FINDFILE (PACKFILENAME (QUOTE BODY)
|
||||
HASHFILE.NAME
|
||||
(QUOTE EXTENSION)
|
||||
(FILENAMEFIELD
|
||||
DEFAULT.HASHFILE.NAME
|
||||
(QUOTE EXTENSION)))
|
||||
T)
|
||||
else (INFILEP (PACKFILENAME (QUOTE BODY)
|
||||
HASHFILE.NAME
|
||||
(QUOTE BODY)
|
||||
DEFAULT.HASHFILE.NAME]
|
||||
(if FULL.HASHFILE.NAME
|
||||
then (printout T "opening data base file " FULL.HASHFILE.NAME T)
|
||||
(RETURN (OPENHASHFILE FULL.HASHFILE.NAME (QUOTE INPUT)))
|
||||
else (printout T "data base file " HASHFILE.NAME " not found" T)
|
||||
(RETURN NIL])
|
||||
|
||||
(REDISPLAY.IM.NAME.MENU
|
||||
[LAMBDA (OLDMENU) (* mjs " 6-Aug-85 14:10")
|
||||
(* updates IM name menu OLDMENU.)
|
||||
(PROG ((WINDOW (WFROMMENU OLDMENU))
|
||||
NAME.ASSOC HASHFILE.PTR HASHFILE.WINDOW.STRING HASHFILE.DEFAULT.DIRECTORY MENU)
|
||||
(SETQ NAME.ASSOC (WINDOWPROP WINDOW (QUOTE IM.NAME.ASSOC)))
|
||||
(SETQ HASHFILE.PTR (WINDOWPROP WINDOW (QUOTE IM.NAME.HASHFILE)))
|
||||
(SETQ HASHFILE.WINDOW.STRING (WINDOWPROP WINDOW (QUOTE IM.NAME.HASHFILE.WINDOW.STRING)))
|
||||
(SETQ HASHFILE.DEFAULT.DIRECTORY (WINDOWPROP WINDOW (QUOTE IM.NAME.DEFAULT.DIRECTORY)))
|
||||
[SETQ MENU
|
||||
(create MENU
|
||||
ITEMS _[PROG [(MENU.ITEMS (for X in NAME.ASSOC as C from 1 to IM.NAME.MAX.DISPLAY
|
||||
collect (LIST (CAR X)
|
||||
(CAR X)
|
||||
"Reselect an old IM name"]
|
||||
(RETURN (CONS HASHFILE.WINDOW.STRING (CONS (QUOTE (Type% an% IM% name
|
||||
|
||||
Type% an% IM% name
|
||||
"The user is prompted to type in a new IM name"))
|
||||
MENU.ITEMS]
|
||||
TITLE _ "IM Name Inspector"
|
||||
MENUBORDERSIZE _ 1
|
||||
WHENSELECTEDFN _(FUNCTION (LAMBDA (ITEM MENU MOUSEKEY)
|
||||
(if (LISTP ITEM)
|
||||
then (SELECT.IM.MENU.ITEM
|
||||
(if (EQ (CADR ITEM)
|
||||
(QUOTE Type% an% IM% name))
|
||||
then (CLRPROMPT)
|
||||
[MKATOM (U-CASE (PROMPTFORWORD "Type an IM name: " NIL
|
||||
"Type a name to be looked up in the Interlisp Manual Index"
|
||||
PROMPTWINDOW NIL NIL
|
||||
(CHARCODE (EOL ESCAPE LF]
|
||||
else (CADR ITEM))
|
||||
MENU]
|
||||
(DELETE.UNDER.MENUS OLDMENU)
|
||||
(DELETEMENU OLDMENU NIL WINDOW)
|
||||
(SHAPEW WINDOW (CREATEREGION (fetch (REGION LEFT) of (WINDOWPROP WINDOW (QUOTE REGION)))
|
||||
(fetch (REGION BOTTOM) of (WINDOWPROP WINDOW (QUOTE REGION)))
|
||||
(fetch (MENU IMAGEWIDTH) of MENU)
|
||||
(fetch (MENU IMAGEHEIGHT) of MENU)))
|
||||
(ADDMENU MENU WINDOW)
|
||||
(SHADEITEM HASHFILE.WINDOW.STRING MENU BLACKSHADE WINDOW)
|
||||
(RETURN MENU])
|
||||
|
||||
(REDISPLAY.IM.REF.MENU
|
||||
[LAMBDA (NAME.OR.TYPE.MENU TYPE.NAME.DIR.REFS) (* mjs "28-OCT-83 11:42")
|
||||
(* TYPE.NAME.DIR.REFS is a list of <selected-type
|
||||
selected-name default-directory refs>)
|
||||
(PROG ((SELECTED.TYPE (CAR TYPE.NAME.DIR.REFS))
|
||||
(SELECTED.NAME (CADR TYPE.NAME.DIR.REFS))
|
||||
(DEFAULT.DIR (CADDR TYPE.NAME.DIR.REFS))
|
||||
(REFS (CADDDR TYPE.NAME.DIR.REFS)))
|
||||
(DISPLAY.UNDER.MENU NAME.OR.TYPE.MENU
|
||||
(create MENU
|
||||
ITEMS _[for PTRS.TO.ONE.FILE in (CDR (ASSOC SELECTED.TYPE REFS))
|
||||
join (CONS (LIST (CONCAT "from: " (CAR
|
||||
PTRS.TO.ONE.FILE))
|
||||
(CONS (PACKFILENAME (QUOTE BODY)
|
||||
(CAR
|
||||
PTRS.TO.ONE.FILE)
|
||||
(QUOTE BODY)
|
||||
DEFAULT.DIR)
|
||||
NIL)
|
||||
|
||||
"creates/finds TEDIT window into the file")
|
||||
(for PTR on (CDR PTRS.TO.ONE.FILE)
|
||||
by (CDDR PTR)
|
||||
collect
|
||||
(LIST (CONCAT (if (CAR PTR)
|
||||
else "index")
|
||||
" ("
|
||||
(CADR PTR)
|
||||
")")
|
||||
(CONS (PACKFILENAME
|
||||
(QUOTE BODY)
|
||||
(CAR PTRS.TO.ONE.FILE)
|
||||
(QUOTE BODY)
|
||||
DEFAULT.DIR)
|
||||
(CADR PTR))
|
||||
|
||||
"creates/finds TEDIT window into the file, and positions the cursor at the selected reference"]
|
||||
TITLE _(CONCAT "Refs for " SELECTED.NAME " (type "
|
||||
SELECTED.TYPE ")")
|
||||
MENUBORDERSIZE _ 1
|
||||
WHENSELECTEDFN _(FUNCTION (LAMBDA (ITEM MENU MOUSEKEY)
|
||||
(if (NLISTP ITEM)
|
||||
then NIL
|
||||
else (TEDIT.IM.FILE (CAR (CADR ITEM))
|
||||
(CDR (CADR ITEM])
|
||||
|
||||
(REDISPLAY.IM.TYPE.MENU
|
||||
[LAMBDA (NAME.MENU NAME.DIR.REFS) (* mjs "27-OCT-83 17:04")
|
||||
(* NAME.DIR.REFS is a list of <selected-name
|
||||
default-directory refs>)
|
||||
(PROG ((NAME.WINDOW (WFROMMENU NAME.MENU))
|
||||
(SELECTED.NAME (CAR NAME.DIR.REFS))
|
||||
(REFS (CADDR NAME.DIR.REFS)))
|
||||
(if (EQLENGTH REFS 1)
|
||||
then (* if only one type, skip type menu)
|
||||
(REDISPLAY.IM.REF.MENU NAME.MENU (CONS (CAAR REFS)
|
||||
NAME.DIR.REFS))
|
||||
else (DISPLAY.UNDER.MENU NAME.MENU (create MENU
|
||||
ITEMS _(for X in REFS
|
||||
collect (LIST (CAR X)
|
||||
NAME.DIR.REFS
|
||||
"Select which type you want the references for"))
|
||||
TITLE _(CONCAT "ref types for '" SELECTED.NAME
|
||||
"'")
|
||||
MENUBORDERSIZE _ 1
|
||||
WHENSELECTEDFN _(FUNCTION (LAMBDA (ITEM MENU
|
||||
MOUSEKEY)
|
||||
(if (NLISTP ITEM)
|
||||
then NIL
|
||||
else (REDISPLAY.IM.REF.MENU
|
||||
MENU
|
||||
(CONS (CAR ITEM)
|
||||
(CADR ITEM])
|
||||
|
||||
(SELECT.IM.MENU.ITEM
|
||||
[LAMBDA (NAM MENU) (* mjs "24-Jul-85 15:19")
|
||||
(PROG (NAME.ASSOC WINDOW NAM.DATA REFS HASHFILE.PTR)
|
||||
(SETQ WINDOW (WFROMMENU MENU))
|
||||
(SETQ NAME.ASSOC (WINDOWPROP WINDOW (QUOTE IM.NAME.ASSOC)))
|
||||
(SETQ HASHFILE.PTR (WINDOWPROP WINDOW (QUOTE IM.NAME.HASHFILE)))
|
||||
(if (EQ NAM (CAR (CAR NAME.ASSOC)))
|
||||
then (* selected first item, so don't need to do any
|
||||
updating)
|
||||
(RETURN))
|
||||
(SETQ NAM.DATA (ASSOC NAM NAME.ASSOC))
|
||||
(if NAM.DATA
|
||||
then (SETQ REFS (CDR NAM.DATA))
|
||||
(SETQ NAME.ASSOC (CONS NAM.DATA (REMOVE NAM.DATA NAME.ASSOC)))
|
||||
else (SETQ REFS (GETHASHFILE (U-CASE NAM)
|
||||
HASHFILE.PTR))
|
||||
(if REFS
|
||||
then (SETQ NAME.ASSOC (CONS (CONS NAM REFS)
|
||||
NAME.ASSOC))
|
||||
else (CLRPROMPT)
|
||||
(PROMPTPRINT (CONCAT NAM " has no references"))
|
||||
(RETURN)))
|
||||
(WINDOWPROP WINDOW (QUOTE IM.NAME.ASSOC)
|
||||
NAME.ASSOC)
|
||||
(SETQ MENU (REDISPLAY.IM.NAME.MENU MENU))
|
||||
(REDISPLAY.IM.TYPE.MENU MENU (LIST NAM (WINDOWPROP WINDOW (QUOTE IM.NAME.DEFAULT.DIRECTORY))
|
||||
REFS])
|
||||
|
||||
(TEDIT.IM.FILE
|
||||
[LAMBDA (IM.FILE.NAME IM.FILE.PTR) (* mjs "24-Jul-85 15:26")
|
||||
(PROG [(TEDIT.TEXT.OBJECT NIL)
|
||||
(NORMAL.FILE.NAME (PACKFILENAME (QUOTE NAME)
|
||||
(FILENAMEFIELD IM.FILE.NAME (QUOTE NAME))
|
||||
(QUOTE EXTENSION)
|
||||
(FILENAMEFIELD IM.FILE.NAME (QUOTE EXTENSION]
|
||||
(if (NULL IM.FILE.NAME)
|
||||
then (RETURN))
|
||||
[for X in (OPENWINDOWS) bind POSS.TOBJ POSS.FILENAME when (SETQ POSS.TOBJ
|
||||
(WINDOWPROP X (QUOTE TEXTOBJ)))
|
||||
repeatuntil TEDIT.TEXT.OBJECT
|
||||
do (SETQ POSS.FILENAME (FULLNAME (fetch (TEXTOBJ TXTFILE) of POSS.TOBJ)))
|
||||
(COND
|
||||
([OR (NOT (LITATOM POSS.FILENAME))
|
||||
(NEQ (FILENAMEFIELD POSS.FILENAME (QUOTE NAME))
|
||||
(FILENAMEFIELD NORMAL.FILE.NAME (QUOTE NAME)))
|
||||
(NEQ (FILENAMEFIELD POSS.FILENAME (QUOTE EXTENSION))
|
||||
(FILENAMEFIELD NORMAL.FILE.NAME (QUOTE EXTENSION]
|
||||
(SETQ TEDIT.TEXT.OBJECT NIL))
|
||||
(T (SETQ TEDIT.TEXT.OBJECT POSS.TOBJ]
|
||||
(if TEDIT.TEXT.OBJECT
|
||||
then (if IM.FILE.PTR
|
||||
then (TEDIT.SETSEL TEDIT.TEXT.OBJECT (IMAX 1 (IDIFFERENCE (ADD1 IM.FILE.PTR)
|
||||
25))
|
||||
0
|
||||
(QUOTE LEFT))
|
||||
(TEDIT.NORMALIZECARET TEDIT.TEXT.OBJECT)
|
||||
(TEDIT.SETSEL TEDIT.TEXT.OBJECT (ADD1 IM.FILE.PTR)
|
||||
0
|
||||
(QUOTE LEFT))
|
||||
(TEDIT.NORMALIZECARET TEDIT.TEXT.OBJECT))
|
||||
(TTY.PROCESS (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of TEDIT.TEXT.OBJECT))
|
||||
(QUOTE PROCESS)))
|
||||
else (PROG [(FULL.FILE.NAME (if (FINDFILE NORMAL.FILE.NAME T)
|
||||
else (INFILEP IM.FILE.NAME]
|
||||
(if (NULL FULL.FILE.NAME)
|
||||
then (CLRPROMPT)
|
||||
(printout PROMPTWINDOW NORMAL.FILE.NAME " not found" T)
|
||||
(RETURN))
|
||||
(CLRPROMPT)
|
||||
(printout PROMPTWINDOW "Please specify a TEDIT window for " FULL.FILE.NAME T)
|
||||
(TEDIT FULL.FILE.NAME NIL NIL (if IM.FILE.PTR
|
||||
then (LIST (QUOTE SEL)
|
||||
(ADD1 IM.FILE.PTR))
|
||||
else NIL])
|
||||
)
|
||||
|
||||
(RPAQ? IM.NAME.MAX.DISPLAY 5)
|
||||
|
||||
(RPAQ? IM.NAME.DEFAULT.HASHFILE NIL)
|
||||
|
||||
(RPAQ? IM.NAME.HASHFILE.ABBREVS (QUOTE ((INTERLISP . {ERINYES}<LISPMANUAL>INTERLISP.IMNAMEHASH)
|
||||
(LOOPS . {INDIGO}<LOOPS>MANUAL>LOOPS.IMNAMEHASH))))
|
||||
(FILESLOAD HASH)
|
||||
(DECLARE: EVAL@COMPILE
|
||||
[PUTPROPS IMNAME.RESETSAVE.MOVD MACRO (X (BQUOTE (RESETSAVE (MOVD , (CAR X)
|
||||
,
|
||||
(CADR X)
|
||||
,
|
||||
(CADDR X))
|
||||
(LIST (QUOTE [LAMBDA (FN DEF)
|
||||
(PUTD FN DEF])
|
||||
,
|
||||
(CADR X)
|
||||
(GETD , (CADR X]
|
||||
)
|
||||
(PUTPROPS IMNAME COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986))
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL (1013 35919 (DELETE.UNDER.MENUS 1023 . 1595) (DISPLAY.UNDER.MENU 1597 . 2782) (
|
||||
GET.IM.NAME.LIST 2784 . 3218) (IMNAME 3220 . 3365) (IMNAME.UPDATE.HASHFILE 3367 . 16148) (
|
||||
IMNAME.UPDATE.REF#TOPROG 16150 . 17634) (IMNAME.UPDATE.REFS 17636 . 19950) (IMNAME.UPDATE.SEND.INFO
|
||||
19952 . 21829) (INSPECT.IM 21831 . 22714) (MAKE.IM.INSPECTOR 22716 . 24663) (MOVE.UNDER.MENUS 24665 .
|
||||
25447) (OPEN.IM.NAME.HASHFILE 25449 . 26834) (REDISPLAY.IM.NAME.MENU 26836 . 29208) (
|
||||
REDISPLAY.IM.REF.MENU 29210 . 31019) (REDISPLAY.IM.TYPE.MENU 31021 . 32234) (SELECT.IM.MENU.ITEM 32236
|
||||
. 33632) (TEDIT.IM.FILE 33634 . 35917)))))
|
||||
STOP
|
||||
BIN
docs/Documentation Tools/IMNAME.LCOM
Normal file
BIN
docs/Documentation Tools/IMNAME.LCOM
Normal file
Binary file not shown.
1
docs/Documentation Tools/IMNAME.TEDIT
Normal file
1
docs/Documentation Tools/IMNAME.TEDIT
Normal file
File diff suppressed because one or more lines are too long
2434
docs/Documentation Tools/IMTEDIT
Normal file
2434
docs/Documentation Tools/IMTEDIT
Normal file
File diff suppressed because it is too large
Load Diff
BIN
docs/Documentation Tools/IMTEDIT.LCOM
Normal file
BIN
docs/Documentation Tools/IMTEDIT.LCOM
Normal file
Binary file not shown.
BIN
docs/Documentation Tools/IMTEDIT.TEDIT
Normal file
BIN
docs/Documentation Tools/IMTEDIT.TEDIT
Normal file
Binary file not shown.
1041
docs/Documentation Tools/IMTOOLS
Normal file
1041
docs/Documentation Tools/IMTOOLS
Normal file
File diff suppressed because it is too large
Load Diff
BIN
docs/Documentation Tools/IMTOOLS.LCOM
Normal file
BIN
docs/Documentation Tools/IMTOOLS.LCOM
Normal file
Binary file not shown.
1270
docs/Documentation Tools/IMTRAN
Normal file
1270
docs/Documentation Tools/IMTRAN
Normal file
File diff suppressed because it is too large
Load Diff
BIN
docs/Documentation Tools/IMTRAN.LCOM
Normal file
BIN
docs/Documentation Tools/IMTRAN.LCOM
Normal file
Binary file not shown.
BIN
docs/Documentation Tools/INDEX-FORMAT.TEDIT
Normal file
BIN
docs/Documentation Tools/INDEX-FORMAT.TEDIT
Normal file
Binary file not shown.
2
docs/Documentation Tools/NONAME.IMPTR
Normal file
2
docs/Documentation Tools/NONAME.IMPTR
Normal file
@ -0,0 +1,2 @@
|
||||
(ASDF NIL NIL NIL ("1") 1)
|
||||
(ASDF NIL NIL NIL ("A") 2)
|
||||
Loading…
x
Reference in New Issue
Block a user