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
@@ -1,658 +0,0 @@
|
||||
(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
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,754 +0,0 @@
|
||||
(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
|
||||
Binary file not shown.
File diff suppressed because one or more lines are too long
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
Reference in New Issue
Block a user