diff --git a/docs/Documentation Tools/IMINDEX b/docs/Documentation Tools/IMINDEX
new file mode 100644
index 00000000..1e96d387
--- /dev/null
+++ b/docs/Documentation Tools/IMINDEX	
@@ -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
diff --git a/docs/Documentation Tools/IMINDEX.LCOM b/docs/Documentation Tools/IMINDEX.LCOM
new file mode 100644
index 00000000..02a963a9
Binary files /dev/null and b/docs/Documentation Tools/IMINDEX.LCOM differ
diff --git a/docs/Documentation Tools/IMINDEX.TEDIT b/docs/Documentation Tools/IMINDEX.TEDIT
new file mode 100644
index 00000000..956a1f05
Binary files /dev/null and b/docs/Documentation Tools/IMINDEX.TEDIT differ
diff --git a/docs/Documentation Tools/IMNAME b/docs/Documentation Tools/IMNAME
new file mode 100644
index 00000000..026d1318
--- /dev/null
+++ b/docs/Documentation Tools/IMNAME	
@@ -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
diff --git a/docs/Documentation Tools/IMNAME.LCOM b/docs/Documentation Tools/IMNAME.LCOM
new file mode 100644
index 00000000..3a20b04b
Binary files /dev/null and b/docs/Documentation Tools/IMNAME.LCOM differ
diff --git a/docs/Documentation Tools/IMNAME.TEDIT b/docs/Documentation Tools/IMNAME.TEDIT
new file mode 100644
index 00000000..2fa7cb58
--- /dev/null
+++ b/docs/Documentation Tools/IMNAME.TEDIT	
@@ -0,0 +1 @@
+
author:  Michael Sannella
file:  {Phylum}<LispUsers>IMNAME. (& .DCOM)
loads file:  {Phylum}<LispUsers>HASH.DCOM
loads file:  {Phylum}<LispUsers>IMTRAN.DCOM [loaded by IMNAME.UPDATE.HASHFILE]


******  The IMNAME Database Package  *****

IM format is the text formatting language that the Interlisp Reference Manual is represented in.  It is somewhat like TEX source code, in that there are keywords, and brackets are used to delimit text.  However, IM format was specifically designed for representing the Interlisp Manual, so the "text objects" used are semantically meaningful objects within the manual, such as "function definition", "lisp code", "subsection".

IMNAME is a package designed to help people who may frequently need to modify IM format files.  Usually, a large document (such as the Interlisp Manual) is stored in a number of seperate files, and it is difficult to know which file contains a particular piece of information.  IMNAME contains functions for analyzing a set of IM format files and building a database of "IM Names" (functions, variables, property names, etc) with pointers to the files where they are defined.  Using this database, other functions allow the user to specify an IM name, and bring up a Tedit window on the appropriate file, with the cursor positioned at the right place.  This tool has been very helpful to the people updating the Interlisp Reference Manual.


******  Using IMNAME to access IM format files.  *****

The normal way of using an IMNAME database is by creating an "IM name inspector".  This can be done using either of the following two functions:

(MAKE.IM.INSPECTOR hashFileName)
or
(IMNAME hashFileName)

hashFileName should be the name of the IMNAME database hashfile to use for this inspector.  One can create multiple IM name inspectors point to the same hashfile, or to different hashfiles.  Currently, I know of only two IMNAME hashfiles; the one for the Interlisp Manual and one for the Loops Manual.  If hashFileName is the atom INTERLISP or LOOPS, this Inspector will point to the appropriate hashfile.  If hashFileName is ommitted, it will assume that the Interlisp Manual hashfile is desired for people whose default host is Phylum, and the Loops Manual for people on Ivy.  (Other people can set up their own default IMNAME hashfile by setting the global variable IM.NAME.DEFAULT.HASHFILE).

MAKE.IM.INSPECTOR sets up an "IM Inspector Window", which contains a menu.  Initially, this contains the single selection "Type an IM name", which (when buttoned) prompts the user to type a name which will be looked up in the database.  If an IM name is found in the hashfile, another window will appear below the first one, containing all of the "types" that the given name is known by.  For example, a name may be known as both a variable and a function.  If one of these types is selected, a third menu will apear below the second, listing references to the name in different files.  Selecting one of the references will move the cursor in a TEDIT window (if there exists an active TEDIT window to the appropriate file), or create a new TEDIT window to the file.  [Note:  If a name is only known to be of one type, the "type menu" step is ommitted.]

Other functions:

(INSPECT.IM imname hashFileName)
This allows the searching for a single IM name, using several pop-up menus.  In general, it is easier to use the IM name inspector.

(GET.IM.NAME.LIST hashFileName)
Returns a list of all of the IM names known within the specified hashFileName.


******  Updating an IMNAME database.  *****

IMNAME works by referencing a hashfile database containing IM names and pointers to files where these names are referenced.  As a set of files is modified, this information will become obsolete.  In particular, simply adding a few characters to a file will invalidate all pointers to positons later in the file.  This can be tolorated for awhile (it is rare that IM format files will be changed enough such that the pointers are totally off), but eventually, it is necessary to update the IMNAME database, using the following function:

(IMNAME.UPDATE.HASHFILE oldHashFileName addFileList deleteFileList flushDisappearedFlg )

This function updates an IMNAME database hashfile.  First, it looks at the list of files referenced in the hashfile, and determines which of these files have been updated, by comparing version numbers.  Next, every updated file is reanalyzed with IMTRAN, and updated index information is stored into an in-core hasharray.  Finally, the entries in the old hashfile are read in, merged with the new info, and written out to a new hashfile.

oldHashFileName is the name of the hashfile to be updated  (Note that this file must be named explicitly --- 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.  addFileList is a list of files that will be analyzed, and added to the database.  deleteFileList is a list of files that will be deleted from the database.  addFileList and deleteFileList can be used to "manage" a database, as new files are added to a document, and old ones are removed, split up,or renamed.  flushDisappearedFlg 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 deleteFileList).  If flushDisappearedFlg = T, the info for those files will simply be deleted.  If flushDisappearedFlg = ERROR, IMNAME.UPDATE.HASHFILE will return without doing anything if files have disappeared.  If flushDisappearedFlg = <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 oldHashFileName, and give a list of files as addFileList.  In this case, a new hashfile will be created just from the internal hasharray info.


\ No newline at end of file
diff --git a/docs/Documentation Tools/IMTEDIT b/docs/Documentation Tools/IMTEDIT
new file mode 100644
index 00000000..e5cb3416
--- /dev/null
+++ b/docs/Documentation Tools/IMTEDIT	
@@ -0,0 +1,2434 @@
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
+(FILECREATED " 8-Dec-91 15:41:54" {DSK}<users>sybalsky>PUBS>IMTEDIT.;2 116642 
+
+      changes to%:  (FNS TRANSLATE.DUMPOUT DUMP DUMP.HEADERS.FOOTERS DUMP.HRULE CHANGE.FONT 
+                         IM.BOUT.IMAGEOBJ IM.TEDIT.DUMP.COMMANDS IM.TEDIT.DUMP.FOOTNOTES 
+                         MAKE.IM.DOCUMENT PRINT.VRULES.ON.PAGE CREATE.FOLIO.OBJECT GET.FOLIO.STRING)
+
+      previous date%: " 4-Aug-86 11:53:22" {DSK}<users>sybalsky>PUBS>IMTEDIT.;1)
+
+
+(* ; "
+Copyright (c) 1983, 1984, 1985, 1986, 1991 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT IMTEDITCOMS)
+
+(RPAQQ IMTEDITCOMS 
+       ((FNS IM.TEDIT DUMP DUMP.HEADERS.FOOTERS DUMP.HRULE CHANGE.FONT IM.BOUT.IMAGEOBJ 
+             IM.TEDIT.DUMP.COMMANDS IM.TEDIT.DUMP.FOOTNOTES IM.TEDIT.DUMP.PARA INDEXX.PARSE.TYPE 
+             FORMAT.DEF FORMAT.LISPWORD MAKE.IM.DOCUMENT PRINT.NOTE SEND.INFO)
+        (COMS (* fns for drawing vrules to the left of definition text -- an unused, never-fully 
+                 debuged feature)
+              (FNS IM.VRULE.DISPLAYFN CREATE.VRULE.OBJECT PRINT.VRULES.ON.PAGE)
+              (VARS (IM.VRULE.STATE.LIST))
+              (INITVARS (IM.VRULE.OBJECT.IMAGEFNS NIL)
+                     (IM.PRINT.VRULE.FLG NIL)))
+        (COMS (* fns for printing page numbers)
+              (FNS IM.FOLIO.DISPLAYFN IM.FOLIO.SIZEFN CREATE.FOLIO.OBJECT GET.FOLIO.STRING)
+              (INITVARS (IM.FOLIO.OBJECT.IMAGEFNS NIL)))
+        (COMS (* TOPROG functions, used to define the translating actions of IM text objects.)
+              (FNS ARG#TOPROG BIGLISPCODE#TOPROG BRACKET#TOPROG CHAPTER#TOPROG COMMENT#TOPROG 
+                   DEF#TOPROG FIGURE#TOPROG FN#TOPROG FNDEF#TOPROG FOOT#TOPROG INCLUDE#TOPROG 
+                   INDEX#TOPROG INDEXX#TOPROG IT#TOPROG LBRACKET#TOPROG LISP#TOPROG LISPCODE#TOPROG 
+                   LISPWORD#TOPROG LIST#TOPROG MACDEF#TOPROG NOTE#TOPROG PRINT.SPECIAL.CHARS#TOPROG 
+                   PROPDEF#TOPROG RBRACKET#TOPROG REF#TOPROG RM#TOPROG SUB#TOPROG SUBSEC#TOPROG 
+                   SUPER#TOPROG TABLE#TOPROG TAG#TOPROG TERM#TOPROG VAR#TOPROG VARDEF#TOPROG)
+              (VARS TO.NAME.LIST TO.SYNONYM.LIST)
+              (IFPROP (TO.PROG TO.ARGS TO.ARG.SYNONYMS TO.TYPE TO.ARG.TYPE)
+                     * TO.NAME.LIST))
+        [INITVARS (IM.TEDIT.FONT.DEFS '(NIL (FAMILY MODERN FACE MRR SIZE 10)
+                                            FOOTNOTE
+                                            (FAMILY MODERN FACE MRR SIZE 10)
+                                            NOTE
+                                            (FAMILY MODERN FACE MIR SIZE 8)
+                                            BOLD
+                                            (FAMILY MODERN FACE BRR SIZE 10)
+                                            ITALIC
+                                            (FAMILY MODERN FACE MIR SIZE 10)
+                                            LISP
+                                            (FAMILY MODERN FACE BRR SIZE 10)
+                                            ARG
+                                            (FAMILY MODERN FACE MIR SIZE 10]
+        [INITVARS (IM.CHAPTER.TITLE.FONT '(FAMILY MODERN FACE BRR SIZE 18))
+               (IM.SUBSEC.ONE.TITLE.FONT '(FAMILY MODERN SIZE 14 FACE BRR))
+               (IM.SUBSEC.TWO.TITLE.FONT '(FAMILY MODERN SIZE 12 FACE BRR))
+               (IM.SUBSEC.THREE.TITLE.FONT '(FAMILY MODERN SIZE 10 FACE BRR))
+               (IM.TEXT.FONT '(FAMILY MODERN FACE MRR SIZE 10))
+               (IM.HEADER.FOOTER.FONT '(FAMILY MODERN FACE MRR SIZE 8))
+               (IM.XEROX.LOGO.FONT '(FAMILY MODERN FACE BRR SIZE 30]
+        (COMS (* the following variables specify all of the lengths used for possitioning IM text, 
+                 headers, etc. on the page. All of these are measured with respect to the page 
+                 *margins* <the region on the page defined by the Tedit margin parameters> or with 
+                 respect to the page *edges* <the edges of the physical page>.)
+              (* Note%: The formatting and printing does not always position the image on the page 
+                 exactly as specified. It will probably be necessary to adjust any variables based on
+                 the page edges until they come out correctly on your printer.)
+              (* indentation of 1st line of definitian header, measured in points from left page 
+                 margin. Also used for indentation of hrule under defn header.)
+              (INITVARS (IM.DEF.TITLE.1STLEFTMARGIN 75))
+              (* indentation of 2nd and other overflow lines of definition header, measured in points
+                 from left page margin.)
+              (INITVARS (IM.DEF.TITLE.LEFTMARGIN 204))
+              (* indentation of vertical rule to the left of definition text, measured in points from
+                 left page margin. This is a never-used, never-debugged feature.)
+              (INITVARS (IM.VRULE.X 194))
+              (* y-pos of top-left corner of top text line, measured in points from bottom page edge.
+                 )
+              (INITVARS (IM.TEXT.TOPMARGIN 738))
+              (* y-pos of bottom-left corner of bottom text line, measured in points from bottom page
+                 edge.)
+              (INITVARS (IM.TEXT.BOTTOMMARGIN 54))
+              (* x-pos of left edge of text, measured in points from the left page margin.)
+              (INITVARS (IM.TEXT.LEFTMARGIN 204))
+              (* x-pos of right edge of text, measured in points from the left page margin.)
+              (INITVARS (IM.TEXT.RIGHTMARGIN 504))
+              (* X-pos and Y-pos of the lower-left corner of the 
+                 "[This page intentionally left blank]" message printed on blank pages, measured in 
+                 points from the left and bottom page edges.)
+              (INITVARS (IM.BLANKPAGE.SPECIALX 258)
+                     (IM.BLANKPAGE.SPECIALY 400))
+              (* In the table of contents, indentation of first and second-level subsection headers,
+                 measured in points from the left page margin.)
+              (INITVARS (IM.TOC.SUBSEC.ONE.LEFTMARGIN 120)
+                     (IM.TOC.SUBSEC.TWO.LEFTMARGIN 216))
+              (* in the index, the indentation of the first line and remaining lines of a top-level 
+                 entry, of a subentry, and of a subsubentry, measured in points from the left page 
+                 margin <for the left column>.)
+              (INITVARS (IM.INDEX.1STLEFTMARGIN 0)
+                     (IM.INDEX.LEFTMARGIN 75)
+                     (IM.INDEX.SUB.1STLEFTMARGIN 25)
+                     (IM.INDEX.SUB.LEFTMARGIN 75)
+                     (IM.INDEX.SUBSUB.1STLEFTMARGIN 50)
+                     (IM.INDEX.SUBSUB.LEFTMARGIN 75))
+              (* on the title page, the y-pos of the lower-left corner of the first line in the title
+                 <and of the XEROX logo>, measured in points from the bottom page margin. The X-pos 
+                 is always 0 for the XEROX logo, and the normal text indentation for the title.)
+              (INITVARS (IM.TITLEPAGE.TITLE.Y 258))
+              (* on the title page, the y-pos of the lower-left corner of the first line in the 
+                 document number, measured in points from the bottom page margin. The Y-pos is always
+                 the normal text indentation.)
+              (INITVARS (IM.TITLEPAGE.DOCNUMBER.Y 45))
+              (* Tedit tab setting used for subsection heading text. "(40 . LEFT)" determines the 
+                 indentation of the title after the subsec number, measured in points from the left 
+                 page margin. "18" is the tab used if the subsec number is wider than 40 pts.)
+              [INITVARS (IM.SUBSEC.TITLE.TABS '(18 (40 . LEFT]
+              (* Tedit tab setting used for chapter titles, headers, and footers to right-justify 
+                 text. "(504 . RIGHT)" specifies a right tab at the right-hand edge of the text, 
+                 measured in points from the left page margin.)
+              [INITVARS (IM.RIGHT.MARGIN.TABS '(0 (504 . RIGHT]
+              (* Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists. 
+                 "(186 . RIGHT)" right-justifies the label on the left of the center space. 
+                 "(204 . LEFT)" starts the first line of the list item with the same indentation as 
+                 normal text. Both measurements are measured in points from the left page margin.)
+              [INITVARS (IM.LABELED.LIST.TABS '(18 (186 . RIGHT)
+                                                   (204 . LEFT]
+              (* left, right, top, and bottom margins of the "page region" %, measured in points from
+                 the four edges of the page.)
+              (INITVARS (IM.PAGE.LEFTMARGIN 58)
+                     (IM.PAGE.RIGHTMARGIN 54)
+                     (IM.PAGE.TOPMARGIN 54)
+                     (IM.PAGE.BOTTOMMARGIN 54))
+              (* top margin of the page region for the first page of a chapter <where the first 
+                 paragraph is the chapter title>, measured in points from the top page edge.)
+              (INITVARS (IM.PAGE.FIRST.TOPMARGIN 12))
+              (* top margin of the page region for the first page of the index, measured in points 
+                 from the top page edge. Note that in the case of the index, because it uses two 
+                 columns, the index title is implemented as a Tedit header, instead of as the first 
+                 paragraph of the document.)
+              (INITVARS (IM.INDEX.PAGE.FIRST.TOPMARGIN 144))
+              (* y-pos of lower-left corner of footer text, measured in points from the bottom page 
+                 edge.)
+              (INITVARS (IM.FOOTER.Y 22))
+              (* y-pos of the footer hrule, measured in points from the bottom page edge.)
+              (INITVARS (IM.FOOTER.RULE.Y 30))
+              (* y-pos of lower-left corner of header text, measured in points from the bottom page 
+                 edge.)
+              (INITVARS (IM.HEADER.Y 761))
+              (* y-pos of the header hrule, measured in points from the bottom page edge.)
+              (INITVARS (IM.HEADER.RULE.Y 757))
+              (* y-pos of lower-left corner of bottom draft message, measured in points from the 
+                 bottom page edge.)
+              (INITVARS (IM.DRAFT.MESSAGE.BOTTOM.Y 5))
+              (* y-pos of lower-left corner of top draft message, measured in points from the bottom
+                 page edge.)
+              (INITVARS (IM.DRAFT.MESSAGE.TOP.Y 775))
+              (* x-pos of lower-left corner of both top and bottom draft messages, measured in points
+                 from the left page edge.)
+              (INITVARS (IM.DRAFT.MESSAGE.X 200)))
+        (FILES TEDIT IMTRAN HRULE IMINDEX)
+        (FNS TRANSLATE.DUMPOUT TRANSLATE.SAVE.DUMPOUT)
+        (MACROS IM.HOLD.FOOTNOTES DUMPOUT SAVE.DUMPOUT)))
+(DEFINEQ
+
+(IM.TEDIT
+  [LAMBDA (INFILE.NAME OUTFILE.FLG)                      (* mjs " 4-Aug-86 10:53")
+
+         (* * This function takes an IM format file, and produces a formatted Tedit text 
+       stream. Note that the Tedit text stream is a totally different document ---
+       the user may edit it to clear up formatting problems before printing, but the 
+       user must be careful not to edit this document without going back and changing 
+       the original IM format file. INFILE.NAME is the name of an IM format file.)
+
+         (* * If OUTFILE.FLG is NIL, the output file is just sent to the default 
+       printer. If OUTFILE.FLG is T, the outfile textstream is simply returned.
+       If OUTFILE.FLG = anything else, it is taken as a file name to put the press 
+       file which is created <but not printed>.)
+
+    (PROG ((ERRFILE.NAME (PACKFILENAME 'NAME (FILENAMEFIELD INFILE.NAME 'NAME)
+                                'EXTENSION
+                                'IMERR))
+           (PTRFILENAME (PACKFILENAME 'NAME (FILENAMEFIELD INFILE.NAME 'NAME)
+                               'EXTENSION
+                               'IMPTR))
+           ERRFILE DOC.VAL)
+          (DECLARE (SPECVARS ERRFILE.NAME ERRFILE))
+          (SETQ DOC.VAL (MAKE.IM.DOCUMENT '(IMTRAN INFILE.NAME)
+                               OUTFILE.FLG NIL (CONCAT "IMTEDIT Hardcopy of " INFILE.NAME)
+                               NIL PTRFILENAME))
+          (if (OPENP ERRFILE)
+              then (CLOSEF ERRFILE)
+                    (printout T "Error File: " (FULLNAME ERRFILE)
+                           T))
+          (RETURN DOC.VAL])
+
+(DUMP
+  [LAMBDA (C)                                            (* mjs "12-Apr-85 10:41")
+
+         (* * this function dumps the character C into the Tedit stream.
+       It maps multiple CRs into a single CR, and decides when to put out paragraph 
+       looks. If C is a list, it is treated as a special "Dump Command" which does 
+       things such as changing fonts.)
+                                                             (* printout T "flg=" IM.TEDIT.CR.FLG 
+                                                           ";C=" (if (AND (LISTP C)
+                                                           (EQ (CAR C) (QUOTE TEXT))) then
+                                                           (QUOTE TEXT) elseif
+                                                           (SMALLP C) then (CONCAT C "/"
+                                                           (CHARACTER C)) else C) T)
+                                                             (* handle all CRs as examples of the 
+                                                           Dump Command CR)
+    (COND
+       [(EQ C (CHARCODE CR))
+        (IM.TEDIT.DUMP.COMMANDS '(CR]
+       ((ZEROP C)                                            (* flush null chars)
+        NIL)
+       ((LISTP C)                                            (* treat lists as Dump Commands)
+        (IM.TEDIT.DUMP.COMMANDS C))
+       [IM.TEDIT.CR.FLG (COND
+                           ((EQ C (CHARCODE SPACE))          (* ignore spaces after a CR)
+                            (NILL))
+                           ((EQ IM.TEDIT.CR.FLG 'ONE)        (* if there was only one CR, put out 
+                                                           a space and the following char)
+                            (BOUT IM.OUTFILE (CHARCODE SPACE))
+                            (SETQ IM.TEDIT.CR.FLG NIL)
+                            (DUMP C))
+                           ((EQ IM.TEDIT.CR.FLG 'MANY)       (* time to start a new para)
+                            (SETQ IM.TEDIT.CR.FLG NIL)
+                            (DUMP C]
+       ((SMALLP C)
+        (BOUT IM.OUTFILE C))
+       ((IMAGEOBJP C)
+        (IM.BOUT.IMAGEOBJ C IM.OUTFILE))
+       (T (SHOULDNT])
+
+(DUMP.HEADERS.FOOTERS
+  [LAMBDA (HEADER.TEXT FOOTER.TEXT)                      (* mjs "18-Sep-85 15:40")
+    [COND
+       (HEADER.TEXT (SETQ HEADER.TEXT (U-CASE HEADER.TEXT))
+              (DUMPOUT CR CR START.PARA FONT IM.HEADER.FOOTER.FONT PARALOOKS
+                     `(TYPE PAGEHEADING SUBTYPE VERSOHEAD QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 
+                            RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN)
+                     DUMP.CHARS HEADER.TEXT CR CR)
+              (DUMP.HRULE 1 NIL `(TYPE PAGEHEADING SUBTYPE VERSOHEADRULE 1STLEFTMARGIN 0 
+                                           LEFTMARGIN 0 RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN))
+              (DUMPOUT CR CR START.PARA FONT IM.HEADER.FOOTER.FONT PARALOOKS
+                     `(TYPE PAGEHEADING SUBTYPE RECTOHEAD QUAD RIGHT 1STLEFTMARGIN 0 LEFTMARGIN 0 
+                            RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN)
+                     DUMP.CHARS HEADER.TEXT CR CR)
+              (DUMP.HRULE 1 NIL `(TYPE PAGEHEADING SUBTYPE RECTOHEADRULE 1STLEFTMARGIN 0 
+                                           LEFTMARGIN 0 RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN]
+    (COND
+       (FOOTER.TEXT (SETQ FOOTER.TEXT (U-CASE FOOTER.TEXT))
+              (DUMP.HRULE 1 NIL `(TYPE PAGEHEADING SUBTYPE VERSOFOOTRULE 1STLEFTMARGIN 0 
+                                           LEFTMARGIN 0 RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN))
+              (DUMPOUT CR CR START.PARA FONT IM.HEADER.FOOTER.FONT PARALOOKS
+                     `(TYPE PAGEHEADING SUBTYPE VERSOFOOT QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 TABS
+                            %, IM.RIGHT.MARGIN.TABS RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN)
+                     DUMP.CHARS
+                     (CREATE.FOLIO.OBJECT)
+                     TAB DUMP.CHARS FOOTER.TEXT CR CR)
+              (DUMP.HRULE 1 NIL `(TYPE PAGEHEADING SUBTYPE RECTOFOOTRULE 1STLEFTMARGIN 0 
+                                           LEFTMARGIN 0 RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN))
+              (DUMPOUT CR CR START.PARA FONT IM.HEADER.FOOTER.FONT PARALOOKS
+                     `(TYPE PAGEHEADING SUBTYPE RECTOFOOT QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 TABS
+                            %, IM.RIGHT.MARGIN.TABS RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN)
+                     DUMP.CHARS FOOTER.TEXT TAB DUMP.CHARS (CREATE.FOLIO.OBJECT)
+                     CR CR])
+
+(DUMP.HRULE
+  [LAMBDA (RULE.WIDTH ADDITIONAL.PARA.LEADING SPECIAL.PARALOOKS)
+                                                             (* mjs "18-Sep-85 15:25")
+
+         (* * old def, used when CR at end of line caused hrule to be too far down%:
+       (DUMPOUT FONT (QUOTE (FAMILY MODERN FACE MRR SIZE 10)) PARALOOKS 
+       SPECIAL.PARALOOKS PARALOOKS (LIST (QUOTE PARALEADING)
+       (IPLUS -10 (if ADDITIONAL.PARA.LEADING else 0))
+       (QUOTE LINELEADING) 0) DUMP.CHARS (HRULE.CREATE RULE.WIDTH) CR CR))
+
+    (DUMPOUT FONT NIL PARALOOKS SPECIAL.PARALOOKS PARALOOKS (LIST 'PARALEADING (COND
+                                                                                  (
+                                                                              ADDITIONAL.PARA.LEADING
+                                                                                   )
+                                                                                  (T 0))
+                                                                  'LINELEADING 0)
+           DUMP.CHARS
+           (HRULE.CREATE RULE.WIDTH)
+           CR CR])
+
+(CHANGE.FONT
+  [LAMBDA (FONT)                                         (* mjs "11-Apr-85 15:49")
+
+         (* * changes all of the text between the last font change and the current 
+       position to the current font, and changes the current font to FONT.
+       If the current position is the same as that of the last font change <this can 
+       happen if you have multiple font changes in a row> just change the current 
+       font.)
+
+    (PROG ((CURRENT.POS (GETFILEPTR IM.OUTFILE)))
+          (COND
+             ((NEQ IM.TEDIT.LAST.FONT.BEGIN CURRENT.POS)
+              (push IM.CHARLOOKS (COND
+                                        ((LISTGET IM.TEDIT.FONT.DEFS IM.TEDIT.FONT))
+                                        (T IM.TEDIT.FONT))
+                     IM.TEDIT.LAST.FONT.BEGIN
+                     (IDIFFERENCE CURRENT.POS IM.TEDIT.LAST.FONT.BEGIN))
+                                                             (* be sure to reset Tedit selection 
+                                                           after any formatting operation)
+              (SETQ IM.TEDIT.LAST.FONT.BEGIN CURRENT.POS)))
+          (SETQ IM.TEDIT.FONT FONT])
+
+(IM.BOUT.IMAGEOBJ
+  [LAMBDA (OBJ FILE)                                     (* mjs "11-Apr-85 12:09")
+    (COND
+       ((NOT (IMAGEOBJP OBJ))
+        (SHOULDNT))
+       (T (PROG [(CURR.CH# (ADD1 (GETFILEPTR FILE]
+                (TEDIT.INSERT.OBJECT OBJ FILE CURR.CH#)
+                (SETFILEPTR FILE CURR.CH#])
+
+(IM.TEDIT.DUMP.COMMANDS
+  [LAMBDA (C)                                            (* mjs " 1-Oct-85 15:14")
+
+         (* * this function interpretes Dump Commands to IM.TEDIT.DUMP, which are always 
+       lists whose CAR is the command name.)
+
+    (SELECTQ (CAR C)
+        (TEXT                                                (* just flush TEX output string)
+              NIL)
+        (START.PARA 
+
+         (* by setting IM.TEDIT.CR.FLG to NIL, this ensures that any following spaces 
+       will not be swollowed because they follow a CR.
+       Warning%: this should only be called after a paragraph is totally ended and 
+       finished.)
+
+                    (COND
+                       ((NEQ IM.TEDIT.CR.FLG 'MANY)
+                        (IM.ERROR 
+ "START.PARA command should only be called after end of paragraph.  Is called when IM.TEDIT.CR.FLG ="
+                               IM.TEDIT.CR.FLG)))
+                    (SETQ IM.TEDIT.CR.FLG NIL))
+        (DUMP.FOOTNOTES                                      (* dump out any footnotes without 
+                                                           starting new paragraph <<which would 
+                                                           freeze para formatting info>>)
+             (IM.TEDIT.DUMP.FOOTNOTES))
+        ((START.SUPER START.SUB) 
+             (SETQ IM.TEDIT.SUB.SUPER.BEGIN (GETFILEPTR IM.OUTFILE)))
+        ((END.SUPER END.SUB) 
+
+         (* this is a very simple scheme --- currently, it does not allow nested super-
+       or subscripts.)
+
+             (PROG ((CURRENT.POS (GETFILEPTR IM.OUTFILE)))
+                   (push IM.CHARLOOKS (if (EQ (CAR C)
+                                                      'END.SUPER)
+                                              then '(SUPERSCRIPT 3)
+                                            else '(SUBSCRIPT 3))
+                          IM.TEDIT.SUB.SUPER.BEGIN
+                          (IDIFFERENCE CURRENT.POS IM.TEDIT.SUB.SUPER.BEGIN))))
+        (PARALOOKS                                           (* add para looks to list for next 
+                                                           para)
+                   (push IM.TEDIT.PARA.LOOKS (CDR C)))
+        (CR 
+
+         (* if we have recieved at least one CR before, set IM.TEDIT.CR.FLG = MANY, 
+       otherwise this is the first CR)
+
+            [COND
+               ((EQ IM.TEDIT.CR.FLG 'ONE)
+                (IM.TEDIT.DUMP.PARA))
+               ((EQ IM.TEDIT.CR.FLG NIL)
+                (SETQ IM.TEDIT.CR.FLG 'ONE])
+        (TAB (DUMP (CHARCODE TAB)))
+        (FONT (CHANGE.FONT (CDR C))
+              (push FONT.STACK (CDR C)))
+        (INDENT (IM.ERROR "INDENT command encountered -- should be flushed"))
+        (UNDO (SELECTQ (CDR C)
+                  (FONT (SETQ FONT.STACK (CDR FONT.STACK))
+                        (CHANGE.FONT (CAR FONT.STACK)))
+                  (INDENT (IM.ERROR "UNDO INDENT command encountered -- should be flushed"))
+                  NIL))
+        (INVISIBLE                                           (* print text <like index> which 
+                                                           should be invisable, so it shouldn't 
+                                                           start/stop paragraphs)
+                   (PROG ((SAVE.CR.FLG IM.TEDIT.CR.FLG))
+                         (DUMP (CDR C))
+                         (SETQ IM.TEDIT.CR.FLG SAVE.CR.FLG)))
+        (SHOULDNT])
+
+(IM.TEDIT.DUMP.FOOTNOTES
+  [LAMBDA NIL                                            (* mjs " 4-Jun-85 15:44")
+    (COND
+       ([AND IM.TEDIT.FOOTNOTE.SAVES (NOT (GET.MY.PROP 'PASSFOOT))
+             (NOT (GET.ANY.PARENT.PROP 'PASSFOOT]
+        (PROG ((CURRENT.FOOTNOTES IM.TEDIT.FOOTNOTE.SAVES))
+              (SETQ IM.TEDIT.FOOTNOTE.SAVES NIL)
+              (for X in (REVERSE CURRENT.FOOTNOTES) do (IM.DUMP.CHARS X])
+
+(IM.TEDIT.DUMP.PARA
+  [LAMBDA NIL                                            (* mjs " 4-Jun-85 15:46")
+    (PROG NIL
+
+         (* * actually end paragraph)
+
+          (BOUT IM.OUTFILE (CHARCODE CR))
+
+         (* * put out current paragraph formatting)
+
+          (for X in (REVERSE IM.TEDIT.PARA.LOOKS) do (push IM.PARALOOKS X 
+                                                                        IM.TEDIT.LAST.PARA.BEGIN 1))
+
+         (* * initialize vars for next paragraph)
+
+          (SETQ IM.TEDIT.LAST.PARA.BEGIN (GETFILEPTR IM.OUTFILE))
+          (SETQ IM.TEDIT.PARA.LOOKS NIL)
+          (SETQ IM.TEDIT.CR.FLG 'MANY)
+
+         (* * print out any footnotes waiting to be printed)
+
+          (IM.TEDIT.DUMP.FOOTNOTES])
+
+(INDEXX.PARSE.TYPE
+  [LAMBDA (SAV)                                          (* mjs "14-Jul-86 09:01")
+
+         (* * Parse the type information from an INDEXX type field)
+
+    (PROG (TYPE)
+          (if (NULL SAV)
+              then (RETURN 'TERM))
+          (SETQ TYPE (PARSE.LIST SAV))
+
+         (* if the type was specified with parenthesis at the beginning and the end, 
+       strip them out)
+
+          [if (AND (LISTP TYPE)
+                       (EQ (NTHCHARCODE (CAR TYPE)
+                                  1)
+                           (CHARCODE %())
+                       (EQ (NTHCHARCODE (CAR (LAST TYPE))
+                                  -1)
+                           (CHARCODE %))))
+              then (SETQ TYPE (CONS (SUBATOM (CAR TYPE)
+                                               2 -1)
+                                        (CDR TYPE)))
+                    (SETQ TYPE (REVERSE (CONS (SUBATOM (CAR (REVERSE TYPE))
+                                                     1 -2)
+                                              (CDR (REVERSE TYPE]
+          [if (TRANSLATE.SPECIAL.TYPES (CAR TYPE))
+              then (SETQ TYPE (TRANSLATE.SPECIAL.TYPES (CAR TYPE]
+          (RETURN (if TYPE
+                    else 'TERM])
+
+(FORMAT.DEF
+  [LAMBDA (NAME TYPE SAV TYPESTRING)                     (* mjs " 3-Oct-85 15:05")
+
+         (* * prints out a formatted definition.
+       SAV should be a SAV-format text object which describes how the name/args should 
+       be formatted. NAME is the index-name inder which this definition should be 
+       grouped. if SAV is NIL, NAME is used instead TYPE is the "object-type" of the 
+       defined object which is pased to the index.
+       TYPE is also printed in NIL after the function name.
+       If TYPESTRING is given, it is used for TYPE in the printed definition, but TYPE 
+       is always used in the index.)
+
+    (IM.HOLD.FOOTNOTES (DUMPOUT CR CR)
+           (SEND.INFO (U-CASE NAME)
+                  TYPE SAV '(*DEF*))
+           (DUMPOUT PARALOOKS
+                  `(QUAD LEFT 1STLEFTMARGIN %, IM.DEF.TITLE.1STLEFTMARGIN LEFTMARGIN %, 
+                         IM.DEF.TITLE.LEFTMARGIN LINELEADING 0 PARALEADING 18 POSTPARALEADING 0 TABS
+                         %, IM.RIGHT.MARGIN.TABS HEADINGKEEP ON)
+                  DUMP.CHARS SAV DUMP.CHARS "  " TAB FONT NIL DUMP.CHARS "[" DUMP.CHARS
+                  (if TYPESTRING
+                    else (LIST.TO.STRING TYPE))
+                  DUMP.CHARS "]" CR CR)
+           (if (EQ TO.ARG.NAME 'TEXT)
+               then (DUMPOUT DUMP.CHARS (CREATE.VRULE.OBJECT T)))
+           (DUMP.HRULE 1 NIL
+                  `(QUAD LEFT 1STLEFTMARGIN %, IM.DEF.TITLE.1STLEFTMARGIN LEFTMARGIN %, 
+                         IM.DEF.TITLE.1STLEFTMARGIN LINELEADING 0 PARALEADING 0 POSTPARALEADING 0 
+                         HEADINGKEEP ON))
+           (if (EQ TO.ARG.NAME 'TEXT)
+               then (DUMPOUT CR CR PARALOOKS '(PARALEADING 0)
+                               DUMP.ARG DUMP.CHARS (CREATE.VRULE.OBJECT)
+                               CR CR)
+                     (DUMP.HRULE 1 NIL)
+                     (DUMPOUT CR CR PARALOOKS '(PARALEADING 18))
+             elseif TO.ARG.NAME
+               then (ERROR "FORMAT.DEF called when not at {TEXT or End of TO"])
+
+(FORMAT.LISPWORD
+  [LAMBDA (SAV)                                          (* mjs " 2-MAY-83 18:08")
+    (DUMPOUT FONT LISP DUMP.CHARS SAV])
+
+(MAKE.IM.DOCUMENT
+  [LAMBDA (FORM OUTFILE.FLG PAGE.LAYOUT OUTPUT.MESSAGE DEFAULT.PARALOOKS PTRFILENAME)
+                                                             (* mjs " 4-Aug-86 10:52")
+
+         (* * this function creates an IM output file, in XPS-compatible format.
+       If sets up all of the special variables needed by DUMP, evaluates FORM, and 
+       sets all of the para and font looks)
+
+         (* * If OUTFILE.FLG is NIL, the output file is just sent to the default 
+       printer. If OUTFILE.FLG is T, the outfile textstream is simply returned.
+       If OUTFILE.FLG = anything else, it is taken as a file name to put the press 
+       file which is created <but not printed>.)
+
+         (* * if PAGE.LAYOUT is non-NIL, it should be the compound page layout to be 
+       used.)
+
+         (* * if OUTPUT.MESSAGE is non-NIL, it is printed on the hardcopy output)
+
+         (* * PTRFILENAME is the name to be used if an index pointer file is generated 
+       during hardcopy <by printing index objects>)
+
+    (PROG ((IM.OUTFILE (OPENTEXTSTREAM "" NIL NIL NIL (LIST 'IM.INDEX.PTRFILENAME PTRFILENAME)))
+           (FONT.STACK (CONS))
+           (IM.TEDIT.LAST.PARA.BEGIN 1)
+           (IM.TEDIT.LAST.FONT.BEGIN 1)
+           (IM.TEDIT.PARA.LOOKS NIL)
+           (IM.TEDIT.LAST.PARA.LOOKS NIL)
+           (IM.TEDIT.FONT NIL)
+           (IM.TEDIT.CR.FLG 'MANY)
+           (IM.TEDIT.FOOTNOTE.SAVES NIL)
+           (IM.TEDIT.SUB.SUPER.BEGIN NIL)
+           IM.CHARLOOKS IM.PARALOOKS)
+          (DECLARE (SPECVARS IM.OUTFILE FONT.STACK IM.TEDIT.LAST.PARA.BEGIN 
+                              IM.TEDIT.LAST.FONT.BEGIN IM.TEDIT.PARA.LOOKS IM.TEDIT.LAST.PARA.LOOKS 
+                              IM.TEDIT.FONT IM.TEDIT.CR.FLG IM.TEDIT.FOOTNOTE.SAVES 
+                              IM.TEDIT.SUB.SUPER.BEGIN IM.CHARLOOKS IM.PARALOOKS))
+          (SETQ IM.VRULE.STATE.LIST NIL)
+          (DUMP.HEADERS.FOOTERS "  " "  ")
+          (DUMPOUT CR CR START.PARA PARALOOKS
+                 `(TYPE PAGEHEADING SUBTYPE DRAFTMESSAGE QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 
+                        RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN)
+                 DUMP.CHARS
+                 (COND
+                    (IM.DRAFT.FLG (CONCAT "***DRAFT***  " (DATE)
+                                         "  ***DRAFT***"))
+                    (T "  "))
+                 CR CR)
+          (EVAL FORM)
+          (COND
+             (IM.EVEN.FLG 
+
+         (* if you must quarantee that you have an even number of pages for two-sided 
+       copying, dump out a blank page no matter what --
+       it can always be discarded)
+
+                    (DUMPOUT CR CR START.PARA PARALOOKS
+                           `(NEWPAGEBEFORE T QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 RIGHTMARGIN %, 
+                                   IM.TEXT.RIGHTMARGIN SPECIALX %, IM.BLANKPAGE.SPECIALX SPECIALY %,
+                                   IM.BLANKPAGE.SPECIALY)
+                           DUMP.CHARS "[This page intentionally left blank]" CR CR)))
+
+         (* after converting document, make sure that last para is formatted correctly 
+       by changing font, ending current para, and starting new para)
+
+          (DUMPOUT CR CR FONT NIL)
+          (DUMP '(START.PARA))
+
+         (* * set page format)
+
+          [TEDIT.PAGEFORMAT IM.OUTFILE
+                 (COND
+                    (PAGE.LAYOUT)
+                    (T (TEDIT.COMPOUND.PAGEFORMAT [TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 
+                                                         IM.PAGE.LEFTMARGIN IM.PAGE.RIGHTMARGIN 
+                                                         IM.PAGE.FIRST.TOPMARGIN IM.PAGE.BOTTOMMARGIN
+                                                         1 NIL NIL
+                                                         `((RECTOFOOT %, IM.PAGE.LEFTMARGIN %, 
+                                                                  IM.FOOTER.Y)
+                                                           (RECTOFOOTRULE %, IM.PAGE.LEFTMARGIN %, 
+                                                                  IM.FOOTER.RULE.Y)
+                                                           (DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
+                                                                  IM.DRAFT.MESSAGE.BOTTOM.Y]
+                              [TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN 
+                                     IM.PAGE.RIGHTMARGIN IM.PAGE.TOPMARGIN IM.PAGE.BOTTOMMARGIN 1 NIL
+                                     NIL `((DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
+                                                  IM.DRAFT.MESSAGE.TOP.Y)
+                                           (VERSOHEAD %, IM.PAGE.LEFTMARGIN %, IM.HEADER.Y)
+                                           (VERSOHEADRULE %, IM.PAGE.LEFTMARGIN %, IM.HEADER.RULE.Y)
+                                           (VERSOFOOT %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.Y)
+                                           (VERSOFOOTRULE %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.RULE.Y)
+                                           (DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
+                                                  IM.DRAFT.MESSAGE.BOTTOM.Y]
+                              (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN 
+                                     IM.PAGE.RIGHTMARGIN IM.PAGE.TOPMARGIN IM.PAGE.BOTTOMMARGIN 1 NIL
+                                     NIL `((DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
+                                                  IM.DRAFT.MESSAGE.TOP.Y)
+                                           (RECTOHEAD %, IM.PAGE.LEFTMARGIN %, IM.HEADER.Y)
+                                           (RECTOHEADRULE %, IM.PAGE.LEFTMARGIN %, IM.HEADER.RULE.Y)
+                                           (RECTOFOOT %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.Y)
+                                           (RECTOFOOTRULE %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.RULE.Y)
+                                           (DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
+                                                  IM.DRAFT.MESSAGE.BOTTOM.Y]
+
+         (* * dump default char and para looks for whole document --
+       and looks that should be different should be specified in the fns)
+
+          (TEDIT.LOOKS IM.OUTFILE IM.TEXT.FONT 1 (GETFILEINFO IM.OUTFILE 'LENGTH))
+          (TEDIT.PARALOOKS IM.OUTFILE
+                 [COND
+                    (DEFAULT.PARALOOKS)
+                    (T `(QUAD JUSTIFIED 1STLEFTMARGIN %, IM.TEXT.LEFTMARGIN LEFTMARGIN %, 
+                              IM.TEXT.LEFTMARGIN RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN LINELEADING 0 
+                              PARALEADING 5 POSTPARALEADING 0]
+                 1
+                 (GETFILEINFO IM.OUTFILE 'LENGTH))
+
+         (* must reverse list because the order of some char and paragraph looks is 
+       significant << earlier looks are overridden by later ones >>)
+
+          (SETQ IM.CHARLOOKS (DREVERSE IM.CHARLOOKS))
+          (SETQ IM.PARALOOKS (DREVERSE IM.PARALOOKS))
+          [while IM.CHARLOOKS bind (LOOKS CH# LEN)
+             do (BLOCK)
+                   (SETQ LEN (pop IM.CHARLOOKS))
+                   (SETQ CH# (ADD1 (pop IM.CHARLOOKS)))
+                   (SETQ LOOKS (pop IM.CHARLOOKS))
+                   (COND
+                      ((IGREATERP LEN 0)
+                       (TEDIT.LOOKS IM.OUTFILE LOOKS CH# LEN]
+          [while IM.PARALOOKS bind (LOOKS CH# LEN)
+             do (BLOCK)
+                   (SETQ LEN (pop IM.PARALOOKS))
+                   (SETQ CH# (ADD1 (pop IM.PARALOOKS)))
+                   (SETQ LOOKS (pop IM.PARALOOKS))
+                   (COND
+                      ((IGREATERP LEN 0)
+                       (TEDIT.PARALOOKS IM.OUTFILE LOOKS CH# LEN]
+          (COND
+             ((NULL OUTFILE.FLG)
+              (TEDIT.HARDCOPY IM.OUTFILE NIL NIL OUTPUT.MESSAGE)
+              (TEDIT.KILL IM.OUTFILE)
+              (printout T "Document sent to printer" T)
+              (RETURN))
+             ((EQ OUTFILE.FLG T)
+              (RETURN IM.OUTFILE))
+             (T (TEDIT.HARDCOPY IM.OUTFILE (PACKFILENAME 'BODY OUTFILE.FLG 'EXTENSION 'IP)
+                       T OUTPUT.MESSAGE)
+                (TEDIT.KILL IM.OUTFILE)
+                (printout T "Output file: " (PACKFILENAME 'BODY OUTFILE.FLG 'EXTENSION 'IP)
+                       T)
+                (RETURN])
+
+(PRINT.NOTE
+  [LAMBDA (NOTE.STRING)                                  (* mjs "10-Apr-85 11:17")
+    (COND
+       (IM.NOTE.FLG (DUMPOUT FONT NOTE DUMP.CHARS "<<<" DUMP.CHARS NOTE.STRING DUMP.CHARS ">>>"])
+
+(SEND.INFO
+  [LAMBDA (NAME TYPE SAV INFO PLIST)                     (* mjs " 4-Aug-86 09:06")
+    (if IM.INDEX.FILE.FLG
+        then (DUMP.FORMAT 'INVISIBLE (IM.INDEX.CREATEOBJ (create IM.INDEX.DATA
+                                                                    NAME _ NAME
+                                                                    TYPE _ TYPE
+                                                                    SAV _ (if (LISTP SAV)
+                                                                              then (CAR SAV)
+                                                                            else SAV)
+                                                                    INFO _ INFO
+                                                                    SUBSEC _ SUBSEC.COUNT.LIST
+                                                                    PROPLIST _ PLIST])
+)
+
+
+
+(* fns for drawing vrules to the left of definition text -- an unused, never-fully debuged feature)
+
+(DEFINEQ
+
+(IM.VRULE.DISPLAYFN
+  [LAMBDA (OBJ STREAM)                                   (* mjs "19-Sep-85 15:06")
+    (if (NOT (DISPLAYSTREAMP STREAM))
+        then (push IM.VRULE.STATE.LIST (LIST (DSPYPOSITION NIL STREAM)
+                                                     (IMAGEOBJPROP OBJ 'IM.VRULE.STATE])
+
+(CREATE.VRULE.OBJECT
+  [LAMBDA (STATE)                                        (* mjs "11-Jul-86 12:17")
+    (if IM.PRINT.VRULE.FLG
+        then (PROG (OBJ)
+                       [SETQ OBJ
+                        (IMAGEOBJCREATE NIL
+                               (if IM.VRULE.OBJECT.IMAGEFNS
+                                 else (SETQ IM.VRULE.OBJECT.IMAGEFNS
+                                           (IMAGEFNSCREATE (FUNCTION IM.VRULE.DISPLAYFN)
+                                                  [FUNCTION (LAMBDA NIL
+                                                              (create IMAGEBOX
+                                                                     XSIZE _ 0
+                                                                     YSIZE _ 0
+                                                                     YDESC _ 0
+                                                                     XKERN _ 0]
+                                                  'NILL
+                                                  (FUNCTION CREATE.VRULE.OBJECT)
+                                                  'NILL
+                                                  'NILL
+                                                  'NILL
+                                                  'NILL
+                                                  'NILL
+                                                  'NILL
+                                                  'NILL
+                                                  'NILL
+                                                  'NILL
+                                                  'IM.VRULE.OBJECT]
+                       (IMAGEOBJPROP OBJ 'IM.VRULE.STATE STATE)
+                       (RETURN OBJ))
+      else ""])
+
+(PRINT.VRULES.ON.PAGE
+  [LAMBDA (STREAM)                                       (* mjs "23-Sep-85 14:14")
+    (COND
+       ((AND IM.PRINT.VRULE.FLG (NOT (DISPLAYSTREAMP STREAM)))
+        (for X in (REVERSE (SORT IM.VRULE.STATE.LIST T))
+           bind (SCALED.VRULE.WIDTH _ (TIMES 1 (DSPSCALE NIL STREAM)))
+                 (SCALED.VRULE.X _ (TIMES (PLUS IM.VRULE.X IM.PAGE.LEFTMARGIN)
+                                          (DSPSCALE NIL STREAM)))
+                 (STATE _ NIL)
+                 (YPOS _ NIL)
+                 CURRENT.STATE CURRENT.YPOS
+           do (SETQ CURRENT.STATE (CADR X))
+                 (SETQ CURRENT.YPOS (CAR X))
+                 (COND
+                    ((AND (NULL CURRENT.STATE)
+                          STATE
+                          (NUMBERP YPOS)
+                          (NUMBERP CURRENT.YPOS))
+                     (DRAWLINE SCALED.VRULE.X YPOS SCALED.VRULE.X CURRENT.YPOS SCALED.VRULE.WIDTH NIL
+                            STREAM)))
+                 (COND
+                    (CURRENT.STATE (SETQ STATE CURRENT.STATE)
+                           (SETQ YPOS CURRENT.YPOS))
+                    (T (SETQ STATE NIL)
+                       (SETQ YPOS NIL)))
+           finally (PROGN (SETQ IM.VRULE.STATE.LIST NIL)
+                              (COND
+                                 ((AND STATE (NUMBERP YPOS))
+                                  (DRAWLINE SCALED.VRULE.X YPOS SCALED.VRULE.X
+                                         (TIMES IM.TEXT.BOTTOMMARGIN (DSPSCALE NIL STREAM))
+                                         SCALED.VRULE.WIDTH NIL STREAM)
+                                  (push IM.VRULE.STATE.LIST (LIST (TIMES IM.TEXT.TOPMARGIN
+                                                                             (DSPSCALE NIL STREAM))
+                                                                      STATE])
+)
+
+(RPAQQ IM.VRULE.STATE.LIST NIL)
+
+(RPAQ? IM.VRULE.OBJECT.IMAGEFNS NIL)
+
+(RPAQ? IM.PRINT.VRULE.FLG NIL)
+
+
+
+(* fns for printing page numbers)
+
+(DEFINEQ
+
+(IM.FOLIO.DISPLAYFN
+  [LAMBDA (OBJ STREAM)                                   (* mjs "20-Sep-85 09:45")
+    (PROG ((FOLIO.TEXT (GET.FOLIO.STRING OBJ STREAM))
+           FONT OFONT)
+          (SETQ FONT (SELECTQ (IMAGESTREAMTYPE STREAM)
+                         (DISPLAY '(MODERN 8 MRR 0 DISPLAY))
+                         (PRESS '(MODERN 8 MRR 0 PRESS))
+                         (INTERPRESS '(MODERN 8 MRR 0 INTERPRESS))
+                         NIL))
+          (SETQ OFONT (DSPFONT FONT STREAM))
+          (PRIN1 FOLIO.TEXT STREAM)
+          (DSPFONT OFONT STREAM)
+
+         (* * take care of any vrules on page)
+
+          (PRINT.VRULES.ON.PAGE STREAM])
+
+(IM.FOLIO.SIZEFN
+  [LAMBDA (OBJ STREAM CURX RIGHTMARGIN)                  (* mjs " 7-Aug-85 10:27")
+                                                             (* Tell the size of a menu button)
+    (PROG ((FOLIO.TEXT (GET.FOLIO.STRING OBJ STREAM))
+           FONT BOX)
+          (SETQ FONT (SELECTQ (IMAGESTREAMTYPE STREAM)
+                         (DISPLAY '(MODERN 8 MRR 0 DISPLAY))
+                         (PRESS '(MODERN 8 MRR 0 PRESS))
+                         (INTERPRESS '(MODERN 8 MRR 0 INTERPRESS))
+                         NIL))
+          (SETQ BOX (create IMAGEBOX
+                           XSIZE _ (STRINGWIDTH FOLIO.TEXT FONT)
+                           YSIZE _ (FONTPROP FONT 'HEIGHT)
+                           YDESC _ (FONTPROP FONT 'DESCENT)
+                           XKERN _ 0))
+          (RETURN BOX])
+
+(CREATE.FOLIO.OBJECT
+  [LAMBDA NIL                                            (* mjs "11-Jul-86 12:16")
+    (PROG (OBJ)
+          [SETQ OBJ (IMAGEOBJCREATE NIL (COND
+                                           (IM.FOLIO.OBJECT.IMAGEFNS)
+                                           (T (SETQ IM.FOLIO.OBJECT.IMAGEFNS
+                                               (IMAGEFNSCREATE (FUNCTION IM.FOLIO.DISPLAYFN)
+                                                      (FUNCTION IM.FOLIO.SIZEFN)
+                                                      'NILL
+                                                      (FUNCTION CREATE.FOLIO.OBJECT)
+                                                      'NILL
+                                                      'NILL
+                                                      'NILL
+                                                      'NILL
+                                                      'NILL
+                                                      'NILL
+                                                      'NILL
+                                                      'NILL
+                                                      'NILL
+                                                      'IM.FOLIO.OBJECT]
+          (IMAGEOBJPROP OBJ 'IM.CHAPNUM.DATA (COND
+                                                ((BOUNDP 'SUBSEC.COUNT.LIST)
+                                                 (CAR (LAST SUBSEC.COUNT.LIST)))
+                                                (T NIL)))
+          (RETURN OBJ])
+
+(GET.FOLIO.STRING
+  [LAMBDA (OBJ STREAM)                                   (* mjs "19-Sep-85 14:59")
+    (PROG ([CHAPNUM.INFO (MKLIST (IMAGEOBJPROP OBJ 'IM.CHAPNUM.DATA]
+           CHAPNUM PAGENUM)
+          (SETQ CHAPNUM (CAR CHAPNUM.INFO))
+          [SETQ PAGENUM (COND
+                           ((DISPLAYSTREAMP STREAM)
+                            "xx")
+                           (T (PROG [(TEDIT.PAGE (fetch (PAGEFORMATTINGSTATE PAGE#) of 
+                                                                                      FORMATTINGSTATE
+                                                        ))
+                                     (NUMBER.PAGENUMS (LENGTH (CDR CHAPNUM.INFO]
+                                    (RETURN (COND
+                                               ((NULL (CDR CHAPNUM.INFO))
+                                                TEDIT.PAGE)
+                                               [(GREATERP TEDIT.PAGE NUMBER.PAGENUMS)
+                                                (COND
+                                                   ((NUMBERP (CAR (LAST CHAPNUM.INFO)))
+                                                    (IPLUS (CAR (LAST CHAPNUM.INFO))
+                                                           (IDIFFERENCE TEDIT.PAGE NUMBER.PAGENUMS)))
+                                                   (T (CAR (LAST CHAPNUM.INFO]
+                                               (T (CAR (NTH (CDR CHAPNUM.INFO)
+                                                            TEDIT.PAGE]
+          (RETURN (COND
+                     (CHAPNUM (CONCAT CHAPNUM "." PAGENUM))
+                     (T (MKSTRING PAGENUM])
+)
+
+(RPAQ? IM.FOLIO.OBJECT.IMAGEFNS NIL)
+
+
+
+(* TOPROG functions, used to define the translating actions of IM text objects.)
+
+(DEFINEQ
+
+(ARG#TOPROG
+  [LAMBDA NIL                                            (* mjs "14-APR-83 16:10")
+    (DUMPOUT FONT ARG DUMP.ARG])
+
+(BIGLISPCODE#TOPROG
+  [LAMBDA NIL                                            (* mjs " 8-Aug-85 09:24")
+    (DUMPOUT CR CR)
+    (IM.HOLD.FOOTNOTES (PROG [(SAV (SAVE.ARG))
+                              (NEW.LINE (CONS))
+                              (LISP.LINE.PARA.LOOKS '(QUAD LEFT LEFTMARGIN 0 1STLEFTMARGIN 0]
+                             (TCONC SAV (CHARCODE CR))
+                             (for X in (CAR SAV)
+                                do (TCONC NEW.LINE X)
+                                      (if (EQ X (CHARCODE CR))
+                                          then (DUMPOUT FONT LISP PARALOOKS LISP.LINE.PARA.LOOKS
+                                                          START.PARA DUMP.CHARS NEW.LINE CR CR) 
+                                                             (* after first line, use 0 para 
+                                                           leading)
+                                                (SETQ LISP.LINE.PARA.LOOKS
+                                                 '(QUAD LEFT PARALEADING 0 LEFTMARGIN 0 1STLEFTMARGIN
+                                                        0))
+                                                (SETQ NEW.LINE (CONS])
+
+(BRACKET#TOPROG
+  [LAMBDA NIL                                            (* mjs "11-APR-83 11:10")
+    (DUMPOUT DUMP.CHARS "{" DUMP.ARG DUMP.CHARS "}"])
+
+(CHAPTER#TOPROG
+  [LAMBDA NIL                                            (* mjs "18-Sep-85 14:54")
+    (SAVE.ARGS NUMBER TITLE)
+    (PROG ((TITLE.SAV (GET.ARG.SAV TITLE))
+           (CHAP.NUM (PARSE.ATOM (GET.ARG.SAV NUMBER)))
+           UCASE.TITLE.STRING CHAP.NUM.STRING)
+          (SETQ UCASE.TITLE.STRING (U-CASE (PARSE.STRING TITLE.SAV)))
+          [if (NULL CHAP.NUM)
+              then (SETQ CHAP.NUM (if (BOUNDP 'GLOBAL.CHAPTER.NUMBER)
+                                          then GLOBAL.CHAPTER.NUMBER
+                                        else (printout T "No number specified for chapter: '" 
+                                                        UCASE.TITLE.STRING 
+                                                        "' --- please type chapter number: ")
+                                              (READ]
+          (SETQ SUBSEC.COUNT.LIST (CONS CHAP.NUM))
+          (SETQ SUBSEC.LAST.SUB 0)
+          (SETQ FOOTNOTE.NUM 0)
+          (SETQ FIGURE.NUM 0)
+
+         (* specify both headers and footers, in case a page break comes before the next 
+       subsec)
+
+          (DUMP.HEADERS.FOOTERS UCASE.TITLE.STRING UCASE.TITLE.STRING)
+          (SEND.INFO (MKATOM UCASE.TITLE.STRING)
+                 'CHAPTER TITLE.SAV)
+          (SETQ CHAP.NUM (MKLIST CHAP.NUM))
+          (SETQ CHAP.NUM.STRING (if (CAR CHAP.NUM)
+                                    then (CONCAT (CAR CHAP.NUM)
+                                                    ".")
+                                  else ""))
+          (DUMPOUT FONT IM.CHAPTER.TITLE.FONT PARALOOKS
+                 `(PARALEADING 0 LINELEADING 0 QUAD LEFT TABS %, IM.RIGHT.MARGIN.TABS)
+                 DUMP.CHARS CHAP.NUM.STRING TAB DUMP.CHARS UCASE.TITLE.STRING CR CR)
+
+         (* we want the PARALEADING between the chapter rule and the next line to be 
+       108pts. ASSUMING that the next line is a normal text line, rather than a subsec 
+       heading, this means that the next para will have a paraleading of 5pts.
+       Therefore, this "invisible" paragraph must take 103pts.
+       If the font size is 10pts and the paraleading is 93pts, this should do the 
+       trick.)
+
+          (DUMP.HRULE 6)
+          (DUMPOUT START.PARA FONT NIL PARALOOKS '(PARALEADING 93 LINELEADING 0)
+                 DUMP.CHARS " " CR CR)
+
+         (* theoretically, we should be able to get the space we need by using 
+       POSTPARALEADING, but this doesn't seem to work.
+       Try%: (DUMP.HRULE 6 NIL (QUOTE (POSTPARALEADING 103))))
+
+          (if (EQ TO.ARG.NAME 'TEXT)
+              then (DUMPOUT DUMP.ARG CR CR])
+
+(COMMENT#TOPROG
+  [LAMBDA NIL                                            (* mjs " 6-Aug-85 15:15")
+    (PROG ((IM.INDEX.FILE.FLG NIL)
+           (IM.REF.FLG NIL)
+           (IM.SEND.IMPLICIT NIL)
+           (IM.CHECK.DEFS NIL))
+          (DECLARE (SPECVARS IM.INDEX.FILE.FLG IM.REF.FLG IM.SEND.IMPLICIT IM.CHECK.DEFS))
+                                                             (* make sure that no ptrs are sent 
+                                                           from TOs in a note or comment)
+          (FLUSH.ARG])
+
+(DEF#TOPROG
+  [LAMBDA NIL                                            (* mjs " 9-Apr-85 16:00")
+    (SAVE.ARGS TYPE NAME PRINTNAME ARGS PARENS NOPARENS)
+    (PROG [[PARENS.FLG (OR (GET.ARG.SAV PARENS)
+                           (AND (GET.ARG.SAV NAME)
+                                (GET.ARG.SAV ARGS)
+                                (NULL (GET.ARG.SAV NOPARENS]
+           [INDEX.NAME (MKATOM (LIST.TO.STRING (PARSE.LIST (GET.ARG.SAV NAME]
+           (PARSED.TYPE (PARSE.LIST (GET.ARG.SAV TYPE]       (* if no more args, just return)
+          (if (TRANSLATE.SPECIAL.TYPES (CAR PARSED.TYPE))
+              then (SETQ PARSED.TYPE (TRANSLATE.SPECIAL.TYPES (CAR PARSED.TYPE)))
+            elseif (AND (EQ (NTHCHAR (CAR PARSED.TYPE)
+                                       1)
+                                '%()
+                            (EQ (NTHCHAR (CAR (LAST PARSED.TYPE))
+                                       -1)
+                                '%)))
+              then (SETQ PARSED.TYPE (CAR (GET.ARG.SAV TYPE)))
+                    (SETQ PARSED.TYPE (CDR (MEMB (CHARCODE %()
+                                                 PARSED.TYPE)))
+                    [SETQ PARSED.TYPE (REVERSE (CDR (MEMB (CHARCODE %))
+                                                          (REVERSE PARSED.TYPE]
+                    [SETQ PARSED.TYPE (PARSE.LIST (CONS PARSED.TYPE (LAST PARSED.TYPE]
+            else (IM.ERROR "bad TYPE arg given to DEF of " INDEX.NAME "  '" (PARSE.STRING 
+                                                                                       PARSED.TYPE)
+                            "'  ---  TERM used instead")
+                  (SETQ PARSED.TYPE 'TERM))
+          (FORMAT.DEF INDEX.NAME PARSED.TYPE
+                 (if (GET.ARG.SAV PRINTNAME)
+                     then (SAVE.DUMPOUT FONT LISP DUMP.CHARS (GET.ARG.SAV PRINTNAME))
+                   else (if (GET.ARG.SAV ARGS)
+                                then (if PARENS.FLG
+                                             then (SAVE.DUMPOUT FONT LISP DUMP.CHARS "(" 
+                                                             DUMP.CHARS (GET.ARG.SAV NAME)
+                                                             DUMP.CHARS " " FONT ARG DUMP.CHARS
+                                                             (GET.ARG.SAV ARGS)
+                                                             FONT LISP DUMP.CHARS ")")
+                                           else (SAVE.DUMPOUT FONT LISP DUMP.CHARS (GET.ARG.SAV
+                                                                                        NAME)
+                                                           DUMP.CHARS " " FONT ARG DUMP.CHARS
+                                                           (GET.ARG.SAV ARGS)))
+                              else (if PARENS.FLG
+                                           then (SAVE.DUMPOUT FONT LISP DUMP.CHARS "(" DUMP.CHARS
+                                                           (GET.ARG.SAV NAME)
+                                                           DUMP.CHARS ")")
+                                         else (SAVE.DUMPOUT FONT LISP DUMP.CHARS (GET.ARG.SAV
+                                                                                      NAME])
+
+(FIGURE#TOPROG
+  [LAMBDA NIL                                            (* mjs "25-Jul-85 11:30")
+    (PROG ((DUMP.CAPTION.FLG NIL)
+           (CHAP.NUM (CAR (LAST SUBSEC.COUNT.LIST)))
+           (FIGURE.TAG.LIST NIL)
+           FIGURE.TAG ARG.NAME FIGURE.NUM.STRING)
+          (SETQ FIGURE.NUM (ADD1 FIGURE.NUM))
+          (SETQ FIGURE.NUM.STRING (if (EQ CHAP.NUM 0)
+                                      then (CONCAT "Figure " FIGURE.NUM ".")
+                                    else (CONCAT "Figure " CHAP.NUM "." FIGURE.NUM ".")))
+          (DUMPOUT CR CR)
+      loop
+          (SELECTQ (SETQ ARG.NAME (GET.ARG))
+              (TAG [SETQ FIGURE.TAG (U-CASE (PARSE.ATOM (SAVE.ARG]
+                   (SETQ FIGURE.TAG.LIST (CONS FIGURE.TAG FIGURE.TAG.LIST))
+                   (SEND.INFO FIGURE.TAG 'TAG NIL (LIST '*FIGURE* FIGURE.NUM)))
+              (TEXT (DUMPOUT DUMP.ARG CR CR))
+              (CAPTION (DUMPOUT DUMP.CHARS FIGURE.NUM.STRING DUMP.CHARS "   " DUMP.ARG CR CR)
+                       (SETQ DUMP.CAPTION.FLG T))
+              (NIL (if (NOT DUMP.CAPTION.FLG)
+                       then (DUMPOUT DUMP.CHARS FIGURE.NUM.STRING CR CR))
+                   (SAVE.INFILE.NOTE 'IM.FIGURE (CONS FIGURE.NUM FIGURE.TAG.LIST))
+                   (RETURN))
+              (SHOULDNT))
+          (GO loop])
+
+(FN#TOPROG
+  [LAMBDA NIL                                            (* mjs "13-SEP-83 17:14")
+    (PROG ((SAV (SAVE.ARG)))
+          (FORMAT.LISPWORD SAV)
+          (SEND.IMPLICIT (PARSE.ATOM SAV)
+                 '(Function)
+                 SAV)
+          (if [AND IM.CHECK.DEFS (NOT (GETD (PARSE.ATOM SAV]
+              then (SAVE.INFILE.NOTE 'UNDEF.FN (PARSE.ATOM SAV])
+
+(FNDEF#TOPROG
+  [LAMBDA NIL                                            (* mjs "18-Sep-85 14:57")
+    (SAVE.ARGS NAME ARGS TYPE)
+    (PROG ((NAME (PARSE.ATOM (GET.ARG.SAV NAME)))
+           (ARGS (PARSE.LIST (GET.ARG.SAV ARGS)))
+           [TYPES (U-CASE (PARSE.LIST (GET.ARG.SAV TYPE]
+           NEXT.ARG typestring fntype typelist)              (* if no more args, just return)
+          (DUMPOUT CR CR)
+          (if IM.CHECK.DEFS
+              then (if (GETD NAME)
+                           then (SETQ fntype 0)
+                                 (COND
+                                    ((FMEMB 'NLAMBDA TYPES)
+                                     (SETQ fntype 1)))
+                                 [COND
+                                    ((FMEMB 'NOSPREAD TYPES)
+                                     (SETQ fntype (IPLUS fntype 2]
+                                 (COND
+                                    ((NEQ fntype (ARGTYPE NAME))
+                                     (SETQ typelist (SELECTQ (ARGTYPE NAME)
+                                                        (0 '[LAMBDA SPREAD])
+                                                        (1 '[NLAMBDA SPREAD])
+                                                        (2 '[LAMBDA NOSPREAD])
+                                                        (3 '[NLAMBDA NOSPREAD])
+                                                        NIL))
+                                     (DUMPOUT CR CR)
+                                     (PRINT.NOTE (CONCAT NAME " is a " typelist 
+                                                            " but manual def says it is a " TYPES))
+                                     (IM.WARNING NAME " is a " typelist 
+                                            " but manual def says it is a " TYPES)))
+                                 (COND
+                                    ([NOT (OR (EQUAL ARGS (MKLIST (ARGLIST NAME)))
+                                              (AND (NLISTP (ARGLIST NAME))
+                                                   (GREATERP (LENGTH ARGS)
+                                                          1]
+                                     (DUMPOUT CR CR)
+                                     (PRINT.NOTE (CONCAT NAME " has arglist: "
+                                                            (MKLIST (ARGLIST NAME))
+                                                            " in Interlisp-D"))
+                                     (IM.WARNING NAME " has arglist: " (MKLIST (ARGLIST NAME)))
+                                     (IM.WARNING "      but manual says: " ARGS)))
+                         else (DUMPOUT CR CR)
+                               (PRINT.NOTE (CONCAT "Function: " NAME 
+                                                      " is not defined in Interlisp-D"))
+                               (IM.WARNING "Function: " NAME " is not defined in Interlisp-D")
+                               (SAVE.INFILE.NOTE 'UNDEF.FN NAME)))
+          (DUMPOUT CR CR)
+          (SETQ typestring "Function")
+          [COND
+             ((FMEMB 'NOSPREAD TYPES)
+              (SETQ typestring (CONCAT "NoSpread " typestring]
+          [COND
+             ((FMEMB 'NLAMBDA TYPES)
+              (SETQ typestring (CONCAT "NLambda " typestring]
+          (FORMAT.DEF NAME '(Function)
+                 (if (AND (LISTP (GET.ARG.SAV ARGS))
+                              (CAR (GET.ARG.SAV ARGS)))
+                     then (SAVE.DUMPOUT FONT LISP DUMP.CHARS "(" DUMP.CHARS (GET.ARG.SAV NAME)
+                                     DUMP.CHARS " " FONT ARG DUMP.CHARS (GET.ARG.SAV ARGS)
+                                     FONT LISP DUMP.CHARS ")")
+                   else (SAVE.DUMPOUT FONT LISP DUMP.CHARS "(" DUMP.CHARS (GET.ARG.SAV NAME)
+                                   DUMP.CHARS ")"))
+                 typestring])
+
+(FOOT#TOPROG
+  [LAMBDA NIL                                            (* mjs "18-Sep-85 14:57")
+    (PROG (FOOT.SAV)
+          (SETQ FOOTNOTE.NUM (ADD1 FOOTNOTE.NUM))
+          (IM.WARNING "footnote #" FOOTNOTE.NUM "  --- not fully implemented")
+          (DUMPOUT FONT FOOTNOTE START.SUPER DUMP.CHARS FOOTNOTE.NUM END.SUPER)
+          (SETQ FOOT.SAV (SAVE.DUMPOUT FONT FOOTNOTE START.SUPER DUMP.CHARS FOOTNOTE.NUM END.SUPER 
+                                DUMP.ARG CR CR))
+          (push IM.TEDIT.FOOTNOTE.SAVES FOOT.SAV])
+
+(INCLUDE#TOPROG
+  [LAMBDA NIL                                            (* mjs "25-Jul-85 10:49")
+    (PROG [(names (PARSE.LIST (SAVE.ARG]
+          (COND
+             ((CDR names)
+              (IM.ERROR "Include file name: " names " -- first name will be used")))
+          (INCLUDE.FILE (CAR names])
+
+(INDEX#TOPROG
+  [LAMBDA NIL                                            (* mjs "23-Jul-85 11:21")
+    (PROG ((SAV (SAVE.ARG))
+           (INFO NIL)
+           TYPE ARGS TEMP ARG.ATOM)
+          (SETQ TEMP (PARSE.INDEX.SPEC SAV T))
+          (if (OR (NULL TEMP)
+                      (NULL (CAR TEMP)))
+              then (IM.WARNING "null index with type=" (CDR TEMP)
+                              " --- ignored")
+                    (RETURN))
+          (SETQ ARGS (CAR TEMP))
+          (SETQ TYPE (CDR TEMP))
+          (while (FMEMB (CAR ARGS)
+                            '(*BEGIN* *END* *PRIMARY*)) do (SETQ INFO (CONS (CAR ARGS)
+                                                                                INFO))
+                                                              (SETQ ARGS (CDR ARGS)))
+          (SETQ ARG.ATOM (MKATOM (LIST.TO.STRING ARGS)))
+          (if (U-CASEP ARG.ATOM)
+              then (SEND.INFO ARG.ATOM TYPE NIL INFO)
+            else (SEND.INFO (U-CASE ARG.ATOM)
+                            TYPE ARG.ATOM INFO])
+
+(INDEXX#TOPROG
+  [LAMBDA NIL                                            (* mjs "11-Jul-86 16:57")
+    (SAVE.ARGS NAME TYPE INFO TEXT SUBNAME SUBTYPE SUBTEXT SUBSUBNAME SUBSUBTYPE SUBSUBTEXT)
+    (PROG ((PROPLIST NIL)
+           [NAME (MKATOM (LIST.TO.STRING (if (PARSE.LIST (GET.ARG.SAV NAME))
+                                           else '(NIL]
+           (TYPE (INDEXX.PARSE.TYPE (GET.ARG.SAV TYPE)))
+           (INFO (PARSE.LIST (GET.ARG.SAV INFO)))
+           [SUBNAME (MKATOM (LIST.TO.STRING (if (PARSE.LIST (GET.ARG.SAV SUBNAME))
+                                              else '(NIL]
+           (SUBTYPE (INDEXX.PARSE.TYPE (GET.ARG.SAV SUBTYPE)))
+           [SUBSUBNAME (MKATOM (LIST.TO.STRING (if (PARSE.LIST (GET.ARG.SAV SUBSUBNAME))
+                                                 else '(NIL]
+           (SUBSUBTYPE (INDEXX.PARSE.TYPE (GET.ARG.SAV SUBSUBTYPE)))
+           TEXT SUBTEXT SUBSUBTEXT)
+          (SETQ TEXT (if (GET.ARG.SAV TEXT)
+                       elseif (NOT (U-CASEP NAME))
+                         then NAME))
+          (SETQ SUBTEXT (if (GET.ARG.SAV SUBTEXT)
+                          elseif (NOT (U-CASEP SUBNAME))
+                            then SUBNAME))
+          (SETQ SUBSUBTEXT (if (GET.ARG.SAV SUBSUBTEXT)
+                             elseif (NOT (U-CASEP SUBSUBNAME))
+                               then SUBSUBNAME))
+          (SETQ NAME (U-CASE NAME))
+          (SETQ SUBNAME (U-CASE SUBNAME))
+          (SETQ SUBSUBNAME (U-CASE SUBSUBNAME))
+          [if (OR SUBNAME SUBTEXT)
+              then (SETQ PROPLIST (APPEND PROPLIST (LIST 'SUBNAME SUBNAME 'SUBTYPE SUBTYPE
+                                                             'SUBTEXT SUBTEXT]
+          [if (OR SUBSUBNAME SUBSUBTEXT)
+              then (SETQ PROPLIST (APPEND PROPLIST (LIST 'SUBSUBNAME SUBSUBNAME 'SUBSUBTYPE 
+                                                             SUBSUBTYPE 'SUBSUBTEXT SUBSUBTEXT]
+          (SEND.INFO NAME TYPE TEXT INFO PROPLIST])
+
+(IT#TOPROG
+  [LAMBDA NIL                                            (* mjs "18-APR-83 14:32")
+    (DUMPOUT FONT ITALIC DUMP.ARG])
+
+(LBRACKET#TOPROG
+  [LAMBDA NIL                                            (* mjs "10-Apr-85 09:51")
+    (IM.DUMP.CHARS "{")
+    (TRIVIAL.ARG])
+
+(LISP#TOPROG
+  [LAMBDA NIL                                            (* mjs "18-APR-83 14:27")
+    (DUMPOUT FONT LISP DUMP.ARG])
+
+(LISPCODE#TOPROG
+  [LAMBDA NIL                                            (* mjs " 2-Aug-85 16:27")
+    (DUMPOUT CR CR)
+    (IM.HOLD.FOOTNOTES (PROG [(SAV (SAVE.ARG))
+                              (NEW.LINE (CONS))
+                              (LISP.LINE.PARA.LOOKS '(QUAD LEFT]
+                             (TCONC SAV (CHARCODE CR))
+                             (for X in (CAR SAV)
+                                do (TCONC NEW.LINE X)
+                                      (if (EQ X (CHARCODE CR))
+                                          then (DUMPOUT FONT LISP PARALOOKS LISP.LINE.PARA.LOOKS
+                                                          START.PARA DUMP.CHARS NEW.LINE CR CR) 
+                                                             (* after first line, use 0 para 
+                                                           leading)
+                                                (SETQ LISP.LINE.PARA.LOOKS
+                                                 '(QUAD LEFT PARALEADING 0))
+                                                (SETQ NEW.LINE (CONS])
+
+(LISPWORD#TOPROG
+  [LAMBDA NIL                                            (* mjs "27-JUL-83 14:13")
+
+         (* keep as seperate fn from LISP#TOPROG so can easily add hacks to check fns, 
+       etc..)
+
+    (PROG ((SAV (SAVE.ARG)))
+          (FORMAT.LISPWORD SAV)
+          (SEND.IMPLICIT (PARSE.ATOM SAV)
+                 (SELECTQ TO.NAME
+                     (ATOM '(Litatom))
+                     (BREAKCOM '(Break Command))
+                     (EDITCOM '(Editor Command))
+                     (FILECOM '(File Package Command))
+                     (MAC '(Macro))
+                     (PACOM '(Prog. Asst. Command))
+                     (PROP '(Property Name))
+                     'TERM)
+                 SAV])
+
+(LIST#TOPROG
+  [LAMBDA NIL                                            (* mjs "28-Jul-86 16:36")
+    (PROG ((LNAME.AND.NAME.LIST NIL)
+           (ITEM.NUMBER 0)
+           (LIST.PARA.LOOKS `(1STLEFTMARGIN 0 LEFTMARGIN %, IM.TEXT.LEFTMARGIN POSTPARALEADING 0 TABS
+                                    %, IM.LABELED.LIST.TABS))
+           LAST.SPEC)
+
+         (* * LNAME.AND.NAME.LIST is a list of LNAME and NAME values, where each element 
+       of the list is of the form (LNAME . NAME))
+
+          (DUMPOUT CR CR)
+          (until (NULL (SETQ LAST.SPEC (GET.ARG)))
+             do
+             (SELECTQ LAST.SPEC
+                 ((INDENT MAX) 
+                      (IM.WARNING "List with " LAST.SPEC (PARSE.NUMBER.OR.PERCENTAGE (SAVE.ARG)
+                                                                100 100)
+                             " spec -- de-implemented"))
+                 (UNINDENTED (DUMPOUT CR CR DUMP.ARG CR CR))
+                 (LNAME (push LNAME.AND.NAME.LIST (CONS (SAVE.ARG)
+                                                            " ")))
+                 (NAME [if [AND LNAME.AND.NAME.LIST (EQUAL " " (CDR (CAR LNAME.AND.NAME.LIST]
+                           then (RPLACD (CAR LNAME.AND.NAME.LIST)
+                                           (SAVE.ARG))
+                         else (push LNAME.AND.NAME.LIST (CONS " " (SAVE.ARG])
+                 (ITEM (SETQ ITEM.NUMBER (ADD1 ITEM.NUMBER))
+                       (SELECTQ TO.NAME
+                           (NUMBEREDLIST (DUMPOUT PARALOOKS LIST.PARA.LOOKS TAB DUMP.CHARS "(" 
+                                                DUMP.CHARS ITEM.NUMBER DUMP.CHARS ")" TAB DUMP.ARG CR
+                                                CR))
+                           (UNNUMBEREDLIST 
+                                (DUMPOUT PARALOOKS LIST.PARA.LOOKS TAB DUMP.CHARS
+                                       (MKSTRING (CHARACTER (CHARCODE %#7)))
+                                       TAB DUMP.ARG CR CR))
+                           (LABELEDLIST (if LNAME.AND.NAME.LIST
+                                            then (PROG ((ALL.BUT.LAST.NAME.SPECS
+                                                             (REVERSE (CDR LNAME.AND.NAME.LIST)))
+                                                            (FIRST.NAME.SPEC (CAR LNAME.AND.NAME.LIST
+                                                                                  )))
+                                                           [for LNAME.NAME in 
+                                                                              ALL.BUT.LAST.NAME.SPECS
+                                                              do 
+                                                             (* dump all but last name)
+                                                                    (DUMPOUT PARALOOKS 
+                                                                           LIST.PARA.LOOKS DUMP.CHARS
+                                                                           (CAR LNAME.NAME)
+                                                                           TAB PARALOOKS
+                                                                           '(HEADINGKEEP ON)
+                                                                           DUMP.CHARS
+                                                                           (CDR LNAME.NAME)
+                                                                           TAB CR CR PARALOOKS
+                                                                           '(PARALEADING 0]
+                                                             (* dump last name and item)
+                                                           (DUMPOUT PARALOOKS LIST.PARA.LOOKS 
+                                                                  DUMP.CHARS (CAR FIRST.NAME.SPEC)
+                                                                  TAB DUMP.CHARS (CDR FIRST.NAME.SPEC
+                                                                                      )
+                                                                  TAB DUMP.ARG CR CR))
+                                          else (DUMPOUT DUMP.ARG CR CR))
+                                        (SETQ LNAME.AND.NAME.LIST NIL))
+                           (SHOULDNT)))
+                 (SHOULDNT])
+
+(MACDEF#TOPROG
+  [LAMBDA NIL                                            (* mjs " 5-AUG-83 13:31")
+    (SAVE.ARGS NAME ARGS TYPE)
+    (PROG ((NAME (PARSE.ATOM (GET.ARG.SAV NAME)))
+           (ARGS (PARSE.LIST (GET.ARG.SAV ARGS)))
+           [TYPES (U-CASE (PARSE.LIST (GET.ARG.SAV TYPE]
+           typestring)
+
+         (* * will eventually check if NAME has a macro definition)
+
+          (SETQ typestring "Macro")
+          [COND
+             ((FMEMB 'NOSPREAD TYPES)
+              (SETQ typestring (CONCAT "NoSpread " typestring]
+          [COND
+             ((FMEMB 'NLAMBDA TYPES)
+              (SETQ typestring (CONCAT "NLambda " typestring]
+          (FORMAT.DEF NAME '(Macro)
+                 (if (GET.ARG.SAV ARGS)
+                     then (SAVE.DUMPOUT FONT LISP DUMP.CHARS "(" DUMP.CHARS (GET.ARG.SAV NAME)
+                                     DUMP.CHARS " " FONT ARG DUMP.CHARS (GET.ARG.SAV ARGS)
+                                     FONT LISP DUMP.CHARS ")")
+                   else (SAVE.DUMPOUT FONT LISP DUMP.CHARS "(" DUMP.CHARS (GET.ARG.SAV NAME)
+                                   DUMP.CHARS ")"))
+                 typestring])
+
+(NOTE#TOPROG
+  [LAMBDA NIL                                            (* mjs " 6-Aug-85 15:14")
+    (PROG ((IM.INDEX.FILE.FLG NIL)
+           (IM.REF.FLG NIL)
+           (IM.SEND.IMPLICIT NIL)
+           (IM.CHECK.DEFS NIL))
+          (DECLARE (SPECVARS IM.INDEX.FILE.FLG IM.REF.FLG IM.SEND.IMPLICIT IM.CHECK.DEFS))
+                                                             (* make sure that no ptrs are sent 
+                                                           from TOs in a note or comment)
+          (if IM.NOTE.FLG
+              then (DUMPOUT FONT NOTE DUMP.CHARS "<<<< " DUMP.ARG DUMP.CHARS " >>>>")
+            else (FLUSH.ARG])
+
+(PRINT.SPECIAL.CHARS#TOPROG
+  [LAMBDA NIL                                            (* mjs " 4-Oct-85 13:45")
+    (PROG [(CHAR.STRING (SELECTQ TO.NAME
+                            (ANONARG (MKSTRING (CHARACTER (CHARCODE 357,45))))
+                            (BULLET (MKSTRING (CHARACTER (CHARCODE %#7))))
+                            (CRSYMBOL (DUMPOUT START.SUPER DUMP.CHARS "cr" END.SUPER)
+                                      "")
+                            (ELLIPSIS "...")
+                            (EMDASH (MKSTRING (CHARACTER (CHARCODE 357,45))))
+                            (ENDASH (MKSTRING (CHARACTER (CHARCODE 357,44))))
+                            (GE ">=")
+                            (LE "<=")
+                            (NE "~=")
+                            (PI "~PI~")
+                            (PLUSMINUS "+-")
+                            (SP " ")
+                            (SHOULDNT]
+          (DUMPOUT DUMP.CHARS CHAR.STRING TRIVIAL.ARG])
+
+(PROPDEF#TOPROG
+  [LAMBDA NIL                                            (* mjs " 5-MAY-83 11:56")
+    (SAVE.ARGS NAME)
+    (FORMAT.DEF (PARSE.ATOM (GET.ARG.SAV NAME))
+           '(Property Name)
+           (SAVE.DUMPOUT FONT LISP DUMP.CHARS (GET.ARG.SAV NAME])
+
+(RBRACKET#TOPROG
+  [LAMBDA NIL                                            (* mjs "10-Apr-85 09:50")
+    (IM.DUMP.CHARS "}")
+    (TRIVIAL.ARG])
+
+(REF#TOPROG
+  [LAMBDA NIL                                            (* mjs " 4-Aug-86 11:40")
+    (if (NOT IM.REF.FLG)
+        then (SAVE.ARG)
+              (IM.DUMP.CHARS (SELECTQ TO.NAME
+                                 (PAGEREF "page X.XX")
+                                 (SECTIONREF "section X.XX")
+                                 (FIGUREREF "figure X.X")
+                                 (SHOULDNT)))
+      else (PROG ((SAV (SAVE.ARG))
+                      (DEF.REFS NIL)
+                      (PRIMARY.REFS NIL)
+                      (SECONDARY.REFS NIL)
+                      (MAX.REF NIL)
+                      REF.STRING TYPE ARGS TEMP ARG.ATOM REFS)
+                     (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 'FIGUREREF)
+                                    then                 (* for FIGUREREF, ignore specified 
+                                                           type --- use TAG)
+                                          'TAG
+                                  elseif (U-CASE (CDR TEMP))
+                                  else 'TERM))
+                     [SETQ ARG.ATOM (U-CASE (MKATOM (LIST.TO.STRING ARGS]
+
+         (* * only look at refs that have the correct type, AND that are not subentries 
+       or subsub entries)
+
+                     (SETQ REFS (for X in (GETHASH ARG.ATOM IMPTR.HASH)
+                                   when [AND (EQUAL (if (U-CASE (fetch (IM.INDEX.DATA
+                                                                                    TYPE)
+                                                                           of X))
+                                                          else 'TERM)
+                                                        TYPE)
+                                                 (NULL (LISTGET (fetch (IM.INDEX.DATA PROPLIST)
+                                                                   of X)
+                                                              'SUBNAME))
+                                                 (NULL (LISTGET (fetch (IM.INDEX.DATA PROPLIST)
+                                                                   of X)
+                                                              'SUBTEXT] collect X))
+                     (if (NULL REFS)
+                         then (IM.WARNING " no refs for resolving {" TO.NAME " " TYPE " " 
+                                         ARG.ATOM "} -- dummy used")
+                               (IM.DUMP.CHARS (SELECTQ TO.NAME
+                                                  (PAGEREF "page X.XX")
+                                                  (SECTIONREF "section X.XX")
+                                                  (FIGUREREF "figure X.X")
+                                                  (SHOULDNT)))
+                               (RETURN))
+
+         (* * REFS is list list of refs to index name ARG.ATOM of type TYPE, with 
+       elements of form%: (type text info section file fileptr))
+
+                     [for X in REFS
+                        do (if (OR (AND (EQ TO.NAME 'FIGUREREF)
+                                                (MEMB '*FIGURE* (fetch (IM.INDEX.DATA INFO)
+                                                                   of X)))
+                                           (MEMB '*PRIMARY* (fetch (IM.INDEX.DATA INFO)
+                                                               of X)))
+                                   then (SETQ PRIMARY.REFS (CONS X PRIMARY.REFS))
+                                 elseif (MEMB '*DEF* (fetch (IM.INDEX.DATA INFO) of
+                                                                                         X))
+                                   then (SETQ DEF.REFS (CONS X DEF.REFS))
+                                 else (SETQ SECONDARY.REFS (CONS X SECONDARY.REFS]
+                     (SETQ MAX.REF (if PRIMARY.REFS
+                                     elseif DEF.REFS
+                                     else SECONDARY.REFS))
+                     (if (CDR MAX.REF)
+                         then (IM.WARNING "multiple "
+                                         (if PRIMARY.REFS
+                                             then "primary"
+                                           elseif DEF.REFS
+                                             then "def"
+                                           else "secondary")
+                                         " refs for resolving {" TO.NAME " " TYPE " " ARG.ATOM 
+                                         "} - first used"))
+                     (SETQ MAX.REF (CAR MAX.REF))
+                     (SETQ REF.STRING
+                      (SELECTQ TO.NAME
+                          (PAGEREF [PROG ((CHAP.PAGE.LST (REF.TO.PAGE MAX.REF)))
+                                         (RETURN (if (EQ 0 (CAR CHAP.PAGE.LST))
+                                                     then (CONCAT "page " (CADR CHAP.PAGE.LST))
+                                                   else (CONCAT "page " (CAR CHAP.PAGE.LST)
+                                                                   "."
+                                                                   (CADR CHAP.PAGE.LST])
+                          (SECTIONREF (PROG ((SEC.LIST (REVERSE (fetch (IM.INDEX.DATA SUBSEC)
+                                                                   of X)))
+                                             SEC.STRING)
+                                            (SETQ SEC.STRING (if (CDR SEC.LIST)
+                                                                 then "section "
+                                                               elseif (NUMBERP (CAR SEC.LIST))
+                                                                 then "chapter "
+                                                               else "appendix "))
+                                            (if (EQ 0 (CAR SEC.LIST))
+                                                then (SETQ SEC.LIST (CDR SEC.LIST)))
+                                            [for X on SEC.LIST
+                                               do (SETQ SEC.STRING
+                                                       (CONCAT SEC.STRING (CAR X)
+                                                              (if (CDR X)
+                                                                  then "."
+                                                                else ""]
+                                            (RETURN SEC.STRING)))
+                          (FIGUREREF [PROG [[CHAP.NUM (CAR (LAST (fetch (IM.INDEX.DATA SUBSEC)
+                                                                    of X]
+                                            (FIG.NUM (CADR (MEMB '*FIGURE* (fetch (IM.INDEX.DATA
+                                                                                       INFO)
+                                                                              of X]
+                                           (RETURN (if (EQ 0 CHAP.NUM)
+                                                       then (CONCAT "figure " FIG.NUM)
+                                                     else (CONCAT "figure " CHAP.NUM "." FIG.NUM])
+                          (SHOULDNT)))
+                     (IM.DUMP.CHARS REF.STRING])
+
+(RM#TOPROG
+  [LAMBDA NIL                                            (* mjs " 4-MAY-83 10:23")
+    (DUMPOUT FONT NIL DUMP.ARG])
+
+(SUB#TOPROG
+  [LAMBDA NIL                                            (* mjs "14-Dec-83 10:44")
+    (DUMPOUT START.SUB DUMP.ARG END.SUB])
+
+(SUBSEC#TOPROG
+  [LAMBDA NIL                                            (* mjs " 3-Oct-85 15:00")
+    (SAVE.ARGS TITLE)
+    (PROG ((SUBSEC.COUNT.LIST (CONS (SETQ SUBSEC.LAST.SUB (ADD1 SUBSEC.LAST.SUB))
+                                    SUBSEC.COUNT.LIST))
+           (SUBSEC.LAST.SUB 0)
+           PRINTING.TITLE SEC.STRING SEC.LIST CHAP.NUM)
+          (DECLARE (SPECVARS SUBSEC.COUNT.LIST SUBSEC.LAST.SUB))
+
+         (* SUBSEC.COUNT.LIST is a reverse list of the subsec numbers and chapter num, 
+       so if this is subsec 3.5.7, SUBSEC.COUNT.LIST =
+       (7 5 3))
+                                                             (* set SUBSEC.SKIP.STRING to skip 
+                                                           before header (<<<DELETED IN 
+                                                           IM.TEDIT>>>))
+                                                             (* set PRINTING.TITLE to subsec 
+                                                           title <u-case if 1st-level subsec)
+          (SETQ PRINTING.TITLE (GET.ARG.SAV TITLE))
+          (SETQ SEC.STRING "")
+          (SETQ SEC.LIST (REVERSE SUBSEC.COUNT.LIST))
+          [SETQ CHAP.NUM (CAR (MKLIST (CAR SEC.LIST]
+          [SETQ SEC.LIST (if (NULL CHAP.NUM)
+                             then (CDR SEC.LIST)
+                           else (CONS CHAP.NUM (CDR SEC.LIST]
+          [for X on SEC.LIST do (SETQ SEC.STRING (CONCAT SEC.STRING (CAR X)
+                                                                    (if (CDR X)
+                                                                        then "."
+                                                                      else ""]
+          [if (EQ 2 (LENGTH SUBSEC.COUNT.LIST))
+              then                                       (* major heading)
+                    (DUMP.HEADERS.FOOTERS (U-CASE (PARSE.STRING PRINTING.TITLE))
+                           NIL)
+                    (DUMP.HRULE 2 55
+                           '(QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0 PARALEADING 0 
+                                  POSTPARALEADING 0 HEADINGKEEP ON))
+                    (DUMPOUT FONT IM.SUBSEC.ONE.TITLE.FONT PARALOOKS
+                           `(QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0 PARALEADING 0 
+                                  POSTPARALEADING 0 TABS %, IM.SUBSEC.TITLE.TABS HEADINGKEEP ON)
+                           DUMP.CHARS SEC.STRING DUMP.CHARS "  " TAB DUMP.CHARS PRINTING.TITLE CR CR)
+                    (DUMP.HRULE 1 NIL
+                           '(QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0 PARALEADING 0 
+                                  POSTPARALEADING 0 HEADINGKEEP ON))
+            elseif (EQ 3 (LENGTH SUBSEC.COUNT.LIST))
+              then                                       (* important heading)
+                    (DUMPOUT FONT IM.SUBSEC.TWO.TITLE.FONT PARALOOKS
+                           `(QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0 PARALEADING 35 
+                                  POSTPARALEADING 0 TABS %, IM.SUBSEC.TITLE.TABS HEADINGKEEP ON)
+                           DUMP.CHARS SEC.STRING DUMP.CHARS "  " TAB DUMP.CHARS PRINTING.TITLE CR CR)
+                    (DUMP.HRULE 1 NIL
+                           '(QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0 PARALEADING 0 
+                                  POSTPARALEADING 0 HEADINGKEEP ON))
+            else                                         (* plain heading for 3rd or greater 
+                                                           level headings)
+                  (DUMPOUT FONT IM.SUBSEC.THREE.TITLE.FONT PARALOOKS
+                         `(QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0 PARALEADING 35 
+                                POSTPARALEADING 0 TABS %, IM.SUBSEC.TITLE.TABS HEADINGKEEP ON)
+                         DUMP.CHARS SEC.STRING DUMP.CHARS "  " TAB DUMP.CHARS PRINTING.TITLE CR CR)
+                  (DUMP.HRULE 1 NIL
+                         '(QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0 PARALEADING 0 
+                                POSTPARALEADING 0 HEADINGKEEP ON]
+          (SEND.INFO [U-CASE (MKATOM (PARSE.STRING (GET.ARG.SAV TITLE]
+                 'SUBSEC
+                 (GET.ARG.SAV TITLE))
+          (if (EQ TO.ARG.NAME 'TEXT)
+              then (DUMP.ARG)
+                    (DUMPOUT CR CR])
+
+(SUPER#TOPROG
+  [LAMBDA NIL                                            (* mjs "14-Dec-83 10:44")
+    (DUMPOUT START.SUPER DUMP.ARG END.SUPER])
+
+(TABLE#TOPROG
+  [LAMBDA NIL                                            (* mjs "25-Jul-85 10:33")
+    (IM.ERROR "Table --- de-implemented")
+    [IM.HOLD.FOOTNOTES (bind ARG.NAME while (SETQ ARG.NAME (GET.ARG))
+                          do (if (MEMB ARG.NAME '(VSKIP HSKIP COLUMN MULTIPAGE UNDERLINE))
+                                     then (FLUSH.ARG)
+                                   else (DUMPOUT DUMP.ARG CR CR]
+
+         (* * old version%: (IM.HOLD.FOOTNOTES (PROG
+       ((TotalWidth (ANC.WIDTH)) (CurrentIndent
+       (ANC.INDENT)) (FORMAT.PARSED NIL) (vskip 10)
+       (hskip 15) (ColumnWidthList NIL) (UNDERLINE.FLG NIL)
+       (MULTIPAGE.FLG NIL) (BEGIN.FLG T) TableWidth numcol freecol ARG.NAME col 
+       COLUMN.INDENT.WIDTH.LIST COLUMN.WIDTH COLUMN.INDENT COLUMN.PARALOOKS 
+       BEGIN.ROW.FLG) loop (SELECTQ (SETQ ARG.NAME
+       (GET.ARG)) (VSKIP (if FORMAT.PARSED then
+       (FLUSH.ARG) else (SETQ vskip (PARSE.NUMBER.OR.PERCENTAGE
+       (SAVE.ARG) 10 vskip)))) (HSKIP (if FORMAT.PARSED then
+       (FLUSH.ARG) else (SETQ hskip (PARSE.NUMBER.OR.PERCENTAGE
+       (SAVE.ARG) TotalWidth hskip)))) (COLUMN
+       (if FORMAT.PARSED then (FLUSH.ARG) else
+       (SETQ ColumnWidthList (CONS (PARSE.NUMBER.OR.PERCENTAGE
+       (SAVE.ARG) TotalWidth NIL) ColumnWidthList))))
+       (MULTIPAGE (if (NOT FORMAT.PARSED) then
+       (SETQ MULTIPAGE.FLG T)) (FLUSH.ARG)) (UNDERLINE
+       (SETQ UNDERLINE.FLG T) (FLUSH.ARG)) (NIL
+       (RETURN)) (PROGN (if (NOT FORMAT.PARSED) then
+       (* default format spec = 3 columns) (SETQ ColumnWidthList
+       (if (NULL ColumnWidthList) then (LIST NIL NIL NIL) else
+       (DREVERSE ColumnWidthList))) (SETQ numcol
+       (LENGTH ColumnWidthList)) (SETQ TableWidth
+       (IPLUS (ITIMES hskip (SUB1 numcol)) (for X in ColumnWidthList when
+       (NUMBERP X) sum X))) (SETQ freecol (for X in ColumnWidthList count
+       (NULL X))) (if (GREATERP TableWidth TotalWidth) then
+       (IM.WARNING "Table Spec too big --- fudging available space (may cause overlapping")
+       (SETQ TotalWidth (FIX (FTIMES TableWidth 1.1))))
+       (if (GREATERP freecol 0) then (* divide remaining space among unspecified 
+       columns) (for X on ColumnWidthList when
+       (NULL (CAR X)) do (RPLACA X (IQUOTIENT (IDIFFERENCE TotalWidth TableWidth) 
+       freecol))) (SETQ TableWidth TotalWidth))
+       (SETQ COLUMN.INDENT.WIDTH.LIST (for X in ColumnWidthList bind
+       (I _ 0) collect (PROG1 (CONS I X) (SETQ I
+       (IPLUS I X hskip))))) (SETQ col NIL) (SETQ FORMAT.PARSED T))
+       (if (AND col (EQ ARG.NAME (QUOTE FIRST))) then
+       (* if you have a "first" column item, and you are still in a line, close the 
+       line) (SETQ col NIL)) (if (SETQ BEGIN.ROW.FLG
+       (NULL col)) then (SETQ col COLUMN.INDENT.WIDTH.LIST))
+       (SETQ COLUMN.INDENT (CAR (CAR col))) (SETQ COLUMN.WIDTH
+       (CDR (CAR col))) (* specify PARALOOKS of left-justified, right-margin)
+       (SETQ COLUMN.PARALOOKS (CONS (QUOTE RIGHTMARGIN)
+       (CONS (IPLUS COLUMN.INDENT COLUMN.WIDTH)
+       (QUOTE (QUAD LEFT))))) (if BEGIN.FLG then
+       (* for very first para of table only, use default PARALEADING)
+       (SETQ BEGIN.FLG NIL) elseif BEGIN.ROW.FLG then
+       (* before a FIRST column, use PARLEADING of vskip)
+       (SETQ COLUMN.PARALOOKS (CONS (QUOTE PARALEADING)
+       (CONS vskip COLUMN.PARALOOKS))) else (* before a NEXT column, use PARALEADING 
+       of 0) (SETQ COLUMN.PARALOOKS (CONS (QUOTE PARALEADING)
+       (CONS 0 COLUMN.PARALOOKS)))) (DUMPOUT WIDTH
+       (CDR (CAR col)) PARALOOKS COLUMN.PARALOOKS START.PARA DUMP.ARG CR CR)
+       (SETQ col (CDR col)) (* currently, don't use underline)
+       (SETQ UNDERLINE.FLG NIL))) (GO loop))))
+
+    ])
+
+(TAG#TOPROG
+  [LAMBDA NIL                                            (* mjs "27-JUN-83 15:13")
+    (PROG ((SAV (SAVE.ARG)))
+          (SEND.INFO (U-CASE (PARSE.ATOM SAV))
+                 'TAG NIL)
+          (SAVE.INFILE.NOTE 'IM.TAG (PARSE.ATOM SAV])
+
+(TERM#TOPROG
+  [LAMBDA NIL                                            (* mjs "10-Apr-85 09:49")
+    (PROG ((SAV (SAVE.ARG)))
+          (IM.DUMP.CHARS SAV)
+          [SETQ ARG.ATOM (MKATOM (LIST.TO.STRING (PARSE.LIST SAV]
+          (SEND.INFO (U-CASE ARG.ATOM)
+                 'TERM ARG.ATOM NIL])
+
+(VAR#TOPROG
+  [LAMBDA NIL                                            (* mjs "13-SEP-83 17:15")
+    (PROG ((SAV (SAVE.ARG)))
+          (FORMAT.LISPWORD SAV)
+          (SEND.IMPLICIT (PARSE.ATOM SAV)
+                 '(Variable)
+                 SAV)
+          (if [AND IM.CHECK.DEFS (NOT (BOUNDP (PARSE.ATOM SAV]
+              then (SAVE.INFILE.NOTE 'UNBOUND.VAR (PARSE.ATOM SAV])
+
+(VARDEF#TOPROG
+  [LAMBDA NIL                                            (* mjs "10-Apr-85 11:17")
+    (SAVE.ARGS NAME)
+    (PROG [(NAME (PARSE.ATOM (GET.ARG.SAV NAME]
+          (if IM.CHECK.DEFS
+              then (if (NOT (BOUNDP NAME))
+                           then (PRINT.NOTE (CONCAT NAME " is unbound in Interlisp-D"))
+                                 (IM.WARNING NAME 
+                                        " is defined as a variable, but is unbound in Interlisp-D")
+                                 (SAVE.INFILE.NOTE 'UNBOUND.VAR NAME)))
+          (FORMAT.DEF NAME '(Variable)
+                 (SAVE.DUMPOUT FONT LISP DUMP.CHARS (GET.ARG.SAV NAME])
+)
+
+(RPAQQ TO.NAME.LIST 
+       (ANONARG ARG ATOM BIGLISPCODE BRACKET BREAKCOM BULLET CHAPTER COMMENT CRSYMBOL DEF EDITCOM 
+              ELLIPSIS EMDASH ENDASH FIGURE FIGUREREF FILECOM FN FNDEF FOOT GE INCLUDE INDEX INDEXX 
+              IT LABELEDLIST LBRACKET LE LISP LISPCODE MAC MACDEF NE NOTE NUMBEREDLIST PACOM PAGEREF
+              PI PLUSMINUS PROP PROPDEF RBRACKET RM SECTIONREF SP SUB SUBSEC SUPER TABLE TAG TERM 
+              UNNUMBEREDLIST VAR VARDEF))
+
+(RPAQQ TO.SYNONYM.LIST ((CR CRSYMBOL)
+                            (EMPHASIZE IT)
+                            (FOOTNOTE FOOT)
+                            (ITALICS IT)
+                            (LITATOM ATOM)
+                            (UNLABELEDLIST UNNUMBEREDLIST)))
+
+(RPAQQ TO.NAME.LIST 
+       (ANONARG ARG ATOM BIGLISPCODE BRACKET BREAKCOM BULLET CHAPTER COMMENT CRSYMBOL DEF EDITCOM 
+              ELLIPSIS EMDASH ENDASH FIGURE FIGUREREF FILECOM FN FNDEF FOOT GE INCLUDE INDEX INDEXX 
+              IT LABELEDLIST LBRACKET LE LISP LISPCODE MAC MACDEF NE NOTE NUMBEREDLIST PACOM PAGEREF
+              PI PLUSMINUS PROP PROPDEF RBRACKET RM SECTIONREF SP SUB SUBSEC SUPER TABLE TAG TERM 
+              UNNUMBEREDLIST VAR VARDEF))
+
+(PUTPROPS ANONARG TO.PROG PRINT.SPECIAL.CHARS#TOPROG)
+
+(PUTPROPS ARG TO.PROG ARG#TOPROG)
+
+(PUTPROPS ATOM TO.PROG LISPWORD#TOPROG)
+
+(PUTPROPS BIGLISPCODE TO.PROG BIGLISPCODE#TOPROG)
+
+(PUTPROPS BRACKET TO.PROG BRACKET#TOPROG)
+
+(PUTPROPS BREAKCOM TO.PROG LISPWORD#TOPROG)
+
+(PUTPROPS BULLET TO.PROG PRINT.SPECIAL.CHARS#TOPROG)
+
+(PUTPROPS CHAPTER TO.PROG CHAPTER#TOPROG)
+
+(PUTPROPS COMMENT TO.PROG COMMENT#TOPROG)
+
+(PUTPROPS CRSYMBOL TO.PROG PRINT.SPECIAL.CHARS#TOPROG)
+
+(PUTPROPS DEF TO.PROG DEF#TOPROG)
+
+(PUTPROPS EDITCOM TO.PROG LISPWORD#TOPROG)
+
+(PUTPROPS ELLIPSIS TO.PROG PRINT.SPECIAL.CHARS#TOPROG)
+
+(PUTPROPS EMDASH TO.PROG PRINT.SPECIAL.CHARS#TOPROG)
+
+(PUTPROPS ENDASH TO.PROG PRINT.SPECIAL.CHARS#TOPROG)
+
+(PUTPROPS FIGURE TO.PROG FIGURE#TOPROG)
+
+(PUTPROPS FIGUREREF TO.PROG REF#TOPROG)
+
+(PUTPROPS FILECOM TO.PROG LISPWORD#TOPROG)
+
+(PUTPROPS FN TO.PROG FN#TOPROG)
+
+(PUTPROPS FNDEF TO.PROG FNDEF#TOPROG)
+
+(PUTPROPS FOOT TO.PROG FOOT#TOPROG)
+
+(PUTPROPS GE TO.PROG PRINT.SPECIAL.CHARS#TOPROG)
+
+(PUTPROPS INCLUDE TO.PROG INCLUDE#TOPROG)
+
+(PUTPROPS INDEX TO.PROG INDEX#TOPROG)
+
+(PUTPROPS INDEXX TO.PROG INDEXX#TOPROG)
+
+(PUTPROPS IT TO.PROG IT#TOPROG)
+
+(PUTPROPS LABELEDLIST TO.PROG LIST#TOPROG)
+
+(PUTPROPS LBRACKET TO.PROG LBRACKET#TOPROG)
+
+(PUTPROPS LE TO.PROG PRINT.SPECIAL.CHARS#TOPROG)
+
+(PUTPROPS LISP TO.PROG LISP#TOPROG)
+
+(PUTPROPS LISPCODE TO.PROG LISPCODE#TOPROG)
+
+(PUTPROPS MAC TO.PROG LISPWORD#TOPROG)
+
+(PUTPROPS MACDEF TO.PROG MACDEF#TOPROG)
+
+(PUTPROPS NE TO.PROG PRINT.SPECIAL.CHARS#TOPROG)
+
+(PUTPROPS NOTE TO.PROG NOTE#TOPROG)
+
+(PUTPROPS NUMBEREDLIST TO.PROG LIST#TOPROG)
+
+(PUTPROPS PACOM TO.PROG LISPWORD#TOPROG)
+
+(PUTPROPS PAGEREF TO.PROG REF#TOPROG)
+
+(PUTPROPS PI TO.PROG PRINT.SPECIAL.CHARS#TOPROG)
+
+(PUTPROPS PLUSMINUS TO.PROG PRINT.SPECIAL.CHARS#TOPROG)
+
+(PUTPROPS PROP TO.PROG LISPWORD#TOPROG)
+
+(PUTPROPS PROPDEF TO.PROG PROPDEF#TOPROG)
+
+(PUTPROPS RBRACKET TO.PROG RBRACKET#TOPROG)
+
+(PUTPROPS RM TO.PROG RM#TOPROG)
+
+(PUTPROPS SECTIONREF TO.PROG REF#TOPROG)
+
+(PUTPROPS SP TO.PROG PRINT.SPECIAL.CHARS#TOPROG)
+
+(PUTPROPS SUB TO.PROG SUB#TOPROG)
+
+(PUTPROPS SUBSEC TO.PROG SUBSEC#TOPROG)
+
+(PUTPROPS SUPER TO.PROG SUPER#TOPROG)
+
+(PUTPROPS TABLE TO.PROG TABLE#TOPROG)
+
+(PUTPROPS TAG TO.PROG TAG#TOPROG)
+
+(PUTPROPS TERM TO.PROG TERM#TOPROG)
+
+(PUTPROPS UNNUMBEREDLIST TO.PROG LIST#TOPROG)
+
+(PUTPROPS VAR TO.PROG VAR#TOPROG)
+
+(PUTPROPS VARDEF TO.PROG VARDEF#TOPROG)
+
+(PUTPROPS CHAPTER TO.ARGS ((TITLE NUMBER)
+                               TEXT))
+
+(PUTPROPS DEF TO.ARGS ((TYPE NAME PRINTNAME ARGS PARENS NOPARENS)
+                           TEXT))
+
+(PUTPROPS FIGURE TO.ARGS ((TAG)
+                              (TEXT)
+                              (CAPTION)))
+
+(PUTPROPS FNDEF TO.ARGS (NAME (ARGS)
+                                  (TYPE)
+                                  TEXT))
+
+(PUTPROPS INDEXX TO.ARGS ((TYPE NAME INFO TEXT SUBNAME SUBTYPE SUBTEXT SUBSUBNAME SUBSUBTYPE 
+                                    SUBSUBTEXT)))
+
+(PUTPROPS LABELEDLIST TO.ARGS ((LNAME NAME ITEM INDENT MAX UNINDENTED)))
+
+(PUTPROPS MACDEF TO.ARGS (NAME (ARGS)
+                                   (TYPE)
+                                   TEXT))
+
+(PUTPROPS NUMBEREDLIST TO.ARGS ((ITEM)))
+
+(PUTPROPS PROPDEF TO.ARGS (NAME TEXT))
+
+(PUTPROPS SUBSEC TO.ARGS (TITLE TEXT))
+
+(PUTPROPS TABLE TO.ARGS ((FIRST NEXT COLUMN UNDERLINE MULTIPAGE HSKIP VSKIP)))
+
+(PUTPROPS UNNUMBEREDLIST TO.ARGS ((ITEM)))
+
+(PUTPROPS VARDEF TO.ARGS (NAME TEXT))
+
+(PUTPROPS FNDEF TO.ARG.SYNONYMS (FNNAME NAME FNARGS ARGS FNTYPE TYPE))
+
+(PUTPROPS LABELEDLIST TO.ARG.SYNONYMS (LABEL NAME TEXT ITEM UNINDENT UNINDENTED UNLABELED 
+                                                 UNINDENTED UNLABEL UNINDENTED))
+
+(PUTPROPS NUMBEREDLIST TO.ARG.SYNONYMS (TEXT ITEM))
+
+(PUTPROPS TABLE TO.ARG.SYNONYMS (COL COLUMN MULTI MULTIPAGE))
+
+(PUTPROPS UNNUMBEREDLIST TO.ARG.SYNONYMS (TEXT ITEM))
+
+(PUTPROPS ANONARG TO.TYPE SIMPLE)
+
+(PUTPROPS ARG TO.TYPE SIMPLE)
+
+(PUTPROPS ATOM TO.TYPE SIMPLE)
+
+(PUTPROPS BIGLISPCODE TO.TYPE NIL)
+
+(PUTPROPS BRACKET TO.TYPE SIMPLE)
+
+(PUTPROPS BREAKCOM TO.TYPE SIMPLE)
+
+(PUTPROPS BULLET TO.TYPE SIMPLE)
+
+(PUTPROPS CHAPTER TO.TYPE NIL)
+
+(PUTPROPS COMMENT TO.TYPE SIMPLE)
+
+(PUTPROPS CRSYMBOL TO.TYPE SIMPLE)
+
+(PUTPROPS EDITCOM TO.TYPE SIMPLE)
+
+(PUTPROPS ELLIPSIS TO.TYPE SIMPLE)
+
+(PUTPROPS EMDASH TO.TYPE SIMPLE)
+
+(PUTPROPS ENDASH TO.TYPE SIMPLE)
+
+(PUTPROPS FIGURE TO.TYPE NIL)
+
+(PUTPROPS FIGUREREF TO.TYPE SIMPLE)
+
+(PUTPROPS FILECOM TO.TYPE SIMPLE)
+
+(PUTPROPS FN TO.TYPE SIMPLE)
+
+(PUTPROPS FNDEF TO.TYPE NIL)
+
+(PUTPROPS FOOT TO.TYPE SIMPLE)
+
+(PUTPROPS GE TO.TYPE SIMPLE)
+
+(PUTPROPS INCLUDE TO.TYPE SIMPLE)
+
+(PUTPROPS INDEX TO.TYPE SIMPLE)
+
+(PUTPROPS INDEXX TO.TYPE SIMPLE)
+
+(PUTPROPS IT TO.TYPE SIMPLE)
+
+(PUTPROPS LABELEDLIST TO.TYPE NIL)
+
+(PUTPROPS LBRACKET TO.TYPE SIMPLE)
+
+(PUTPROPS LE TO.TYPE SIMPLE)
+
+(PUTPROPS LISP TO.TYPE SIMPLE)
+
+(PUTPROPS LISPCODE TO.TYPE NIL)
+
+(PUTPROPS MAC TO.TYPE SIMPLE)
+
+(PUTPROPS MACDEF TO.TYPE NIL)
+
+(PUTPROPS NE TO.TYPE SIMPLE)
+
+(PUTPROPS NOTE TO.TYPE SIMPLE)
+
+(PUTPROPS NUMBEREDLIST TO.TYPE NIL)
+
+(PUTPROPS PACOM TO.TYPE SIMPLE)
+
+(PUTPROPS PAGEREF TO.TYPE SIMPLE)
+
+(PUTPROPS PI TO.TYPE SIMPLE)
+
+(PUTPROPS PLUSMINUS TO.TYPE SIMPLE)
+
+(PUTPROPS PROP TO.TYPE SIMPLE)
+
+(PUTPROPS PROPDEF TO.TYPE NIL)
+
+(PUTPROPS RBRACKET TO.TYPE SIMPLE)
+
+(PUTPROPS RM TO.TYPE SIMPLE)
+
+(PUTPROPS SECTIONREF TO.TYPE SIMPLE)
+
+(PUTPROPS SP TO.TYPE SIMPLE)
+
+(PUTPROPS SUB TO.TYPE SIMPLE)
+
+(PUTPROPS SUBSEC TO.TYPE NIL)
+
+(PUTPROPS SUPER TO.TYPE SIMPLE)
+
+(PUTPROPS TABLE TO.TYPE NIL)
+
+(PUTPROPS TAG TO.TYPE SIMPLE)
+
+(PUTPROPS TERM TO.TYPE SIMPLE)
+
+(PUTPROPS UNNUMBEREDLIST TO.TYPE NIL)
+
+(PUTPROPS VAR TO.TYPE SIMPLE)
+
+(PUTPROPS VARDEF TO.TYPE NIL)
+
+(PUTPROPS ANONARG TO.ARG.TYPE CHARS)
+
+(PUTPROPS ARG TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS ATOM TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS BIGLISPCODE TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS BRACKET TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS BREAKCOM TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS BULLET TO.ARG.TYPE CHARS)
+
+(PUTPROPS CHAPTER TO.ARG.TYPE (TITLE SIMPLE NUMBER CHARS))
+
+(PUTPROPS COMMENT TO.ARG.TYPE NIL)
+
+(PUTPROPS CRSYMBOL TO.ARG.TYPE CHARS)
+
+(PUTPROPS DEF TO.ARG.TYPE (TYPE CHARS NAME SIMPLE PRINTNAME SIMPLE PARENS CHARS NOPARENS CHARS))
+
+(PUTPROPS EDITCOM TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS ELLIPSIS TO.ARG.TYPE CHARS)
+
+(PUTPROPS EMDASH TO.ARG.TYPE CHARS)
+
+(PUTPROPS ENDASH TO.ARG.TYPE CHARS)
+
+(PUTPROPS FIGURE TO.ARG.TYPE (TAG CHARS))
+
+(PUTPROPS FIGUREREF TO.ARG.TYPE CHARS)
+
+(PUTPROPS FILECOM TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS FN TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS FNDEF TO.ARG.TYPE (NAME SIMPLE ARGS SIMPLE TYPE CHARS))
+
+(PUTPROPS FOOT TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS GE TO.ARG.TYPE CHARS)
+
+(PUTPROPS INCLUDE TO.ARG.TYPE CHARS)
+
+(PUTPROPS INDEX TO.ARG.TYPE CHARS)
+
+(PUTPROPS INDEXX TO.ARG.TYPE 
+          (TYPE CHARS NAME CHARS INFO CHARS TEXT SIMPLE SUBNAME CHARS SUBTYPE CHARS SUBTEXT SIMPLE 
+                SUBSUBNAME CHARS SUBSUBTYPE CHARS SUBSUBTEXT SIMPLE))
+
+(PUTPROPS IT TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS LABELEDLIST TO.ARG.TYPE (LNAME SIMPLE NAME SIMPLE INDENT CHARS MAX CHARS))
+
+(PUTPROPS LBRACKET TO.ARG.TYPE CHARS)
+
+(PUTPROPS LE TO.ARG.TYPE CHARS)
+
+(PUTPROPS LISP TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS LISPCODE TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS MAC TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS MACDEF TO.ARG.TYPE (NAME SIMPLE ARGS SIMPLE TYPE CHARS))
+
+(PUTPROPS NE TO.ARG.TYPE CHARS)
+
+(PUTPROPS NOTE TO.ARG.TYPE NIL)
+
+(PUTPROPS NUMBEREDLIST TO.ARG.TYPE NIL)
+
+(PUTPROPS PACOM TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS PAGEREF TO.ARG.TYPE CHARS)
+
+(PUTPROPS PI TO.ARG.TYPE CHARS)
+
+(PUTPROPS PLUSMINUS TO.ARG.TYPE CHARS)
+
+(PUTPROPS PROP TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS PROPDEF TO.ARG.TYPE (NAME SIMPLE))
+
+(PUTPROPS RBRACKET TO.ARG.TYPE CHARS)
+
+(PUTPROPS RM TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS SECTIONREF TO.ARG.TYPE CHARS)
+
+(PUTPROPS SP TO.ARG.TYPE CHARS)
+
+(PUTPROPS SUB TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS SUBSEC TO.ARG.TYPE (TITLE SIMPLE))
+
+(PUTPROPS SUPER TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS TABLE TO.ARG.TYPE (COLUMN CHARS UNDERLINE CHARS MULTIPAGE CHARS HSKIP CHARS VSKIP CHARS
+                                       ))
+
+(PUTPROPS TAG TO.ARG.TYPE CHARS)
+
+(PUTPROPS TERM TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS UNNUMBEREDLIST TO.ARG.TYPE NIL)
+
+(PUTPROPS VAR TO.ARG.TYPE SIMPLE)
+
+(PUTPROPS VARDEF TO.ARG.TYPE (NAME SIMPLE))
+
+(RPAQ? IM.TEDIT.FONT.DEFS '(NIL (FAMILY MODERN FACE MRR SIZE 10)
+                                    FOOTNOTE
+                                    (FAMILY MODERN FACE MRR SIZE 10)
+                                    NOTE
+                                    (FAMILY MODERN FACE MIR SIZE 8)
+                                    BOLD
+                                    (FAMILY MODERN FACE BRR SIZE 10)
+                                    ITALIC
+                                    (FAMILY MODERN FACE MIR SIZE 10)
+                                    LISP
+                                    (FAMILY MODERN FACE BRR SIZE 10)
+                                    ARG
+                                    (FAMILY MODERN FACE MIR SIZE 10)))
+
+(RPAQ? IM.CHAPTER.TITLE.FONT '(FAMILY MODERN FACE BRR SIZE 18))
+
+(RPAQ? IM.SUBSEC.ONE.TITLE.FONT '(FAMILY MODERN SIZE 14 FACE BRR))
+
+(RPAQ? IM.SUBSEC.TWO.TITLE.FONT '(FAMILY MODERN SIZE 12 FACE BRR))
+
+(RPAQ? IM.SUBSEC.THREE.TITLE.FONT '(FAMILY MODERN SIZE 10 FACE BRR))
+
+(RPAQ? IM.TEXT.FONT '(FAMILY MODERN FACE MRR SIZE 10))
+
+(RPAQ? IM.HEADER.FOOTER.FONT '(FAMILY MODERN FACE MRR SIZE 8))
+
+(RPAQ? IM.XEROX.LOGO.FONT '(FAMILY MODERN FACE BRR SIZE 30))
+
+
+
+(* the following variables specify all of the lengths used for possitioning IM text, headers, etc. 
+on the page. All of these are measured with respect to the page *margins* <the region on the page 
+defined by the Tedit margin parameters> or with respect to the page *edges* <the edges of the physical
+ page>.)
+
+
+
+
+(* Note%: The formatting and printing does not always position the image on the page exactly as 
+specified. It will probably be necessary to adjust any variables based on the page edges until they 
+come out correctly on your printer.)
+
+
+
+
+(* indentation of 1st line of definitian header, measured in points from left page margin. Also used
+ for indentation of hrule under defn header.)
+
+
+(RPAQ? IM.DEF.TITLE.1STLEFTMARGIN 75)
+
+
+
+(* indentation of 2nd and other overflow lines of definition header, measured in points from left 
+page margin.)
+
+
+(RPAQ? IM.DEF.TITLE.LEFTMARGIN 204)
+
+
+
+(* indentation of vertical rule to the left of definition text, measured in points from left page 
+margin. This is a never-used, never-debugged feature.)
+
+
+(RPAQ? IM.VRULE.X 194)
+
+
+
+(* y-pos of top-left corner of top text line, measured in points from bottom page edge.)
+
+
+(RPAQ? IM.TEXT.TOPMARGIN 738)
+
+
+
+(* y-pos of bottom-left corner of bottom text line, measured in points from bottom page edge.)
+
+
+(RPAQ? IM.TEXT.BOTTOMMARGIN 54)
+
+
+
+(* x-pos of left edge of text, measured in points from the left page margin.)
+
+
+(RPAQ? IM.TEXT.LEFTMARGIN 204)
+
+
+
+(* x-pos of right edge of text, measured in points from the left page margin.)
+
+
+(RPAQ? IM.TEXT.RIGHTMARGIN 504)
+
+
+
+(* X-pos and Y-pos of the lower-left corner of the "[This page intentionally left blank]" message 
+printed on blank pages, measured in points from the left and bottom page edges.)
+
+
+(RPAQ? IM.BLANKPAGE.SPECIALX 258)
+
+(RPAQ? IM.BLANKPAGE.SPECIALY 400)
+
+
+
+(* In the table of contents, indentation of first and second-level subsection headers, measured in 
+points from the left page margin.)
+
+
+(RPAQ? IM.TOC.SUBSEC.ONE.LEFTMARGIN 120)
+
+(RPAQ? IM.TOC.SUBSEC.TWO.LEFTMARGIN 216)
+
+
+
+(* in the index, the indentation of the first line and remaining lines of a top-level entry, of a 
+subentry, and of a subsubentry, measured in points from the left page margin <for the left column>.)
+
+
+(RPAQ? IM.INDEX.1STLEFTMARGIN 0)
+
+(RPAQ? IM.INDEX.LEFTMARGIN 75)
+
+(RPAQ? IM.INDEX.SUB.1STLEFTMARGIN 25)
+
+(RPAQ? IM.INDEX.SUB.LEFTMARGIN 75)
+
+(RPAQ? IM.INDEX.SUBSUB.1STLEFTMARGIN 50)
+
+(RPAQ? IM.INDEX.SUBSUB.LEFTMARGIN 75)
+
+
+
+(* on the title page, the y-pos of the lower-left corner of the first line in the title <and of the 
+XEROX logo>, measured in points from the bottom page margin. The X-pos is always 0 for the XEROX logo,
+ and the normal text indentation for the title.)
+
+
+(RPAQ? IM.TITLEPAGE.TITLE.Y 258)
+
+
+
+(* on the title page, the y-pos of the lower-left corner of the first line in the document number, 
+measured in points from the bottom page margin. The Y-pos is always the normal text indentation.)
+
+
+(RPAQ? IM.TITLEPAGE.DOCNUMBER.Y 45)
+
+
+
+(* Tedit tab setting used for subsection heading text. "(40 . LEFT)" determines the indentation of 
+the title after the subsec number, measured in points from the left page margin. "18" is the tab used 
+if the subsec number is wider than 40 pts.)
+
+
+(RPAQ? IM.SUBSEC.TITLE.TABS '(18 (40 . LEFT)))
+
+
+
+(* Tedit tab setting used for chapter titles, headers, and footers to right-justify text. 
+"(504 . RIGHT)" specifies a right tab at the right-hand edge of the text, measured in points from the 
+left page margin.)
+
+
+(RPAQ? IM.RIGHT.MARGIN.TABS '(0 (504 . RIGHT)))
+
+
+
+(* Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists. "(186 . RIGHT)" 
+right-justifies the label on the left of the center space. "(204 . LEFT)" starts the first line of the
+ list item with the same indentation as normal text. Both measurements are measured in points from the
+ left page margin.)
+
+
+(RPAQ? IM.LABELED.LIST.TABS '(18 (186 . RIGHT)
+                                     (204 . LEFT)))
+
+
+
+(* left, right, top, and bottom margins of the "page region" %, measured in points from the four 
+edges of the page.)
+
+
+(RPAQ? IM.PAGE.LEFTMARGIN 58)
+
+(RPAQ? IM.PAGE.RIGHTMARGIN 54)
+
+(RPAQ? IM.PAGE.TOPMARGIN 54)
+
+(RPAQ? IM.PAGE.BOTTOMMARGIN 54)
+
+
+
+(* top margin of the page region for the first page of a chapter <where the first paragraph is the 
+chapter title>, measured in points from the top page edge.)
+
+
+(RPAQ? IM.PAGE.FIRST.TOPMARGIN 12)
+
+
+
+(* top margin of the page region for the first page of the index, measured in points from the top 
+page edge. Note that in the case of the index, because it uses two columns, the index title is 
+implemented as a Tedit header, instead of as the first paragraph of the document.)
+
+
+(RPAQ? IM.INDEX.PAGE.FIRST.TOPMARGIN 144)
+
+
+
+(* y-pos of lower-left corner of footer text, measured in points from the bottom page edge.)
+
+
+(RPAQ? IM.FOOTER.Y 22)
+
+
+
+(* y-pos of the footer hrule, measured in points from the bottom page edge.)
+
+
+(RPAQ? IM.FOOTER.RULE.Y 30)
+
+
+
+(* y-pos of lower-left corner of header text, measured in points from the bottom page edge.)
+
+
+(RPAQ? IM.HEADER.Y 761)
+
+
+
+(* y-pos of the header hrule, measured in points from the bottom page edge.)
+
+
+(RPAQ? IM.HEADER.RULE.Y 757)
+
+
+
+(* y-pos of lower-left corner of bottom draft message, measured in points from the bottom page edge.
+)
+
+
+(RPAQ? IM.DRAFT.MESSAGE.BOTTOM.Y 5)
+
+
+
+(* y-pos of lower-left corner of top draft message, measured in points from the bottom page edge.)
+
+
+(RPAQ? IM.DRAFT.MESSAGE.TOP.Y 775)
+
+
+
+(* x-pos of lower-left corner of both top and bottom draft messages, measured in points from the 
+left page edge.)
+
+
+(RPAQ? IM.DRAFT.MESSAGE.X 200)
+
+(FILESLOAD TEDIT IMTRAN HRULE IMINDEX)
+(DEFINEQ
+
+(TRANSLATE.DUMPOUT
+  [LAMBDA (DUMPOUT.ARGS)                                 (* mjs "18-Sep-85 16:17")
+
+         (* * this function translates the DUMPOUT macro form into a PROGN form that 
+       calls a series of functions, such as DUMP.)
+
+         (* * the indentation code has been commented out ---
+       will try indenting everything to same, unless specified otherwise with 
+       PARALOOKS)
+
+    (PROG ((DUMPOUT.FORMS NIL)
+           (DUMPOUT.UNDO NIL)
+           COMM COMM.ARG)
+          [while DUMPOUT.ARGS do (SELECTQ (SETQ COMM (pop DUMPOUT.ARGS))
+                                             (NIL)
+                                             ((CR TAB START.PARA DUMP.FOOTNOTES START.SUPER START.SUB
+                                                  END.SUPER END.SUB) 
+                                                             (* just pass these atoms as commands 
+                                                           to DUMP)
+                                                  (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT
+                                                                                (KWOTE COMM))))
+                                             ((FLUSH.ARG TRIVIAL.ARG DUMP.ARG) 
+                                                  (push DUMPOUT.FORMS (LIST COMM)))
+                                             (INDENT 
+
+         (* * SELECTQ (SETQ COMM.ARG (pop DUMPOUT.ARGS))
+       (INIT (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
+       (QUOTE INDENT) INITIAL.INDENT))) (push DUMPOUT.FORMS
+       (QUOTE (PUT.MY.PROP (QUOTE WIDTH) INITIAL.WIDTH)))
+       (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT
+       (QUOTE INDENT) INITIAL.INDENT)))) (NONE
+       (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
+       (QUOTE INDENT) (QUOTE NONE)))) (push DUMPOUT.FORMS
+       (QUOTE (PUT.MY.PROP (QUOTE WIDTH) (ANC.WIDTH))))
+       (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT
+       (QUOTE INDENT) (QUOTE NONE))))) (push DUMPOUT.FORMS
+       (LIST (QUOTE (LAMBDA (I) (PUT.MY.PROP (QUOTE INDENT)
+       (IPLUS (ANC.INDENT) I)) (PUT.MY.PROP (QUOTE WIDTH)
+       (IDIFFERENCE (ANC.WIDTH) I)) (DUMP.FORMAT
+       (QUOTE INDENT) (IPLUS (ANC.INDENT) I)))) COMM.ARG)))
+
+         (* * push DUMPOUT.UNDO (QUOTE INDENT))
+
+                                                     (SETQ COMM.ARG (pop DUMPOUT.ARGS)))
+                                             (WIDTH (push DUMPOUT.FORMS
+                                                           (LIST 'PUT.MY.PROP (KWOTE 'WIDTH)
+                                                                 (pop DUMPOUT.ARGS))))
+                                             (FONT (SETQ COMM.ARG (pop DUMPOUT.ARGS))
+                                                   [push DUMPOUT.FORMS
+                                                          (LIST 'DUMP.FORMAT (KWOTE 'FONT)
+                                                                (COND
+                                                                   ((LISTGET IM.TEDIT.FONT.DEFS 
+                                                                           COMM.ARG)
+                                                                    (KWOTE COMM.ARG))
+                                                                   (T COMM.ARG]
+                                                   (push DUMPOUT.UNDO 'FONT))
+                                             (PARALOOKS (push DUMPOUT.FORMS
+                                                               (LIST 'DUMP.FORMAT (KWOTE 'PARALOOKS)
+                                                                     (pop DUMPOUT.ARGS))))
+                                             (DUMP.CHARS (push DUMPOUT.FORMS
+                                                                (LIST (FUNCTION IM.DUMP.CHARS)
+                                                                      (pop DUMPOUT.ARGS))))
+                                             (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT
+                                                                           (KWOTE 'TEXT)
+                                                                           (LIST 'MAKE.SAVE COMM]
+          [for X in DUMPOUT.UNDO do (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT
+                                                                              (KWOTE 'UNDO)
+                                                                              (KWOTE X]
+
+         (* * push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
+       (QUOTE INDENT) DUMPOUT.SAVE.INDENT)))
+
+         (* * push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
+       (QUOTE WIDTH) DUMPOUT.SAVE.WIDTH)))
+
+         (* * RETURN (APPEND (QUOTE (PROG ((DUMPOUT.SAVE.INDENT
+       (GET.MY.PROP (QUOTE INDENT))) (DUMPOUT.SAVE.WIDTH
+       (GET.MY.PROP (QUOTE WIDTH)))))) (DREVERSE DUMPOUT.FORMS)))
+
+          (RETURN (CONS 'PROGN (DREVERSE DUMPOUT.FORMS])
+
+(TRANSLATE.SAVE.DUMPOUT
+  [LAMBDA (SAVE.DUMPOUT.ARGS)                            (* mjs "12-Jan-84 15:00")
+    (LSUBST SAVE.DUMPOUT.ARGS 'XXX '(PROG ((GOBBLE.SAVE.CONC (CONS)))
+                                          (DECLARE (SPECVARS GOBBLE.SAVE.CONC))
+                                          (DUMPOUT XXX)
+                                          (RETURN GOBBLE.SAVE.CONC])
+)
+(DECLARE%: EVAL@COMPILE 
+
+[PUTPROPS IM.HOLD.FOOTNOTES MACRO (X `(PROG NIL
+                                            (PUT.MY.PROP 'PASSFOOT T)
+                                        %,@
+                                        X   (PUT.MY.PROP 'PASSFOOT NIL)
+                                            (DUMPOUT CR CR DUMP.FOOTNOTES]
+
+(PUTPROPS DUMPOUT MACRO (X (TRANSLATE.DUMPOUT X)))
+
+(PUTPROPS SAVE.DUMPOUT MACRO (X (TRANSLATE.SAVE.DUMPOUT X)))
+)
+(PUTPROPS IMTEDIT COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986 1991))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (10973 37992 (IM.TEDIT 10983 . 12664) (DUMP 12666 . 14961) (DUMP.HEADERS.FOOTERS 14963
+ . 17329) (DUMP.HRULE 17331 . 18482) (CHANGE.FONT 18484 . 19678) (IM.BOUT.IMAGEOBJ 19680 . 20003) (
+IM.TEDIT.DUMP.COMMANDS 20005 . 23558) (IM.TEDIT.DUMP.FOOTNOTES 23560 . 24001) (IM.TEDIT.DUMP.PARA 
+24003 . 24777) (INDEXX.PARSE.TYPE 24779 . 26074) (FORMAT.DEF 26076 . 28207) (FORMAT.LISPWORD 28209 . 
+28360) (MAKE.IM.DOCUMENT 28362 . 36847) (PRINT.NOTE 36849 . 37063) (SEND.INFO 37065 . 37990)) (38101 
+42119 (IM.VRULE.DISPLAYFN 38111 . 38435) (CREATE.VRULE.OBJECT 38437 . 40217) (PRINT.VRULES.ON.PAGE 
+40219 . 42117)) (42277 47032 (IM.FOLIO.DISPLAYFN 42287 . 42965) (IM.FOLIO.SIZEFN 42967 . 43816) (
+CREATE.FOLIO.OBJECT 43818 . 45364) (GET.FOLIO.STRING 45366 . 47030)) (47164 93404 (ARG#TOPROG 47174 . 
+47313) (BIGLISPCODE#TOPROG 47315 . 48551) (BRACKET#TOPROG 48553 . 48717) (CHAPTER#TOPROG 48719 . 51400
+) (COMMENT#TOPROG 51402 . 51954) (DEF#TOPROG 51956 . 55291) (FIGURE#TOPROG 55293 . 56637) (FN#TOPROG 
+56639 . 57036) (FNDEF#TOPROG 57038 . 60930) (FOOT#TOPROG 60932 . 61473) (INCLUDE#TOPROG 61475 . 61790)
+ (INDEX#TOPROG 61792 . 62882) (INDEXX#TOPROG 62884 . 64965) (IT#TOPROG 64967 . 65108) (LBRACKET#TOPROG
+ 65110 . 65264) (LISP#TOPROG 65266 . 65407) (LISPCODE#TOPROG 65409 . 66528) (LISPWORD#TOPROG 66530 . 
+67270) (LIST#TOPROG 67272 . 71694) (MACDEF#TOPROG 71696 . 72874) (NOTE#TOPROG 72876 . 73556) (
+PRINT.SPECIAL.CHARS#TOPROG 73558 . 74535) (PROPDEF#TOPROG 74537 . 74814) (RBRACKET#TOPROG 74816 . 
+74970) (REF#TOPROG 74972 . 82811) (RM#TOPROG 82813 . 82951) (SUB#TOPROG 82953 . 83101) (SUBSEC#TOPROG 
+83103 . 87606) (SUPER#TOPROG 87608 . 87762) (TABLE#TOPROG 87764 . 91716) (TAG#TOPROG 91718 . 91985) (
+TERM#TOPROG 91987 . 92300) (VAR#TOPROG 92302 . 92705) (VARDEF#TOPROG 92707 . 93402)) (110656 116084 (
+TRANSLATE.DUMPOUT 110666 . 115683) (TRANSLATE.SAVE.DUMPOUT 115685 . 116082)))))
+STOP
diff --git a/docs/Documentation Tools/IMTEDIT.LCOM b/docs/Documentation Tools/IMTEDIT.LCOM
new file mode 100644
index 00000000..1e48a11d
Binary files /dev/null and b/docs/Documentation Tools/IMTEDIT.LCOM differ
diff --git a/docs/Documentation Tools/IMTEDIT.TEDIT b/docs/Documentation Tools/IMTEDIT.TEDIT
new file mode 100644
index 00000000..f5ca7018
Binary files /dev/null and b/docs/Documentation Tools/IMTEDIT.TEDIT differ
diff --git a/docs/Documentation Tools/IMTOOLS b/docs/Documentation Tools/IMTOOLS
new file mode 100644
index 00000000..2490007b
--- /dev/null
+++ b/docs/Documentation Tools/IMTOOLS	
@@ -0,0 +1,1041 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(FILECREATED " 8-Dec-91 15:13:17" {DSK}<users>sybalsky>PUBS>IMTOOLS.;2 65965  
+
+      changes to%:  (VARS IMTOOLSCOMS)
+                    (FNS GRAB.IMPTR PRINT.INDEX.OBJECT REF.TO.PAGE)
+
+      previous date%: " 4-Sep-91 18:04:53" {DSK}<users>sybalsky>PUBS>IMTOOLS.;1)
+
+
+(* ; "
+Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT IMTOOLSCOMS)
+
+(RPAQQ IMTOOLSCOMS 
+       (                                                     (* ; 
+                                                  "Maintainance Functions: generating indexes, etc")
+        (FNS ADD.IM.MENU COLLECT.MODIFIED.IM.CHAPTERS DO.INDEX DO.MANUAL GRAB.IM.MANUAL.PTRS 
+             GRAB.IMPTR IM.COMMAND.MENU IM.TEDIT.SELECTION INIT.INDEX.VARS INSERT.CHARS.AROUND.SEL 
+             INTERPRET.IM.MENU.COMMAND MAKE.IM.TITLE MAKE.IM.TOC NEWTO PRINT.INDEX.OBJECT 
+             PRINT.INDEX.SUBREFS PROCESS.IM.CHAPTERS REF.TO.PAGE REFS.TO.PAGES)
+        (COMS (FNS MAKE.IM.INDEX))
+        (VARS IM.MANUAL.CHAPTERS IM.MANUAL.VOLUMES)
+        (VARS (IM.MANUAL.DIRECTORY '"{PELE:}<DOC>IRM>"))
+        (FILES IMTEDIT FREEMENU)))
+
+
+
+(* ; "Maintainance Functions: generating indexes, etc")
+
+(DEFINEQ
+
+(ADD.IM.MENU
+  [LAMBDA (WINDOW)                                       (* mjs "12-Jul-85 15:20")
+    (ATTACHMENU (create MENU
+                       ITEMS _ '(fn var arg lisp FnDef VarDef Text Name Args lispcode U-CASE CLOSE)
+                       WHENSELECTEDFN _ (FUNCTION INTERPRET.IM.MENU.COMMAND))
+           WINDOW
+           'RIGHT
+           'TOP])
+
+(COLLECT.MODIFIED.IM.CHAPTERS
+  [LAMBDA NIL                                            (* mjs "29-Jul-85 17:09")
+                                                             (* check which chapters have been 
+                                                           updated since they were last 
+                                                           processed)
+    (for CHAPTER.FILE.LIST in IM.MANUAL.CHAPTERS
+       when (PROG ((IPFILE (FINDFILE (PACKFILENAME 'EXTENSION 'IP 'BODY (CADR CHAPTER.FILE.LIST))
+                                      T))
+                       (IMPTRFILE (FINDFILE (PACKFILENAME 'EXTENSION 'IMPTR 'BODY (CADR 
+                                                                                    CHAPTER.FILE.LIST
+                                                                                        ))
+                                         T))
+                       EARLIEST.IDATE)
+                      (printout T "checking " (CADR CHAPTER.FILE.LIST)
+                             "...")
+                      (if (OR (NULL IPFILE)
+                                  (NULL IMPTRFILE))
+                          then                           (* process if IP or IMPTR file 
+                                                           doesn't exist)
+                                (printout T "will reprocess" T)
+                                (RETURN T))
+                      [SETQ EARLIEST.IDATE (IMIN (GETFILEINFO IPFILE 'ICREATIONDATE)
+                                                 (GETFILEINFO IMPTRFILE 'ICREATIONDATE]
+                      (if (for IMFILE in (CDR CHAPTER.FILE.LIST) bind FULLFILE
+                                 thereis (AND (SETQ FULLFILE (FINDFILE (PACKFILENAME 'EXTENSION
+                                                                                  'IM
+                                                                                  'BODY IMFILE)
+                                                                        T))
+                                                  (IGREATERP (GETFILEINFO FULLFILE 'ICREATIONDATE)
+                                                         EARLIEST.IDATE)))
+                          then (printout T "will reprocess" T)
+                                (RETURN T)
+                        else (printout T "OK" T)
+                              (RETURN NIL))) collect (LIST (CAR CHAPTER.FILE.LIST)
+                                                               (CADR CHAPTER.FILE.LIST])
+
+(DO.INDEX
+  [LAMBDA NIL                                            (* mjs "23-Sep-85 14:10")
+    (printout T "creating Index" T)
+    (MAKE.IM.INDEX '{DSK}ChapIndex.IP IM.MANUAL.VOLUMES)
+    [if (INFILEP '{DSK}ChapIndex.IP)
+        then (RENAMEFILE '{DSK}ChapIndex.IP (PACK* IM.MANUAL.DIRECTORY 'ChapIndex.IP]
+    (for X in (CONS '(Master)
+                            IM.MANUAL.VOLUMES) bind LOCALFILE REMOTEFILE
+       do (SETQ LOCALFILE (PACK* '{DSK}ChapTOC- (CAR X)
+                                     '.IP))
+             (SETQ REMOTEFILE (PACK* IM.MANUAL.DIRECTORY 'ChapTOC- (CAR X)
+                                     '.IP))
+             (printout T "creating TOC for vol: " (CAR X)
+                    T)
+             (MAKE.IM.TOC LOCALFILE (CDR X))
+             (if (INFILEP LOCALFILE)
+                 then (RENAMEFILE LOCALFILE REMOTEFILE)))
+    (for X in IM.MANUAL.CHAPTERS do (printout T "making TOC for chapter: " X T)
+                                               (MAKE.IM.TOC (PACK* IM.MANUAL.DIRECTORY
+                                                                       (CADR X)
+                                                                       '-TOC.IP)
+                                                      (CAR X)))
+    (for X in '((I "Volume I: Language" 3101272 "October, 1985")
+                        (II "Volume II: Environment" 3101273 "October, 1985")
+                        (III "Volume III: Input/Output" 3101274 "October, 1985"))
+       do (MAKE.IM.TITLE (PACK* IM.MANUAL.DIRECTORY "ChapTitle-" (CAR X)
+                                        '.IP)
+                     (CADR X)
+                     (CADDR X)
+                     (CADDDR X])
+
+(DO.MANUAL
+  [LAMBDA (CHAPNAMES MAKE.INDEX.FLG GET.REFS NO.IP.FLG)  (* mjs "12-Oct-85 14:18")
+    (PROG ((IM.NOTE.FLG NIL)
+           (IM.CHECK.DEFS NIL)
+           (IM.REF.FLG NIL)
+           (IM.INDEX.FILE.FLG T)
+           (IM.DRAFT.FLG NIL)
+           (IM.EVEN.FLG T))
+          (CNDIR '{DSK})
+          (if GET.REFS
+              then (INIT.INDEX.VARS)
+                    (GRAB.IM.MANUAL.PTRS)
+                    (SETQ IM.REF.FLG T))
+          (PROCESS.IM.CHAPTERS CHAPNAMES NO.IP.FLG)
+          (if MAKE.INDEX.FLG
+              then (INIT.INDEX.VARS)
+                    (GRAB.IM.MANUAL.PTRS)
+                    (DO.INDEX])
+
+(GRAB.IM.MANUAL.PTRS
+  [LAMBDA NIL                                            (* mjs "25-Sep-85 15:47")
+    (INIT.INDEX.VARS)
+    (for X in IM.MANUAL.CHAPTERS unless (MEMB (U-CASE (CADR X))
+                                                          '(CHAPACK CHAT))
+       do (GRAB.IMPTR (PACKFILENAME 'BODY (CADR X)
+                                     'BODY IM.MANUAL.DIRECTORY])
+
+(GRAB.IMPTR
+  [LAMBDA (IMPTR.FILE.NAME KEEP.IMPLICIT.REFS.FLG IMPTR.TYPES)
+                                                             (* ; "Edited  8-Dec-91 14:20 by jds")
+
+    (* ;; "Reads the IMPTR file IMPTR.FILE.NAME, and puts the refs in the variables IMPTR.HASH IMPTR.TOC.LIST IMPTR.NAME.LIST.  If KEEP.IMPLICIT.REFS.FLG is non-NIL, implicit references are kept.  If IMPTR.TYPES is non-NIL, it should be a list of reference types <as lists> that should be retrieved.  For example 'IMPTR.TYPES=((Function)(Variable))' to retrieve only function and variable references.")
+
+    (PROG ((PTRFILE (OPENSTREAM (FINDFILE (PACKFILENAME 'BODY (U-CASE IMPTR.FILE.NAME)
+                                                 'EXTENSION
+                                                 'IMPTR)
+                                       T)
+                           'INPUT
+                           'OLD))
+           DATUM)
+          (COND
+             (KEEP.IMPLICIT.REFS.FLG (printout T T 
+                                         "  ***  WARNING:  implicit references will be included  ***"
+                                            T T)))
+          (COND
+             ((NOT (BOUNDP 'IMPTR.HASH))
+              (INIT.INDEX.VARS)))
+          [while [SETQ DATUM (CAR (NLSETQ (READ PTRFILE]
+             do (COND
+                       ((NOT (type? IM.INDEX.DATA DATUM))
+                        (printout T "bad datum -- " DATUM T))
+                       ([MEMBER (MKLIST (fetch (IM.INDEX.DATA TYPE) of DATUM))
+                               '((CHAPTER)
+                                 (SUBSEC)
+                                 (APPENDIX]
+
+                        (* ;; "map (CHAPTER) => CHAPTER.  We want to allow these words in a list, so that users can create TOC entries using IMINDEX.")
+
+                        [replace (IM.INDEX.DATA TYPE) of DATUM
+                           with (CAR (MKLIST (fetch (IM.INDEX.DATA TYPE) of DATUM]
+                        (SETQ IMPTR.TOC.LIST (CONS DATUM IMPTR.TOC.LIST)))
+                       ((AND (NOT KEEP.IMPLICIT.REFS.FLG)
+                             (MEMB '*IMPLICIT* (fetch (IM.INDEX.DATA INFO) of DATUM)))
+                                                             (* ; 
+                                 "unless KEEP.IMPLICIT.REFS.FLG is true, flush implicit references")
+                        NIL)
+                       ((AND IMPTR.TYPES (NOT (MEMBER (fetch (IM.INDEX.DATA TYPE) of DATUM)
+                                                     IMPTR.TYPES)))
+                                                             (* ; 
+                 "if IMPTR.TYPES is non-NIL, flush references that do not have one of these types.")
+                        NIL)
+                       (T [COND
+                             ((NULL (fetch (IM.INDEX.DATA TYPE) of DATUM))
+                              (replace (IM.INDEX.DATA TYPE) of DATUM with 'TERM]
+                          [COND
+                             ((NOT (GETHASH (fetch (IM.INDEX.DATA NAME) of DATUM)
+                                          IMPTR.HASH))
+                              (SETQ IMPTR.NAME.LIST (CONS (fetch (IM.INDEX.DATA NAME)
+                                                             of DATUM)
+                                                          IMPTR.NAME.LIST]
+                          (PUTHASH (fetch (IM.INDEX.DATA NAME) of DATUM)
+                                 (CONS DATUM (GETHASH (fetch (IM.INDEX.DATA NAME) of DATUM)
+                                                    IMPTR.HASH))
+                                 IMPTR.HASH]
+          (CLOSEF PTRFILE])
+
+(IM.COMMAND.MENU
+  [LAMBDA (MENU.POS)                                     (* mjs "24-Jul-85 17:02")
+    (ADDMENU (create MENU
+                    ITEMS _ '[(|FORMAT TEDIT SELECTION| (IM.TEDIT.SELECTION))
+                              (|Add IM Menu| (ADD.IM.MENU (WHICHW (GETPOSITION]
+                    TITLE _ "IM commands")
+           NIL
+           (if MENU.POS
+             else (GETPOSITION])
+
+(IM.TEDIT.SELECTION
+  [LAMBDA NIL                                            (* mjs "30-Jul-85 12:01")
+    (PROG ((TEDITW (WHICHW (GETPOSITION)))
+           TSTREAM TSTREAMSEL SELSTREAM FIRSTCHAR ENDCHAR)   (* make sure that error window won't 
+                                                           pagehold)
+          (WINDOWPROP (WFROMDS (TTYDISPLAYSTREAM))
+                 'PAGEFULLFN
+                 (FUNCTION NILL))
+          (if [OR (NULL TEDITW)
+                      (NULL (WINDOWPROP TEDITW 'TEXTSTREAM]
+              then (RETURN))
+          (SETQ TSTREAM (TEXTSTREAM TEDITW))
+          (SETQ TSTREAMSEL (TEDIT.GETSEL TSTREAM))
+          (SETQ SELSTREAM (OPENTEXTSTREAM))
+          (SETQ FIRSTCHAR (SUB1 (fetch (SELECTION CH#) of TSTREAMSEL)))
+          (SETQ ENDCHAR (IPLUS FIRSTCHAR (fetch (SELECTION DCH) of TSTREAMSEL)))
+          (SETFILEPTR TSTREAM FIRSTCHAR)
+          [for X from 1 to (IDIFFERENCE ENDCHAR FIRSTCHAR) bind C
+             do (SETQ C (BIN TSTREAM))
+                   (if (SMALLP C)
+                       then (BOUT SELSTREAM C)
+                     elseif (IMAGEOBJP C)
+                       then (TEDIT.INSERT.OBJECT C SELSTREAM (ADD1 (GETFILEPTR SELSTREAM)))
+                             (SETFILEPTR SELSTREAM (GETEOFPTR SELSTREAM]
+          (for X in '(FORMATSELDUMMY.IM FORMATSELDUMMY.IMERR FORMATSELDUMMY.IMPTR)
+             when (INFILEP X) do (printout T "deleting " X T)
+                                        (DELFILE X))
+          (TEDIT.PUT SELSTREAM 'FORMATSELDUMMY.IM)
+          (TEDIT.KILL SELSTREAM)
+          (TEDIT (IM.TEDIT 'FORMATSELDUMMY.IM T])
+
+(INIT.INDEX.VARS
+  [LAMBDA NIL                                            (* mjs " 6-Aug-86 09:49")
+    (SETQ IMPTR.HASH (HASHARRAY 5000))
+    (SETQ IMPTR.NAME.LIST NIL)
+    (SETQ IMPTR.TOC.LIST NIL])
+
+(INSERT.CHARS.AROUND.SEL
+  [LAMBDA (TEXTSTREAM BEFORETEXT AFTERTEXT)              (* mjs " 8-May-85 11:46")
+    (PROG [(FIRSTCHAR (fetch (SELECTION CH#) of (TEDIT.GETSEL TEXTSTREAM)))
+           (AFTERLASTCHAR (fetch (SELECTION CHLIM) of (TEDIT.GETSEL TEXTSTREAM]
+          (TEDIT.INSERT TEXTSTREAM AFTERTEXT AFTERLASTCHAR)
+          (TEDIT.INSERT TEXTSTREAM BEFORETEXT FIRSTCHAR])
+
+(INTERPRET.IM.MENU.COMMAND
+  [LAMBDA (ITEM MENU MOUSEKEY)                           (* mjs "12-Jul-85 15:19")
+    (PROG [(TS (TEXTSTREAM (MAINWINDOW (WFROMMENU MENU]
+          (if (EQ ITEM 'CLOSE)
+              then (DETACHWINDOW (WFROMMENU MENU))
+                    (CLOSEW (WFROMMENU MENU))
+            elseif (EQ ITEM 'U-CASE)
+              then (PROG [(CH# (fetch (SELECTION CH#) of (TEDIT.GETSEL TS)))
+                              (NEW (U-CASE (TEDIT.SEL.AS.STRING TS]
+                             (TEDIT.DELETE TS (TEDIT.GETSEL TS))
+                             (TEDIT.INSERT TS NEW)
+                             (TEDIT.SETSEL TS CH# (NCHARS NEW)
+                                    'LEFT))
+            else (INSERT.CHARS.AROUND.SEL TS (CONCAT "{" ITEM
+                                                            (if (EQ ITEM 'Text)
+                                                                then (CHARACTER (CHARCODE CR))
+                                                              else " "))
+                            "}"])
+
+(MAKE.IM.TITLE
+  [LAMBDA (OUTFILE.FLG SUBTITLE DOCNUMBER DOCDATE)       (* mjs "23-Sep-85 14:05")
+    (PROG ((SUBSEC.COUNT.LIST (LIST (LIST NIL "" "ii" "iii" "iv")))
+           (IM.EVEN.FLG NIL))
+          (DECLARE (SPECVARS SUBSEC.COUNT.LIST IM.EVEN.FLG))
+          (RETURN (MAKE.IM.DOCUMENT [LIST (FUNCTION (LAMBDA NIL
+                                                      (DUMPOUT FONT IM.CHAPTER.TITLE.FONT PARALOOKS
+                                                             `(SPECIALX 0 SPECIALY %, 
+                                                                     IM.TITLEPAGE.TITLE.Y)
+                                                             DUMP.CHARS 
+                                                             "Interlisp-D Reference Manual" CR CR 
+                                                             PARALOOKS `(SPECIALX 0 SPECIALY %,
+                                                                               (DIFFERENCE 
+                                                                                 IM.TITLEPAGE.TITLE.Y
+                                                                                      20))
+                                                             DUMP.CHARS SUBTITLE CR CR)
+                                                      (DUMPOUT FONT IM.XEROX.LOGO.FONT PARALOOKS
+                                                             `(LEFTMARGIN 0 1STLEFTMARGIN 0 SPECIALX
+                                                                     0 SPECIALY %, 
+                                                                     IM.TITLEPAGE.TITLE.Y)
+                                                             DUMP.CHARS "XEROX" CR CR)
+                                                      (DUMPOUT FONT IM.SUBSEC.THREE.TITLE.FONT 
+                                                             PARALOOKS
+                                                             `(SPECIALX 0 SPECIALY %, 
+                                                                     IM.TITLEPAGE.DOCNUMBER.Y)
+                                                             DUMP.CHARS DOCNUMBER CR CR PARALOOKS
+                                                             `(SPECIALX 0 SPECIALY %,
+                                                                     (DIFFERENCE 
+                                                                            IM.TITLEPAGE.DOCNUMBER.Y
+                                                                            12))
+                                                             DUMP.CHARS DOCDATE CR CR)
+                                                      (DUMPOUT FONT IM.SUBSEC.THREE.TITLE.FONT 
+                                                             PARALOOKS
+                                                             `(SPECIALX 0 SPECIALY %, 
+                                                                     IM.TITLEPAGE.TITLE.Y 
+                                                                     NEWPAGEBEFORE T)
+                                                             DUMP.CHARS 
+                                                             "Copyright (c) 1985 Xerox Corporation" 
+                                                             CR CR FONT NIL DUMP.CHARS 
+                                                             "All rights reserved." CR CR PARALOOKS
+                                                             '(QUAD JUSTIFIED)
+                                                             DUMP.CHARS "Portions from %"Interlisp Reference Manual%" Copyright (c) 1983 Xerox Corporation, and %"Interlisp Reference Manual%" Copyright (c) 1974, 1975, 1978 Bolt, Beranek & Newman and Xerox Corporation."
+                                                             CR CR DUMP.CHARS "This publication may not be reproduced or transmitted in any form by any means, electronic, microfilm, xerography, or otherwise, or incorporated into any information retrieval system, without the written permission of Xerox Corporation."
+                                                             CR CR]
+                         OUTFILE.FLG NIL "Hardcopy of Title Page"])
+
+(MAKE.IM.TOC
+  [LAMBDA (OUTFILE.FLG CHAPTER.NUMBERS IMPTR.FILES)      (* mjs "12-Aug-86 09:54")
+
+         (* * CHAPTER.NUMBERS is either%: NIL, meaning to generate TOC of ALL data 
+       available; a single number, meaning to generate a chapter TOC for that chapter;
+       or a list of numbers, meaning to generate a TOC for those chapters)
+
+    (PROG* ([IMPTR.DATA (if IMPTR.FILES
+                            then (PROG ((IMPTR.HASH (HASHARRAY 50))
+                                            (IMPTR.TOC.LIST NIL)
+                                            (IMPTR.NAME.LIST NIL))
+                                           (DECLARE (SPECVARS IMPTR.HASH IMPTR.TOC.LIST 
+                                                               IMPTR.NAME.LIST))
+                                           [for X in (MKLIST IMPTR.FILES)
+                                              do (printout T "Grabbing IMPTR file: " X T) 
+
+         (* * the IMPTR.TYPES arg to GRAB.IMPTR is a list containing no possible types, 
+       so that no index entries will be saved.)
+
+                                                    (GRAB.IMPTR X NIL '(XXXXXXXXX]
+                                           (RETURN (LIST IMPTR.HASH IMPTR.TOC.LIST IMPTR.NAME.LIST]
+            (IMPTR.HASH (if IMPTR.FILES
+                            then (CAR IMPTR.DATA)
+                          else IMPTR.HASH))
+            (IMPTR.TOC.LIST (if IMPTR.FILES
+                                then (CADR IMPTR.DATA)
+                              else IMPTR.TOC.LIST))
+            (IMPTR.NAME.LIST (if IMPTR.FILES
+                                 then (CADDR IMPTR.DATA)
+                               else IMPTR.NAME.LIST))
+            (SINGLE.CHAP.TOC.FLG (NUMBERP CHAPTER.NUMBERS))
+            (SUBSEC.COUNT.LIST '(TOC))
+            (MAKE.IM.TOC.TITLE (if (NULL CHAPTER.NUMBERS)
+                                   then "MASTER TABLE OF CONTENTS"
+                                 else "TABLE OF CONTENTS"))
+            MAKE.IM.TOC.LIST)
+           (DECLARE (SPECVARS SINGLE.CHAP.TOC.FLG SUBSEC.COUNT.LIST MAKE.IM.TOC.TITLE 
+                               MAKE.IM.TOC.LIST IMPTR.HASH IMPTR.TOC.LIST IMPTR.NAME.LIST))
+           (SETQ MAKE.IM.TOC.LIST (if (NULL CHAPTER.NUMBERS)
+                                      then (APPEND IMPTR.TOC.LIST)
+                                    else (for X in IMPTR.TOC.LIST
+                                                bind (CHLST _ (MKLIST CHAPTER.NUMBERS))
+                                                when (MEMB (CAR (LAST (fetch (IM.INDEX.DATA
+                                                                                      SUBSEC)
+                                                                             of X)))
+                                                               CHLST) collect X)))
+           [SORT MAKE.IM.TOC.LIST (FUNCTION (LAMBDA (A B)
+                                              (LIST.ORDER (REVERSE (fetch (IM.INDEX.DATA SUBSEC)
+                                                                      of A))
+                                                     (REVERSE (fetch (IM.INDEX.DATA SUBSEC)
+                                                                 of B]
+           (RETURN
+            (MAKE.IM.DOCUMENT
+             [LIST
+              (FUNCTION (LAMBDA NIL
+                          (DUMP.HEADERS.FOOTERS MAKE.IM.TOC.TITLE MAKE.IM.TOC.TITLE)
+                          (DUMPOUT FONT IM.CHAPTER.TITLE.FONT PARALOOKS
+                                 `(PARALEADING 0 LINELEADING 0 QUAD LEFT TABS %, IM.RIGHT.MARGIN.TABS
+                                         )
+                                 TAB DUMP.CHARS MAKE.IM.TOC.TITLE CR CR)
+                          (DUMP.HRULE 6)
+                          (DUMPOUT START.PARA FONT NIL PARALOOKS '(PARALEADING 93 LINELEADING 0)
+                                 DUMP.CHARS " " CR CR)
+                          (for TOC.PTR on MAKE.IM.TOC.LIST bind TOC.LINE
+                             do
+                             (SETQ TOC.LINE (CAR TOC.PTR))
+                             (PROG ((SECTION.STRING "")
+                                    (SEC.LIST (REVERSE (fetch (IM.INDEX.DATA SUBSEC) of
+                                                                                         TOC.LINE)))
+                                    (PAGE.LIST (REF.TO.PAGE TOC.LINE))
+                                    MAJOR.SECTION.FLG LINE.PARA LINE.INDENT)
+                                   (SETQ MAJOR.SECTION.FLG (EQLENGTH SEC.LIST 1))
+                                   [for X on SEC.LIST
+                                      do (SETQ SECTION.STRING (CONCAT SECTION.STRING (CAR X)
+                                                                         (if (CDR X)
+                                                                             then "."
+                                                                           else ""]
+                                   (SETQ LINE.INDENT (if MAJOR.SECTION.FLG
+                                                         then 0
+                                                       elseif (EQLENGTH SEC.LIST 2)
+                                                         then IM.TOC.SUBSEC.ONE.LEFTMARGIN
+                                                       else IM.TOC.SUBSEC.TWO.LEFTMARGIN))
+                                   (SETQ LINE.PARA (LIST '1STLEFTMARGIN LINE.INDENT 'LEFTMARGIN
+                                                         (PLUS LINE.INDENT 72)
+                                                         'QUAD
+                                                         'LEFT
+                                                         'TABS IM.RIGHT.MARGIN.TABS))
+                                   (DUMPOUT PARALOOKS (APPEND '(HEADINGKEEP ON)
+                                                             LINE.PARA)
+                                          FONT
+                                          (if MAJOR.SECTION.FLG
+                                              then IM.SUBSEC.ONE.TITLE.FONT
+                                            else IM.SUBSEC.THREE.TITLE.FONT)
+                                          DUMP.CHARS SECTION.STRING DUMP.CHARS ".   " DUMP.CHARS
+                                          [PROG ((SAV (fetch (IM.INDEX.DATA SAV) of TOC.LINE)
+                                                      ))
+                                                (if (NLISTP SAV)
+                                                    then (SETQ SAV (CHCON SAV)))
+                                                (RETURN (CONS SAV (LAST SAV]
+                                          TAB FONT NIL DUMP.CHARS (CONCAT (CAR PAGE.LIST)
+                                                                         "."
+                                                                         (CADR PAGE.LIST))
+                                          CR CR)
+                                   (DUMP.HRULE
+                                    1 NIL
+                                    (APPEND
+                                     (if [AND MAJOR.SECTION.FLG
+                                                  (EQP (CAR SEC.LIST)
+                                                       (CAR (REVERSE (fetch (IM.INDEX.DATA SUBSEC
+                                                                                       )
+                                                                        of (CADR TOC.PTR]
+                                         then            (* if this is a major heading, and 
+                                                           there are subheadings, prevent a 
+                                                           pagebreak here)
+                                               '(HEADINGKEEP ON)
+                                       else NIL)
+                                     LINE.PARA]
+             OUTFILE.FLG NIL "Hardcopy of Table of Contents"])
+
+(NEWTO
+  [LAMBDA (NAME)                                         (* mjs " 8-APR-83 16:43")
+    (SETQ NAME (U-CASE NAME))
+    (PROG ((TO.PROG.NAME (PACK* NAME "#TOPROG")))
+          [COND
+             ((FMEMB NAME TO.NAME.LIST)
+              (printout T "$$$ WARNING --- " NAME " already defined as TO --- will redefine " 
+                     TO.PROG.NAME))
+             (T (SETQ TO.NAME.LIST (CONS NAME TO.NAME.LIST]
+          (replace TO.PROG of NAME with TO.PROG.NAME)
+          (DEFINE (LIST (CONS TO.PROG.NAME '(NIL (STANDARD.DUMMY.TO.PROG])
+
+(PRINT.INDEX.OBJECT
+  [LAMBDA (NAM LST VOLUME.INFO SUB.LEVEL)                (* ; "Edited  8-Dec-91 15:10 by jds")
+
+(* ;;; "LST is a list of index refs")
+
+(* ;;; "VOLUME.INFO is a list of elements, where each element describes the 'name' of a given volume, and what chapters go into it.  Example: ((I 1 2 3) (II 4 5) (III 6 7 8)) means that chapters 1-3 go into volume 'I' .  If NIL, the index entries are not divided into volumes")
+
+(* ;;; "SUB.LEVEL is NIL if called to print a top-level index entry, 1 if called recursively for first-level subentries, or 2 for second-level subentries.")
+
+(* ;;; "for now, as the type we will just yank the type of the first index reference.  Eventually may want to find the one which looks like it has the case-info most 'correct'")
+
+    (PROG ([TYP (COND
+                   ((fetch (IM.INDEX.DATA TYPE) of (CAR LST)))
+                   (T 'TERM]
+           DEF.REFS OTHER.DEF.REFS REF.TEXT REF SUB.REFS)
+          (COND
+             ((EQ TYP 'TAG)                                  (* ; "ignore TAG index entries")
+              (RETURN))
+             ([NOT (OR (LISTP TYP)
+                       (EQ TYP 'TERM]
+              (SHOULDNT "bad TYP given to PRINT.INDEX.OBJECT")))
+
+(* ;;; "temporary: throw out all *END* references")
+
+          [SETQ LST (for X in LST collect X unless (MEMB '*END* (fetch
+                                                                                 (IM.INDEX.DATA
+                                                                                  INFO) of X]
+          (COND
+             ((NULL LST)
+              (RETURN)))
+
+(* ;;; "seperate out all sub-index entries now, to be processed after this the main one")
+
+          (SETQ SUB.REFS (for X in LST when [PROG ((PLIST (fetch (IM.INDEX.DATA
+                                                                                  PROPLIST)
+                                                                         of X)))
+                                                              (RETURN (OR (LISTGET PLIST 'SUBNAME)
+                                                                          (LISTGET PLIST 'SUBTEXT]
+                            collect X))
+          (SETQ LST (LDIFFERENCE LST SUB.REFS))
+
+(* ;;; "if all refs are subrefs, generate a dummy ref")
+
+          [COND
+             ((NULL LST)
+              (SETQ LST (LIST (create IM.INDEX.DATA
+                                     INFO _ '(*NOPAGE*)
+                                     PROPLIST _ NIL using (CAR SUB.REFS]
+
+(* ;;; "DEF.REFS is all definition references, sorted by size of description, longest one first")
+
+          [SETQ DEF.REFS (SORT (for X in LST when (MEMB '*DEF* (fetch (IM.INDEX.DATA
+                                                                                       INFO)
+                                                                              of X)) collect
+                                                                                         X)
+                               (FUNCTION (LAMBDA (A B)
+                                           (ILEQ (LENGTH (fetch (IM.INDEX.DATA SAV) of A))
+                                                 (LENGTH (fetch (IM.INDEX.DATA SAV) of B]
+
+(* ;;; "for all but the longest definition reference, print as separate index lines, and remove from index list for this line")
+
+(* ;;; 
+"note that any other defs that print the same as the longest def are also merged into this line")
+
+          (SETQ OTHER.DEF.REFS (for X in (CDR DEF.REFS)
+                                  unless (EQUAL (fetch (IM.INDEX.DATA SAV) of X)
+                                                    (fetch (IM.INDEX.DATA SAV)
+                                                       of (CAR DEF.REFS))) collect X))
+          [COND
+             (OTHER.DEF.REFS (PRINT.INDEX.OBJECT NAM OTHER.DEF.REFS VOLUME.INFO SUB.LEVEL)
+                    (SETQ LST (LDIFFERENCE LST OTHER.DEF.REFS]
+
+(* ;;; "get the reference text from the definition ref, if there is one, otherwise from the first primary ref with text, otherwise from any ref, otherwise use the name")
+
+          (SETQ REF.TEXT (COND
+                            ((CAR DEF.REFS)
+                             (fetch (IM.INDEX.DATA SAV) of (CAR DEF.REFS)))
+                            ((SETQ REF (for X in LST when (MEMB '*PRIMARY*
+                                                                            (fetch (IM.INDEX.DATA
+                                                                                        INFO)
+                                                                               of X))
+                                          thereis (fetch (IM.INDEX.DATA SAV) of X)))
+                             (fetch (IM.INDEX.DATA SAV) of REF))
+                            ([AND (SETQ REF (for X in LST thereis (fetch (
+                                                                                        IM.INDEX.DATA
+                                                                                          SAV)
+                                                                                 of X)))
+                                  (NULL DEF.REFS)
+                                  (for X in LST never (MEMB '*PRIMARY*
+                                                                        (fetch (IM.INDEX.DATA
+                                                                                    INFO)
+                                                                           of X]
+                                                             (* ; 
+        "only use text from non-def,non-primary index if there are NO primary or def index entries")
+                             (fetch (IM.INDEX.DATA SAV) of REF))
+                            (T NAM)))
+
+(* ;;; "if REF.TEXT is not a list <either because NAM is used, or the SAV data was an atom>, put it in a list, adding {lisp...} if it is not a term")
+
+          [COND
+             ((NLISTP REF.TEXT)
+              (SETQ REF.TEXT (CHCON REF.TEXT))
+              (COND
+                 ((NEQ TYP 'TERM)
+                  (SETQ REF.TEXT (CONS '(FONT . LISP)
+                                       REF.TEXT]
+
+(* ;;; "Flush all nopage refs")
+
+          (SETQ LST (for X in LST unless (MEMB '*NOPAGE* (fetch (IM.INDEX.DATA INFO)
+                                                                        of X)) collect X))
+
+(* ;;; "print out the text of the index entry")
+
+          (DUMPOUT FONT NIL PARALOOKS (COND
+                                         ((NULL SUB.LEVEL)
+                                          NIL)
+                                         ((EQ SUB.LEVEL 1)
+                                          (LIST '1STLEFTMARGIN IM.INDEX.SUB.1STLEFTMARGIN
+                                                'LEFTMARGIN IM.INDEX.SUB.LEFTMARGIN))
+                                         (T (LIST '1STLEFTMARGIN IM.INDEX.SUBSUB.1STLEFTMARGIN
+                                                  'LEFTMARGIN IM.INDEX.SUBSUB.LEFTMARGIN)))
+                 DUMP.CHARS
+                 (CONS REF.TEXT (LAST REF.TEXT))
+                 DUMP.CHARS "  " FONT ITALIC DUMP.CHARS (COND
+                                                           ((OR (EQ (U-CASE TYP)
+                                                                    'TERM)
+                                                                (AND (EQUAL (U-CASE TYP)
+                                                                            '(FUNCTION))
+                                                                     DEF.REFS))
+                                                            "")
+                                                           (T (MKSTRING TYP)))
+                 DUMP.CHARS "   ")                           (* ; 
+          "divide the index refs between the volumes.  If none in a given volume, don't include it")
+          [SETQ VOLUME.REF.LISTS
+           (COND
+              (VOLUME.INFO (for VOL in VOLUME.INFO bind VOL.REFS
+                              when (SETQ VOL.REFS
+                                        (for REF in LST
+                                           when (MEMBER (CAR (LAST (fetch (IM.INDEX.DATA
+                                                                                   SUBSEC)
+                                                                          of REF)))
+                                                           (CDR VOL)) collect REF))
+                              collect (CONS (CAR VOL)
+                                                VOL.REFS)))
+              (T (LIST (CONS NIL LST]
+          [for VOL.REF.LIST in VOLUME.REF.LISTS bind VOL.NAME VOL.REFS PRIMARY.PAGELST 
+                                                              PAGELST
+             do (SETQ VOL.NAME (CAR VOL.REF.LIST))
+                   (SETQ VOL.REFS (CDR VOL.REF.LIST))
+                   (DUMPOUT FONT NIL DUMP.CHARS (COND
+                                                   ((EQ VOL.REF.LIST (CAR VOLUME.REF.LISTS))
+                                                    "")
+                                                   (T "; "))
+                          DUMP.CHARS
+                          (COND
+                             (VOL.NAME (CONCAT VOL.NAME ": "))
+                             (T ""))) 
+
+                   (* ;; "PRIMARY.PAGELST is a list of all primary or definition references, sorted by chapter and page, with no duplicates")
+
+                   (SETQ PRIMARY.PAGELST (for X in VOL.REFS
+                                            when (OR (MEMB '*DEF* (fetch (IM.INDEX.DATA
+                                                                                  INFO) of X))
+                                                         (MEMB '*PRIMARY* (fetch (IM.INDEX.DATA
+                                                                                      INFO)
+                                                                             of X)))
+                                            collect (REF.TO.PAGE X)))
+                   (SETQ PRIMARY.PAGELST (INTERSECTION PRIMARY.PAGELST PRIMARY.PAGELST))
+                   [SETQ PRIMARY.PAGELST (SORT PRIMARY.PAGELST
+                                               (FUNCTION (LAMBDA (A B)
+                                                           (COND
+                                                              [(AND (NUMBERP (CAR A))
+                                                                    (NUMBERP (CAR B)))
+
+                                                               (* ;; 
+                                                      "CHAPTER is numeric, so compare with numeric")
+
+                                                               (OR (LESSP (CAR A)
+                                                                          (CAR B))
+                                                                   (AND (EQUAL (CAR A)
+                                                                               (CAR B))
+                                                                        (LESSP (CADR A)
+                                                                               (CADR B]
+                                                              (T
+
+                                                               (* ;; 
+                                      "One or t'other chapter is alpha, so compare using ALPHORDER")
+
+                                                               (OR (ALPHORDER (CAR A)
+                                                                          (CAR B))
+                                                                   (AND (STRING-EQUAL
+                                                                         (MKSTRING (CAR A))
+                                                                         (MKSTRING (CAR B)))
+                                                                        (LESSP (CADR A)
+                                                                               (CADR B] 
+
+                   (* ;; 
+                 "PAGELST is: ((chap1 page1) ...  (chapN pageN)) EXCEPT for primary references")
+
+                   (SETQ PAGELST (for X in VOL.REFS collect (REF.TO.PAGE X)))
+                   (SETQ PAGELST (INTERSECTION PAGELST PAGELST))
+                   (SETQ PAGELST (LDIFFERENCE PAGELST PRIMARY.PAGELST)) 
+
+                   (* ;; "PAGELST.BY.CHAPTER is list with elements of form: ((chap1 page1) (chap1 page1) ...) partioned by chapter, and sorted by chapter")
+
+                   (SETQ PAGELST.BY.CHAPTER (PARTITION.LIST PAGELST [FUNCTION (LAMBDA (A B)
+                                                                                (STRING-EQUAL
+                                                                                 (MKSTRING A)
+                                                                                 (MKSTRING B]
+                                                   (FUNCTION CAR)
+                                                   (FUNCTION ALPHORDER)))
+                   [COND
+                      (PRIMARY.PAGELST
+                       (DUMPOUT FONT BOLD DUMP.CHARS
+                              (CONCATLIST (for X in PRIMARY.PAGELST
+                                             bind (LAST.PRIMARY.PAGE _ (CAR (LAST PRIMARY.PAGELST
+                                                                                      )))
+                                             join (APPEND (COND
+                                                                 ((CAR X)
+                                                                  (LIST (CAR X)
+                                                                        "-"))
+                                                                 (T NIL))
+                                                             (LIST (CADR X)
+                                                                   (COND
+                                                                      ((OR (NOT (EQUAL X 
+                                                                                    LAST.PRIMARY.PAGE
+                                                                                       ))
+                                                                           PAGELST.BY.CHAPTER)
+                                                                       "; ")
+                                                                      (T ""]
+                   (for CHAP.PAGES in PAGELST.BY.CHAPTER bind CHAP.STRING NUMS
+                      do [SETQ CHAP.STRING (CONCAT (COND
+                                                          ((EQ CHAP.PAGES (CAR PAGELST.BY.CHAPTER))
+                                                           "")
+                                                          (T "; "))
+                                                      (COND
+                                                         ((CAAR CHAP.PAGES)
+                                                          (CONCAT (CAAR CHAP.PAGES)
+                                                                 "-"))
+                                                         (T ""]
+                            [SETQ NUMS (SORT (for X in CHAP.PAGES collect (CADR X] 
+                                                             (* (* ;; "terrible kludge for the sole purpose of merging runs of page numbers, to produce index entries like '1,3-5' instead of '1,3,4,5'")
+                                                           (bind (FIRSTNUM _ (CAR NUMS))
+                                                           (SECONDNUM _ (CAR NUMS))
+                                                           (NEWNUMS _ NIL) for X in
+                                                           (APPEND (CDR NUMS)
+                                                           (QUOTE (BADNUM))) do
+                                                           (COND ((AND (NUMBERP SECONDNUM)
+                                                           (NOT (EQUAL X (ADD1 SECONDNUM))))
+                                                           (push NEWNUMS (COND
+                                                           ((EQUAL FIRSTNUM SECONDNUM) FIRSTNUM)
+                                                           (T (PACK* FIRSTNUM "-" SECONDNUM))))
+                                                           (SETQ FIRSTNUM X)))
+                                                           (SETQ SECONDNUM X) finally
+                                                           (SETQ NUMS (REVERSE NEWNUMS))))
+                            (for SINGLE.PAGE in NUMS
+                               do (DUMPOUT FONT NIL DUMP.CHARS (COND
+                                                                      ((EQ SINGLE.PAGE (CAR NUMS))
+                                                                       CHAP.STRING)
+                                                                      (T ","))
+                                             DUMP.CHARS SINGLE.PAGE]
+          (DUMPOUT CR CR)
+
+(* ;;; "print out any sub references")
+
+          (PRINT.INDEX.SUBREFS SUB.REFS VOLUME.INFO SUB.LEVEL])
+
+(PRINT.INDEX.SUBREFS
+  [LAMBDA (SUB.REFS VOLUME.INFO SUB.LEVEL)               (* mjs "14-Jul-86 12:39")
+
+    (* ;; "Print sub-item references.  This is how the Notecards manual's Analog-clock sub-items get printed, e.g.:")
+
+    (* ;; " ANALOG CLOCK 168")
+
+    (* ;; "   creating 168")
+
+    (* ;; "   known problems 170")
+
+    (PROG ((NEW.SUB.LEVEL (COND
+                             ((NULL SUB.LEVEL)
+                              1)
+                             (T 2)))
+           SHIFTED.REFS)
+          (COND
+             ([NOT (AND SUB.REFS (MEMB SUB.LEVEL '(NIL 1]
+
+              (* ;; 
+            "There must be references to print, and we only print 2 levels of sub-references.")
+
+              (RETURN)))
+
+     (* ;; "Move everything in the references over:  SUBTYPEW -> TYPE, SUBTEXT -> SAV, etc, and move SUBSUB... up into the SUB fields.")
+
+     (* ;; "Many items were created with only SUBTEXT, so use that as the name if need be (using TERM as the type.)")
+
+          [SETQ SHIFTED.REFS (for X in SUB.REFS
+                                collect (PROG ((PLIST (fetch (IM.INDEX.DATA PROPLIST)
+                                                             of X)))
+                                                  (RETURN (create IM.INDEX.DATA
+                                                                 NAME _ (OR (LISTGET PLIST
+                                                                                   'SUBNAME)
+                                                                            (LISTGET PLIST
+                                                                                   'SUBTEXT))
+                                                                 TYPE _ (OR (LISTGET PLIST
+                                                                                   'SUBTYPE)
+                                                                            'TERM)
+                                                                 SAV _ (LISTGET PLIST 'SUBTEXT)
+                                                                 PROPLIST _
+                                                                 (LIST 'SUBNAME (LISTGET PLIST
+                                                                                       'SUBSUBNAME)
+                                                                       'SUBTYPE
+                                                                       (LISTGET PLIST 'SUBSUBTYPE)
+                                                                       'SUBTEXT
+                                                                       (LISTGET PLIST 'SUBSUBTEXT))
+                                                             using X]
+          (for LST in (PARTITION.LIST SHIFTED.REFS NIL
+                                     [FUNCTION (LAMBDA (A)
+                                                 (CONCAT (if (MEMB '*NOPAGE* (fetch
+                                                                                  (IM.INDEX.DATA
+                                                                                   INFO) of
+                                                                                         A))
+                                                             then "ZZZZZZZ"
+                                                           else "")
+                                                        (fetch (IM.INDEX.DATA NAME) of A]
+                                     (FUNCTION ALPHORDER))
+             do 
+
+                   (* ;; 
+    "partition sort by ref name <putting *NOPAGE* refs at the end>, and for each name, handle refs")
+
+                   (for X in (PARTITION.LIST LST NIL [FUNCTION (LAMBDA (A)
+                                                                         (fetch (IM.INDEX.DATA
+                                                                                     TYPE)
+                                                                            of A]
+                                            (FUNCTION ALPHORDER))
+                      do                                 (* ; "parition sort refs by type")
+                            (PRINT.INDEX.OBJECT (fetch (IM.INDEX.DATA NAME)
+                                                       of (CAR X))
+                                   X VOLUME.INFO NEW.SUB.LEVEL])
+
+(PROCESS.IM.CHAPTERS
+  [LAMBDA (CHAPNAMES NULL.IP.FLG)                        (* mjs "25-Sep-85 15:47")
+    (PROG (CHAPS.TO.PROCESS)
+          [SETQ CHAPS.TO.PROCESS (if (NULL CHAPNAMES)
+                                     then 
+
+         (* if chapter names are not given, check which chapters have been updated since 
+       they were last processed)
+
+                                           (COLLECT.MODIFIED.IM.CHAPTERS)
+                                   elseif (EQ CHAPNAMES T)
+                                     then (for X in IM.MANUAL.CHAPTERS
+                                                 collect (LIST (CAR X)
+                                                                   (CADR X)))
+                                   else (for NAM in (U-CASE (MKLIST CHAPNAMES))
+                                               join (for X in IM.MANUAL.CHAPTERS
+                                                           when (EQ (U-CASE (CADR X))
+                                                                        NAM)
+                                                           collect (LIST (CAR X)
+                                                                             (CADR X]
+          (printout T "will re-process chapters: " CHAPS.TO.PROCESS T)
+          (for X in CHAPS.TO.PROCESS
+             do (SETQ GLOBAL.CHAPTER.NUMBER (CAR X))
+                   (IM.TEDIT (PACKFILENAME 'BODY (CADR X)
+                                    'BODY IM.MANUAL.DIRECTORY)
+                          (if NULL.IP.FLG
+                              then '{NULL}FOO.IP
+                            else (CADR X)))
+                   (for EXT in (if NULL.IP.FLG
+                                           then '(IMPTR IMERR)
+                                         else '(IP IMPTR IMERR))
+                      bind (NAM _ (FILENAMEFIELD (CADR X)
+                                             'NAME))
+                            FROMFILE TOFILE
+                      do (SETQ FROMFILE (PACKFILENAME 'NAME NAM 'EXTENSION EXT 'BODY 
+                                                   '{DSK}FOO.IP))
+                            (SETQ TOFILE (PACKFILENAME 'NAME NAM 'EXTENSION EXT 'BODY 
+                                                IM.MANUAL.DIRECTORY))
+                            (if (INFILEP FROMFILE)
+                                then (printout T "copying from " FROMFILE " to " TOFILE "...." T)
+                                      (RENAMEFILE FROMFILE TOFILE])
+
+(REF.TO.PAGE
+  [LAMBDA (REF DEFAULT-CHAPTER)                          (* ; "Edited  8-Dec-91 15:08 by jds")
+
+    (* ;; "Returns a list of the form (chap# page#)")
+
+    (LIST (CAR (LAST (OR (fetch (IM.INDEX.DATA SUBSEC) of REF)
+                         DEFAULT-CHAPTER)))
+          (fetch (IM.INDEX.DATA PAGE#) of REF])
+
+(REFS.TO.PAGES
+  [LAMBDA (REFS)                                         (* mjs " 6-Jun-85 14:43")
+
+         (* * REFS is list of index refs. Returns a list of the form
+       ((chap1 page1) |...| (chapN pageN)))
+
+    (for X in REFS collect (REF.TO.PAGE X])
+)
+(DEFINEQ
+
+(MAKE.IM.INDEX
+  [LAMBDA (OUTFILE.FLG VOLUME.INFO IMPTR.FILES IMPTR.TYPES)
+                                                             (* ; "Edited 30-Aug-91 10:38 by jds")
+    (SETQ IMPTR.FILES (OR IMPTR.FILES (DIRECTORY "*.IMPTR;")))
+    (PROG* ((*READTABLE* *TEDIT-FILE-READTABLE*)
+            [IMPTR.DATA (COND
+                           (IMPTR.FILES (PROG ((IMPTR.HASH (HASHARRAY 500))
+                                               (IMPTR.TOC.LIST NIL)
+                                               (IMPTR.NAME.LIST NIL))
+                                              (DECLARE (SPECVARS IMPTR.HASH IMPTR.TOC.LIST 
+                                                                  IMPTR.NAME.LIST))
+                                              (for X in (MKLIST IMPTR.FILES)
+                                                 do (printout T "Grabbing IMPTR file: " X T)
+                                                       (GRAB.IMPTR X NIL IMPTR.TYPES))
+                                              (RETURN (LIST IMPTR.HASH IMPTR.TOC.LIST IMPTR.NAME.LIST
+                                                            ]
+            (IMPTR.HASH (COND
+                           (IMPTR.FILES (CAR IMPTR.DATA))
+                           (T IMPTR.HASH)))
+            (IMPTR.TOC.LIST (COND
+                               (IMPTR.FILES (CADR IMPTR.DATA))
+                               (T IMPTR.TOC.LIST)))
+            (IMPTR.NAME.LIST (COND
+                                (IMPTR.FILES (CADDR IMPTR.DATA))
+                                (T IMPTR.NAME.LIST)))
+            INDEX.DATA INDEX.DATA.BY.TYPE)
+           (DECLARE (SPECVARS IMPTR.HASH IMPTR.TOC.LIST IMPTR.NAME.LIST))
+
+(* ;;; "Use either global or local versions of IMPTR.HASH IMPTR.TOC.LIST IMPTR.NAME.LIST")
+
+           [SORT IMPTR.NAME.LIST (FUNCTION (LAMBDA (A B)
+                                             (COND
+                                                ((OR (NUMBERP A)
+                                                     (NUMBERP B))
+                                                 (ALPHORDER (MKSTRING A)
+                                                        (MKSTRING B)))
+                                                (T (ALPHORDER A B]
+                                                             (* ; 
+                                        "sort, then put all names before first A--- at end of list")
+           [PROG ((X IMPTR.NAME.LIST))
+                 (until [OR (NULL X)
+                                (EQ 'A (U-CASE (NTHCHAR (CADR X)
+                                                      1] do (SETQ X (CDR X)))
+                 (COND
+                    (X (RPLACD (LAST X)
+                              IMPTR.NAME.LIST)
+                       (SETQ IMPTR.NAME.LIST (CDR X))
+                       (RPLACD X NIL]
+           (SETQ SUBSEC.COUNT.LIST '(INDEX))
+           (RETURN (MAKE.IM.DOCUMENT
+                    [LIST (FUNCTION (LAMBDA NIL
+                                      (DUMP.HEADERS.FOOTERS "INDEX" "INDEX")
+                                      (DUMPOUT FONT IM.CHAPTER.TITLE.FONT PARALOOKS
+                                             `(PARALEADING 0 LINELEADING 0 QUAD LEFT 1STLEFTMARGIN 0
+                                                     LEFTMARGIN 0 RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN
+                                                     TABS %, IM.RIGHT.MARGIN.TABS TYPE PAGEHEADING 
+                                                     SUBTYPE TITLEHEAD)
+                                             TAB DUMP.CHARS "INDEX" CR CR)
+                                      (DUMP.HRULE 6 NIL
+                                             `(PARALEADING 0 LINELEADING 0 QUAD LEFT 1STLEFTMARGIN 0
+                                                     LEFTMARGIN 0 RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN
+                                                     TABS %, IM.RIGHT.MARGIN.TABS TYPE PAGEHEADING 
+                                                     SUBTYPE TITLEHEADRULE))
+                                      (for INDEX.NAME in IMPTR.NAME.LIST
+                                         bind (LAST.CHAR _ NIL)
+                                               CURRENT.CHAR
+                                         do (SETQ CURRENT.CHAR (U-CASE (NTHCHAR INDEX.NAME 1)))
+                                               (COND
+                                                  ((NEQ CURRENT.CHAR LAST.CHAR)
+                                                   (DUMPOUT CR CR FONT BOLD PARALOOKS
+                                                          '(HEADINGKEEP ON PARALEADING 12)
+                                                          DUMP.CHARS CURRENT.CHAR CR CR)
+                                                   (SETQ LAST.CHAR CURRENT.CHAR)))
+                                               (SETQ INDEX.DATA (GETHASH INDEX.NAME IMPTR.HASH)) 
+                                                             (* ; 
+                                                           "INDEX.DATA is a lists of index refs")
+                                               [SETQ INDEX.DATA.BY.TYPE
+                                                (PARTITION.LIST INDEX.DATA NIL
+                                                       [FUNCTION (LAMBDA (A)
+                                                                   (U-CASE (COND
+                                                                              ((fetch
+                                                                                (IM.INDEX.DATA TYPE)
+                                                                                  of A))
+                                                                              (T 'TERM]
+                                                       (FUNCTION (LAMBDA (A B)
+                                                                   (LIST.ORDER (U-CASE A)
+                                                                          (U-CASE B] 
+
+                                 (* ;; "INDEX.DATA.BY.TYPE is a list of index refs partioned by type, case-independent, and sorted by the ALPHORDER of the U-CASE of the types.  Eventually, may want to make sorting more dependent on the types <terms before fns before vars, etc>")
+
+                                               (for X in INDEX.DATA.BY.TYPE
+                                                  do (PRINT.INDEX.OBJECT INDEX.NAME X 
+                                                                VOLUME.INFO) 
+                                                             (* ; 
+                                            "print the info about a single object of a single type")
+                                                      ))
+                                      (COND
+                                         (IM.EVEN.FLG 
+
+                                 (* ;; "this is a hack so that if you are going to print '[This page intentionally left blank]' on a blank page at the end, skip to the right column or the next page")
+
+                                                (DUMPOUT CR CR START.PARA PARALOOKS
+                                                       '(NEWPAGEBEFORE T)
+                                                       DUMP.CHARS "    " CR CR]
+                    OUTFILE.FLG
+                    [TEDIT.COMPOUND.PAGEFORMAT [TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 
+                                                      IM.PAGE.LEFTMARGIN IM.PAGE.RIGHTMARGIN 
+                                                      IM.INDEX.PAGE.FIRST.TOPMARGIN 
+                                                      IM.PAGE.BOTTOMMARGIN 2 NIL 18
+                                                      `((RECTOFOOT %, IM.PAGE.LEFTMARGIN %, 
+                                                               IM.FOOTER.Y)
+                                                        (RECTOFOOTRULE %, IM.PAGE.LEFTMARGIN %, 
+                                                               IM.FOOTER.RULE.Y)
+                                                        (DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
+                                                               IM.DRAFT.MESSAGE.BOTTOM.Y)
+                                                        (TITLEHEAD %, IM.PAGE.LEFTMARGIN %, 
+                                                               IM.HEADER.Y)
+                                                        (TITLEHEADRULE %, IM.PAGE.LEFTMARGIN %, 
+                                                               IM.HEADER.RULE.Y]
+                           [TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN 
+                                  IM.PAGE.RIGHTMARGIN IM.PAGE.TOPMARGIN IM.PAGE.BOTTOMMARGIN 2 NIL 18
+                                  `((DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, IM.DRAFT.MESSAGE.TOP.Y)
+                                    (VERSOHEAD %, IM.PAGE.LEFTMARGIN %, IM.HEADER.Y)
+                                    (VERSOHEADRULE %, IM.PAGE.LEFTMARGIN %, IM.HEADER.RULE.Y)
+                                    (VERSOFOOT %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.Y)
+                                    (VERSOFOOTRULE %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.RULE.Y)
+                                    (DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, IM.DRAFT.MESSAGE.BOTTOM.Y]
+                           (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN 
+                                  IM.PAGE.RIGHTMARGIN IM.PAGE.TOPMARGIN IM.PAGE.BOTTOMMARGIN 2 NIL 18
+                                  `((DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, IM.DRAFT.MESSAGE.TOP.Y)
+                                    (RECTOHEAD %, IM.PAGE.LEFTMARGIN %, IM.HEADER.Y)
+                                    (RECTOHEADRULE %, IM.PAGE.LEFTMARGIN %, IM.HEADER.RULE.Y)
+                                    (RECTOFOOT %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.Y)
+                                    (RECTOFOOTRULE %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.RULE.Y)
+                                    (DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, IM.DRAFT.MESSAGE.BOTTOM.Y]
+                    "Hardcopy of Index"
+                    `(QUAD LEFT 1STLEFTMARGIN %, IM.INDEX.1STLEFTMARGIN LEFTMARGIN %, 
+                           IM.INDEX.LEFTMARGIN POSTPARALEADING 0 PARALEADING 0 LINELEADING 0])
+)
+
+(RPAQQ IM.MANUAL.CHAPTERS 
+       (((NIL iii iv v vi vii viii ix x xi xii xiii xiv xv)
+         ChapAck)
+        (1 ChapIntro)
+        (2 ChapLitatoms)
+        (3 ChapLists)
+        (4 ChapStrings)
+        (5 ChapArrays)
+        (6 ChapHashArrays)
+        (7 ChapNumbers)
+        (8 ChapRecordPackage)
+        (9 ChapControlFns Conditionals PROG IterativeStatements)
+        (10 ChapFnDef FNTYPES FNDEF FNEVAL MACROS)
+        (11 ChapStack STACKORG STACKFNS INTERPRETERBLIPS GENERATORSANDCOROUTINES)
+        (12 ChapMisc GREET IdleMode VirtualMemory VersionInfo DATETIME DURATION RESOURCES 
+            PATTERNMATCH)
+        (13 ChapExec PAINTRO PACOMS PAMISC PAGUTS PAFNS)
+        (14 ChapErrors BREAKS ERRORFNS RESETVARS ERRORLIST)
+        (15 ChapBreaking BREAKFNS ADVISING)
+        (16 ChapEditor DEDIT EDITORATTNCOMS EDITORMODCOMS EDITORMISC EDITORFNS)
+        (17 ChapFP FPINTRO FPFNS FPTYPES FPCOMS FPFILECOMS FPFORMAT)
+        (18 ChapCompiler COMPILERINTRO COMPILERISSUES COMPILERFNS BLOCKCOMPILER COMPILERERRORS)
+        (19 ChapMasterScope MSLANG MSORG)
+        (20 ChapDWIM DWIMINTRO DWIMORG SPELLINGCORRECTION)
+        (21 ChapCLISP CLISPINTRO CLISPCHARS CLISPDECLARATIONS CLISPORG CLISPGUTS)
+        (22 ChapPerformance GarbageCollection VariableBindings MEASURING GAINSPACE)
+        (23 ChapProcesses)
+        (24 ChapFiles FileStreams FileNames FileOther Directories FileServers)
+        (25 ChapIO INPUTFNS OUTPUTFNS RANDOMIO PRINTOUT READFILE READTABLES)
+        (26 ChapUserIO Inspector PROMPTFORWORD ASKUSER TTYIN PRETTYPRINT)
+        (27 ChapGraphics GraphicsPrimitives ImageStreams ImageStreamsImpl FONTS IMAGEOBJECTS)
+        (28 ChapWindows WindowSystem Windows Menus AttachedWindows)
+        (29 ChapHardcopy)
+        (30 ChapTerminal InterruptChars TERMINALTABLES Dribble Mouse Keyboard Screen)
+        (31 ChapEther ETHEROVERVIEW ETHERPUP ETHERNS ETHERINTROLEVELONE ETHERPUPLEVELONE 
+            ETHERNSLEVELONE ETHEROTHERLEVELONE)))
+
+(RPAQQ IM.MANUAL.VOLUMES ((I 1 2 3 4 5 6 7 8 9 10 11 12)
+                              (II 13 14 15 16 17 18 19 20 21 22 23)
+                              (III 24 25 26 27 28 29 30 31)))
+
+(RPAQQ IM.MANUAL.DIRECTORY "{PELE:}<DOC>IRM>")
+
+(FILESLOAD IMTEDIT FREEMENU)
+(PUTPROPS IMTOOLS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1991))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (1285 53259 (ADD.IM.MENU 1295 . 1667) (COLLECT.MODIFIED.IM.CHAPTERS 1669 . 4256) (
+DO.INDEX 4258 . 6023) (DO.MANUAL 6025 . 6709) (GRAB.IM.MANUAL.PTRS 6711 . 7127) (GRAB.IMPTR 7129 . 
+10872) (IM.COMMAND.MENU 10874 . 11304) (IM.TEDIT.SELECTION 11306 . 13009) (INIT.INDEX.VARS 13011 . 
+13223) (INSERT.CHARS.AROUND.SEL 13225 . 13634) (INTERPRET.IM.MENU.COMMAND 13636 . 14734) (
+MAKE.IM.TITLE 14736 . 18929) (MAKE.IM.TOC 18931 . 27165) (NEWTO 27167 . 27736) (PRINT.INDEX.OBJECT 
+27738 . 45522) (PRINT.INDEX.SUBREFS 45524 . 49994) (PROCESS.IM.CHAPTERS 49996 . 52611) (REF.TO.PAGE 
+52613 . 52963) (REFS.TO.PAGES 52965 . 53257)) (53260 63626 (MAKE.IM.INDEX 53270 . 63624)))))
+STOP
diff --git a/docs/Documentation Tools/IMTOOLS.LCOM b/docs/Documentation Tools/IMTOOLS.LCOM
new file mode 100644
index 00000000..9aec597e
Binary files /dev/null and b/docs/Documentation Tools/IMTOOLS.LCOM differ
diff --git a/docs/Documentation Tools/IMTRAN b/docs/Documentation Tools/IMTRAN
new file mode 100644
index 00000000..0bc92e88
--- /dev/null
+++ b/docs/Documentation Tools/IMTRAN	
@@ -0,0 +1,1270 @@
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
+(FILECREATED " 8-Dec-91 15:16:14" {DSK}<users>sybalsky>PUBS>IMTRAN.;2 61628  
+
+      changes to%:  (FNS PARTITION.LIST)
+                    (VARS IMTRANCOMS)
+
+      previous date%: "11-Jul-86 12:39:31" {DSK}<users>sybalsky>PUBS>IMTRAN.;1)
+
+
+(* ; "
+Copyright (c) 1983, 1984, 1985, 1986, 1991 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT IMTRANCOMS)
+
+(RPAQQ IMTRANCOMS 
+       [
+        (* ;; "Functions to help converting IM format to TEdit.")
+
+        (FNS ADD.ANY.PARENT.PROP.IF ADD.MY.PROP.IF ANC.INDENT ANC.WIDTH ANY.PARENT.CORRECT.ARG 
+             ANY.PARENT.EVAL ANY.PARENT.TO.MATCH ARGS.REMAINING ARGS.REMAINING.AFTER CHANGE.INDENT 
+             CONCCONC CORRECT.ARG CORRECT.TO DECODE.TO.ARG.NAME.SYNONYM DECODE.TO.NAME.SYNONYM 
+             DEFINED.TO DESCRIBE.CURRENT.TO DESCRIBE.TO DUMP.ARG DUMP.FORMAT FLUSH.ARG 
+             GET.ANY.PARENT.PROP GET.ARG GET.ARG.SAV GET.ARG.TYPE GET.MY.PROP GET.TO.TYPE GOBBLE 
+             GOBBLE.DUMP GOBBLE.DUMP.UNDEFINED GOBBLE.FLUSH GOBBLE.SAVE GOBBLE.TRIVIAL IM.DUMP.CHARS
+             IM.FILE.EOF IM.PRINT.MESSAGE IMTRAN INCLUDE.FILE LIST.ORDER LIST.TO.STRING MAKE.SAVE 
+             OPEN.IM.FILE PARSE.ATOM PARSE.INDEX.SPEC PARSE.LIST PARSE.NUMBER.OR.PERCENTAGE 
+             PARSE.STRING PARSE.TO.NAME PARTITION.LIST PRINT.INFILE.NOTES PUT.MY.PROP SAVE.ARG 
+             SAVE.ARGS SAVE.ARGS.EMPTY SAVE.INFILE.NOTE SCRUNCH.REFS SEND.IMPLICIT SKIP.WHITE.SPACE 
+             STANDARD.DUMMY.TO.PROG TAG.LIST.MATCH TO.MATCH TO.NAME.CHAR TRANSLATE.SPECIAL.TYPES 
+             TRIVIAL.ARG)
+        (RECORDS TO)
+        (VARS IM.INFILE.NOTE.TAGS)
+        (INITVARS (IM.NOTE.FLG NIL)
+               (IM.DRAFT.FLG NIL)
+               (IM.INDEX.FILE.FLG NIL)
+               (IM.REF.FLG NIL)
+               (IM.SEND.IMPLICIT NIL)
+               (IM.EVEN.FLG NIL)
+               (IM.CHECK.DEFS NIL))
+        (PROP INFO DUMPOUT)
+        (MACROS IM.ERROR IM.WARNING)
+        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA SAVE.ARGS)
+                                                                             (NLAML GET.ARG.SAV)
+                                                                             (LAMA])
+
+
+
+(* ;; "Functions to help converting IM format to TEdit.")
+
+(DEFINEQ
+
+(ADD.ANY.PARENT.PROP.IF
+  [LAMBDA (PROPNAME VAL)                                 (* mjs "15-APR-83 10:31")
+    (ANY.PARENT.EVAL (LIST 'ADD.MY.PROP.IF (LIST 'QUOTE PROPNAME)
+                               (LIST 'QUOTE VAL])
+
+(ADD.MY.PROP.IF
+  [LAMBDA (PROPNAME VAL)                                 (* mjs "15-APR-83 10:32")
+    (if (GET.MY.PROP PROPNAME)
+        then [PUT.MY.PROP PROPNAME (CONS VAL (LISTP (GET.MY.PROP PROPNAME]
+              T
+      else NIL])
+
+(ANC.INDENT
+  [LAMBDA NIL                                            (* mjs "14-APR-83 13:31")
+    (GET.ANY.PARENT.PROP 'INDENT])
+
+(ANC.WIDTH
+  [LAMBDA NIL                                            (* mjs "14-APR-83 13:31")
+    (GET.ANY.PARENT.PROP 'WIDTH])
+
+(ANY.PARENT.CORRECT.ARG
+  [LAMBDA (NAME)                                         (* mjs " 8-APR-83 12:32")
+    (ANY.PARENT.EVAL (LIST 'CORRECT.ARG (LIST 'QUOTE NAME])
+
+(ANY.PARENT.EVAL
+  [LAMBDA (FORM)                                         (* mjs "11-APR-83 10:00")
+    (PROG ((S (STKSCAN 'TO.NAME))
+           VAL)
+      loop
+          (SETQ S (STKNTH 1 S S))
+          (SETQ S (STKSCAN 'TO.NAME S S))
+          (COND
+             ((NULL S)
+              (RETURN NIL))
+             ((SETQ VAL (STKEVAL S FORM))
+              (RETURN VAL))
+             (T (GO loop])
+
+(ANY.PARENT.TO.MATCH
+  [LAMBDA (NAME BEGINFLG TAGLIST)                        (* mjs " 8-APR-83 16:00")
+    (ANY.PARENT.EVAL (LIST 'TO.MATCH (LIST 'QUOTE NAME)
+                               (LIST 'QUOTE BEGINFLG)
+                               (LIST 'QUOTE TAGLIST])
+
+(ARGS.REMAINING
+  [LAMBDA (NAME ARGS)                                    (* mjs "21-APR-83 13:28")
+
+         (* returns T if NAME is a correct next-arg according to the TO.ARGS.REMAINING 
+       list ARGS. Specifically if the next non-list member of ARGS is EQ to NAME or 
+       NAME is a member of one of the list elements of ARGS before the next non-list 
+       member, then NAME is a correct next-arg.)
+
+    (if (NLISTP (CAR ARGS))
+        then (EQ (CAR ARGS)
+                     NAME)
+      else (OR (FMEMB NAME (CAR ARGS))
+                   (ARGS.REMAINING NAME (CDR ARGS])
+
+(ARGS.REMAINING.AFTER
+  [LAMBDA (NAME ARGS)                                    (* mjs "21-APR-83 13:28")
+
+         (* returns the new TO.ARGS.REMAINING list after arg NAME has been processed.
+       Assumes that NAME is a correct next-arg of ARGS, as according to ARGS.REMAINING 
+       NIL)
+
+    (if (NULL ARGS)
+        then NIL
+      elseif (EQ NAME (CAR ARGS))
+        then (CDR ARGS)
+      elseif (AND (LISTP (CAR ARGS))
+                      (FMEMB NAME (CAR ARGS)))
+        then ARGS
+      else (ARGS.REMAINING.AFTER NAME (CDR ARGS])
+
+(CHANGE.INDENT
+  [LAMBDA (X)                                            (* mjs "10-Apr-85 10:07")
+    (if (EQ X 'NONE)
+        then (PRIN3 "\parshape 0 {}" IM.OUTFILE)
+      else (printout IM.OUTFILE "\parshape 1 " .I4.10 X "pt " .I4.10 (IDIFFERENCE INITIAL.WIDTH X
+                                                                                )
+                      "pt " "{}"])
+
+(CONCCONC
+  [LAMBDA (X Y)                                          (* mjs "13-APR-83 16:44")
+                                                             (* takes two TCONC-format lists, and 
+                                                           concatonates them)
+    (COND
+       ((NLISTP X)
+        Y)
+       ((NULL (CAR Y))
+        X)
+       ((NULL (CAR X))
+        (RPLNODE2 X Y))
+       (T (RPLACD (CDR X)
+                 (CAR Y))
+          (RPLACD X (CDR Y])
+
+(CORRECT.ARG
+  [LAMBDA (NAME)                                         (* mjs "21-APR-83 13:30")
+
+         (* returns non-NIL if NAME is an arg that appears in the args.remaining list of 
+       the current TO)
+
+    (ARGS.REMAINING NAME TO.ARGS.REMAINING])
+
+(CORRECT.TO
+  [LAMBDA (NAME)                                         (* mjs " 9-NOV-83 11:56")
+                                                             (* returns T if NAME can occur as a 
+                                                           TO below TO.NAME)
+    (if (NULL TO.NAME)
+        then                                             (* anything can occur below 
+                                                           top-level TO)
+              T
+      elseif (OR (EQ TO.NAME 'COMMENT)
+                     (EQ TO.NAME 'NOTE))
+        then                                             (* anything can occur below a 
+                                                           comment or a note)
+              T
+      elseif (SELECTQ (GET.ARG.TYPE TO.NAME)
+                     (SIMPLE                                 (* a COMPLEX TO cannot occur within 
+                                                           a SIMPLE arg)
+                             (EQ (GET.TO.TYPE NAME)
+                                 NIL))
+                     (CHARS                                  (* no TO can occur within a CHARS 
+                                                           arg)
+                            T)
+                     NIL)
+        then NIL
+      elseif (SELECTQ NAME
+                     (CHAPTER                                (* exception 1%: chapter can only 
+                                                           occur in top-level TO)
+                              T)
+                     ((SUBSEC FNDEF VARDEF PROPDEF MACDEF COMDEF) 
+                                                             (* exception 2%: subsec, ---def can 
+                                                           only occur within subsec, chapter, 
+                                                           or top-level TO)
+                          [NOT (FMEMB TO.NAME '(CHAPTER SUBSEC])
+                     (FOOT                                   (* exception 3%: foot cannot occur 
+                                                           in foot)
+                           [OR (EQ TO.NAME 'FOOT)
+                               (ANY.PARENT.EVAL '(EQ TO.NAME 'FOOT])
+                     NIL)
+        then NIL
+      else T])
+
+(DECODE.TO.ARG.NAME.SYNONYM
+  [LAMBDA (NAME)                                         (* mjs "14-APR-83 14:40")
+                                                             (* eventually should do arg name 
+                                                           synonym search)
+    (COND
+       ((LISTGET (fetch TO.ARG.SYNONYMS of TO.NAME)
+               NAME))
+       (T NAME])
+
+(DECODE.TO.NAME.SYNONYM
+  [LAMBDA (NAME)                                         (* mjs "13-APR-83 18:56")
+    (COND
+       ((CADR (ASSOC NAME TO.SYNONYM.LIST)))
+       (T NAME])
+
+(DEFINED.TO
+  [LAMBDA (NAME)                                         (* mjs " 8-APR-83 11:02")
+    (fetch TO.PROG of NAME])
+
+(DESCRIBE.CURRENT.TO
+  [LAMBDA NIL                                            (* mjs "13-APR-83 18:22")
+    (DESCRIBE.TO (if TO.BEGIN.FLG
+                         then 'BEGIN
+                       else NIL)
+           TO.ORIG.NAME TO.TAG.LIST TO.ORIG.ARG.NAME])
+
+(DESCRIBE.TO
+  [LAMBDA (BEGIN.END ORIG.NAME TAG.LIST ORIG.ARG.NAME)   (* mjs " 3-MAY-83 14:42")
+    (CONCAT "{" (COND
+                   (BEGIN.END (CONCAT BEGIN.END " " ORIG.NAME " " (LIST.TO.STRING TAG.LIST)
+                                     "}"))
+                   (T ORIG.NAME))
+           (COND
+              (ORIG.ARG.NAME (CONCAT " (arg " ORIG.ARG.NAME ")"))
+              (T ""])
+
+(DUMP.ARG
+  [LAMBDA (NO.SKIP.FLG)                                  (* mjs "21-APR-83 14:14")
+    (if (fetch TO.ARGS of TO.NAME)
+        then (if TO.ARG.NAME
+                     then (GOBBLE.DUMP NO.SKIP.FLG)
+                           (SETQ TO.ARG.NAME NIL)
+                   else (ERROR "TO PROG BUG: attempting to dump arg not yet gotten"))
+      else (if (NOT TO.DONE.FLG)
+                   then (GOBBLE.DUMP NO.SKIP.FLG)
+                         (SETQ TO.DONE.FLG T)
+                 else (ERROR "TO PROG BUG: attempting to process unlabeled arg twice"])
+
+(DUMP.FORMAT
+  [LAMBDA (FORMAT.TYPE FORMAT)                           (* mjs "13-APR-83 17:01")
+    (COND
+       ((BOUNDP 'GOBBLE.SAVE.CONC)
+        (TCONC GOBBLE.SAVE.CONC (CONS FORMAT.TYPE FORMAT)))
+       (T (DUMP (CONS FORMAT.TYPE FORMAT])
+
+(FLUSH.ARG
+  [LAMBDA NIL                                            (* mjs "21-APR-83 14:13")
+    (if (fetch TO.ARGS of TO.NAME)
+        then (if TO.ARG.NAME
+                     then (GOBBLE.FLUSH)
+                           (SETQ TO.ARG.NAME NIL)
+                   else (ERROR "TO PROG BUG: attempting to dump arg not yet gotten"))
+      else (if (NOT TO.DONE.FLG)
+                   then (GOBBLE.FLUSH)
+                         (SETQ TO.DONE.FLG T)
+                 else (ERROR "TO PROG BUG: attempting to process unlabeled arg twice"])
+
+(GET.ANY.PARENT.PROP
+  [LAMBDA (PROPNAME)                                     (* mjs "11-APR-83 10:08")
+    (ANY.PARENT.EVAL (LIST 'GET.MY.PROP (LIST 'QUOTE PROPNAME])
+
+(GET.ARG
+  [LAMBDA NIL                                            (* mjs "12-Jul-85 12:32")
+    (PROG (C SAVE.FILE.PTR ORIG.NAME BEGIN.END TAG.LIST NAME)
+          (if (OR TO.ARG.NAME TO.DONE.FLG (NULL (fetch TO.ARGS of TO.NAME)))
+              then (ERROR "TO PROG BUG: called GET.ARG at bad time"))
+          (SKIP.WHITE.SPACE)
+          (SETQ C (if (EOFP IM.INFILE)
+                      then (IM.FILE.EOF)
+                    else (BIN IM.INFILE)))
+          (if (EQ C (CHARCODE }))
+              then (if TO.BEGIN.FLG
+                           then (IM.ERROR "} closes " (DESCRIBE.CURRENT.TO)))
+                    (SETQ TO.DONE.FLG T)
+                    (RETURN NIL)
+            elseif (EQ C 'EOF)
+              then (if (NEQ TO.NAME NIL)
+                           then (IM.ERROR "EOF - closing bracket for " (DESCRIBE.CURRENT.TO))
+                              )
+                    (SETQ TO.DONE.FLG T)
+                    (RETURN NIL)
+            elseif (NEQ C (CHARCODE {))
+              then (IM.ERROR "Garbage chars found between labeled args of " (
+                                                                               DESCRIBE.CURRENT.TO
+                                                                                 )
+                              " --- auto-completed")
+                    (SETQ SAVE.FILE.PTR (SUB1 (GETFILEPTR IM.INFILE)))
+                    (SETQ TO.DONE.FLG T)
+                    (RETURN NIL))
+          (SETQ SAVE.FILE.PTR (SUB1 (GETFILEPTR IM.INFILE)))
+          (SETQ ORIG.NAME (PARSE.TO.NAME))               (* if PARSE.TO.NAME returns a list, 
+                                                           it must be a BEGIN/END, so unpack 
+                                                           elements)
+          (if (NLISTP ORIG.NAME)
+              then (SETQ BEGIN.END NIL)
+                    (SETQ TAG.LIST NIL)
+            else (SETQ BEGIN.END (CAR ORIG.NAME))
+                  (SETQ TAG.LIST (CADDR ORIG.NAME))
+                  (SETQ ORIG.NAME (CADR ORIG.NAME)))
+          (if (EQ BEGIN.END 'BEGIN)
+              then (IM.ERROR (DESCRIBE.TO BEGIN.END ORIG.NAME TAG.LIST)
+                              " found between labeled args of "
+                              (DESCRIBE.CURRENT.TO)
+                              " --- auto-completed")
+                    (SETFILEPTR IM.INFILE SAVE.FILE.PTR)
+                    (SETQ TO.DONE.FLG T)
+                    (RETURN NIL)
+            elseif (EQ BEGIN.END 'END)
+              then (SETQ NAME (DECODE.TO.NAME.SYNONYM ORIG.NAME))
+                    (if (TO.MATCH NAME T TAG.LIST)
+                        then                             (* normal {end return)
+                              (SETQ TO.DONE.FLG T)
+                              (RETURN NIL)
+                      elseif (ANY.PARENT.TO.MATCH NAME T TAG.LIST)
+                        then (IM.ERROR (DESCRIBE.TO 'END ORIG.NAME TAG.LIST)
+                                        " found between labeled args of "
+                                        (DESCRIBE.CURRENT.TO)
+                                        " --- auto-completed")
+                              (SETFILEPTR IM.INFILE SAVE.FILE.PTR)
+                              (SETQ TO.DONE.FLG T)
+                              (RETURN NIL)
+                      else (IM.ERROR "Unmatched " (DESCRIBE.TO 'END ORIG.NAME TAG.LIST)
+                                      " --- flushed")
+                            (RETURN (GET.ARG)))
+            elseif BEGIN.END
+              then (ERROR "PARSE.TO.NAME returned something besides BEGIN or END"))
+          (SETQ NAME (DECODE.TO.ARG.NAME.SYNONYM ORIG.NAME))
+          (if (CORRECT.ARG NAME)
+              then (SETQ TO.ORIG.ARG.NAME ORIG.NAME)
+                    (SETQ TO.ARG.NAME NAME)
+                    (SETQ TO.ARGS.REMAINING (ARGS.REMAINING.AFTER NAME TO.ARGS.REMAINING))
+                    (RETURN NAME)
+            else (IM.ERROR (DESCRIBE.TO NIL ORIG.NAME NIL)
+                            " found between labeled args of "
+                            (DESCRIBE.CURRENT.TO)
+                            " --- auto-completed")
+                  (SETFILEPTR IM.INFILE SAVE.FILE.PTR)
+                  (SETQ TO.DONE.FLG T)
+                  (RETURN NIL])
+
+(GET.ARG.SAV
+  [NLAMBDA (NAME)                                        (* mjs "13-APR-83 10:23")
+    (LISTGET (GET.MY.PROP 'SAVE.ARGS.PROPLIST)
+           NAME])
+
+(GET.ARG.TYPE
+  [LAMBDA (NAME)                                         (* mjs "22-APR-83 13:19")
+
+         (* if NAME is a TO with labeled args, use the current arg name as index into 
+       the property list TO.ARG.TYPE. otherwise TO.ARG.TYPE is the arg type)
+
+    (if (fetch TO.ARGS of NAME)
+        then (LISTGET (fetch TO.ARG.TYPE of NAME)
+                        TO.ARG.NAME)
+      else (fetch TO.ARG.TYPE of NAME])
+
+(GET.MY.PROP
+  [LAMBDA (PROPNAME)                                     (* mjs "11-APR-83 10:10")
+    (LISTGET TO.PROP.LIST PROPNAME])
+
+(GET.TO.TYPE
+  [LAMBDA (NAME)                                         (* mjs "22-APR-83 13:20")
+
+         (* note that undefined TOs are always SIMPLE, so they can appear anywhere 
+       except in CHARS TOs)
+
+    (if (fetch TO.PROG of NAME)
+        then (fetch TO.TYPE of NAME)
+      else 'SIMPLE])
+
+(GOBBLE
+  [LAMBDA NIL                                            (* mjs "12-Jul-85 12:39")
+
+         (* * reads and dumps chars until closing } or {end)
+
+    (PROG ((SAVE.DUMP.FLG (BOUNDP 'GOBBLE.SAVE.CONC))
+           C SAVE.FILE.PTR CLIST ORIG.NAME NAME BEGIN.END TAG.LIST SAVE.CONC)
+          (if SAVE.DUMP.FLG
+              then (SETQ SAVE.CONC GOBBLE.SAVE.CONC))
+      loop
+          (SETQ C (if (EOFP IM.INFILE)
+                      then (IM.FILE.EOF)
+                    else (BIN IM.INFILE)))               (* if C is just a normal char, just 
+                                                           dump it and loop)
+          (if (EQ C 'EOF)
+              then (if (NEQ TO.NAME NIL)
+                           then (IM.ERROR "EOF - closing bracket for " (DESCRIBE.CURRENT.TO))
+                              )
+                    (RETURN NIL))
+          (if (EQ C (CHARCODE }))
+              then (if (AND TO.BEGIN.FLG (NOT TO.ARG.NAME))
+                           then (IM.ERROR "} closes " (DESCRIBE.CURRENT.TO)))
+                    (RETURN NIL))
+          (if (NEQ C (CHARCODE {))
+              then 
+
+         (* if it is anything else besides a left bracket, it is a character to dump)
+
+                    (if SAVE.DUMP.FLG
+                        then (TCONC SAVE.CONC C)
+                      else (DUMP C))
+                    (GO loop))                               (* at this point, C must be a left 
+                                                           bracket)
+
+         (* * before getting name after {, save current file ptr so you can back it up 
+       if necessary.)
+
+         (* * note%: complete TO name (or Begin spec) must be in one file, so that you 
+       can back up)
+
+          (SETQ SAVE.FILE.PTR (SUB1 (GETFILEPTR IM.INFILE)))
+          (SETQ ORIG.NAME (PARSE.TO.NAME))               (* if PARSE.TO.NAME returns a list, 
+                                                           it must be a BEGIN/END, so unpack 
+                                                           elements)
+          (if (NLISTP ORIG.NAME)
+              then (SETQ BEGIN.END NIL)
+                    (SETQ TAG.LIST NIL)
+            else (SETQ BEGIN.END (CAR ORIG.NAME))
+                  (SETQ TAG.LIST (CADDR ORIG.NAME))
+                  (SETQ ORIG.NAME (CADR ORIG.NAME)))
+          (SETQ NAME (DECODE.TO.NAME.SYNONYM ORIG.NAME))
+          (COND
+             [(EQ BEGIN.END 'END)
+              (COND
+                 ((AND (NOT TO.ARG.NAME)
+                       (TO.MATCH NAME T TAG.LIST))       (* normal {end return)
+                  (RETURN NIL))
+                 ((OR (TO.MATCH NAME T TAG.LIST)
+                      (ANY.PARENT.TO.MATCH NAME T TAG.LIST))
+                  (IM.ERROR (DESCRIBE.TO 'END ORIG.NAME TAG.LIST)
+                         " occurred in "
+                         (DESCRIBE.CURRENT.TO)
+                         " --- auto-completed")
+                  (SETFILEPTR IM.INFILE SAVE.FILE.PTR)
+                  (RETURN NIL))
+                 (T (IM.ERROR "Unmatched " (DESCRIBE.TO 'END ORIG.NAME TAG.LIST)
+                           " --- flushed")
+                    (GO loop]
+             ((AND BEGIN.END (NEQ BEGIN.END 'BEGIN))
+              (ERROR "PARSE.TO.NAME returned something besides BEGIN or END")))
+
+         (* * now, we must be beginning a TO)
+
+          (COND
+             ((AND (DEFINED.TO NAME)
+                   (NOT (CORRECT.TO NAME)))
+
+         (* if name is defined but not correct, auto-complete to pop up to where it is 
+       correct)
+
+              (IM.ERROR (DESCRIBE.TO BEGIN.END ORIG.NAME TAG.LIST)
+                     " not legal in "
+                     (DESCRIBE.CURRENT.TO)
+                     " --- auto-completed")
+              (SETFILEPTR IM.INFILE SAVE.FILE.PTR)
+              (RETURN NIL)))
+          (COND
+             ((AND (NOT BEGIN.END)
+                   (NOT (DEFINED.TO NAME))
+                   (OR (CORRECT.ARG ORIG.NAME)
+                       (ANY.PARENT.CORRECT.ARG ORIG.NAME)))
+
+         (* if name is not in a {begin and is undefined, AND it is a legal arg for the 
+       current TO or a parent TO, auto-complete current TO or arg)
+
+              (IM.ERROR "Possible Argument " (DESCRIBE.TO NIL ORIG.NAME NIL)
+                     " occurred in "
+                     (DESCRIBE.CURRENT.TO)
+                     " --- auto-completed")
+              (SETFILEPTR IM.INFILE SAVE.FILE.PTR)
+              (RETURN NIL)))
+          [PROG ((TO.NAME NAME)
+                 (TO.ORIG.NAME ORIG.NAME)
+                 (TO.BEGIN.FLG (NOT (NULL BEGIN.END)))
+                 (TO.TAG.LIST TAG.LIST)
+                 (TO.ARG.NAME NIL)
+                 (TO.ORIG.ARG.NAME NIL)
+                 (TO.ARGS.REMAINING (fetch TO.ARGS of NAME))
+                 (TO.DONE.FLG NIL)
+                 (TO.PROP.LIST (CONS)))
+                (DECLARE (SPECVARS TO.NAME TO.ORIG.NAME TO.BEGIN.FLG TO.ARG.NAME TO.TAG.LIST 
+                                    TO.ORIG.ARG.NAME TO.ARGS.REMAINING TO.DONE.FLG TO.PROP.LIST))
+                (if (DEFINED.TO NAME)
+                    then (APPLY (fetch TO.PROG of NAME))
+                  else (GOBBLE.DUMP.UNDEFINED))
+                (if (NOT TO.DONE.FLG)
+                    then (if (AND (fetch TO.ARGS of NAME)
+                                          (NULL TO.ARG.NAME)
+                                          (NULL TO.ARGS.REMAINING))
+                                 then 
+
+         (* if the TO has used up all args, but hasn't formally completed scanning, 
+       close it automatically)
+
+                                       (GET.ARG)
+                               else (ERROR (CONCAT "TO function: " (fetch TO.PROG
+                                                                          of NAME)
+                                                      " ended with input in bad state"]
+          (GO loop])
+
+(GOBBLE.DUMP
+  [LAMBDA (NO.SKIP.FLG)                                  (* mjs "21-APR-83 13:48")
+    (PROG NIL
+          (COND
+             ((NOT NO.SKIP.FLG)
+              (SKIP.WHITE.SPACE)))
+          (GOBBLE)
+          (SETQ TO.ORIG.ARG.NAME NIL)
+          (SETQ TO.ARG.NAME NIL])
+
+(GOBBLE.DUMP.UNDEFINED
+  [LAMBDA NIL                                            (* mjs "10-Apr-85 09:53")
+
+         (* * old fn def%: (WARNING T TO.ORIG.NAME 
+       " is undefined as a TO  --- contents will be dumped")
+       (DUMP.ARG))
+
+         (* * current behavior%: for unidentified name, print out "{<bad-name> <arg>}")
+
+    (SAVE.INFILE.NOTE 'BAD.TO.NAME TO.ORIG.NAME)
+    (IM.DUMP.CHARS "{")
+    (IM.DUMP.CHARS TO.ORIG.NAME)
+    (DUMP.ARG T)                                         (* dump rest of TO, WITHOUT SKIPPING 
+                                                           SPACES)
+    (IM.DUMP.CHARS "}"])
+
+(GOBBLE.FLUSH
+  [LAMBDA NIL                                            (* mjs "22-APR-83 10:37")
+
+         (* this flushes all gobbled chars by means of an incredible hack ---
+       by initializing GOBBLE.SAVE.CONC to NIL rather than
+       (NIL)%, none of the TCONCs can update the saved list)
+
+    (PROG ((GOBBLE.SAVE.CONC NIL))
+          (DECLARE (SPECVARS GOBBLE.SAVE.CONC))
+          (GOBBLE)
+          (SETQ TO.ORIG.ARG.NAME NIL)
+          (SETQ TO.ARG.NAME NIL])
+
+(GOBBLE.SAVE
+  [LAMBDA (NO.SKIP.FLG)                                  (* mjs "21-APR-83 13:49")
+    (PROG ((GOBBLE.SAVE.CONC (CONS)))
+          (DECLARE (SPECVARS GOBBLE.SAVE.CONC))
+          (COND
+             ((NOT NO.SKIP.FLG)
+              (SKIP.WHITE.SPACE)))
+          (GOBBLE)
+          (SETQ TO.ORIG.ARG.NAME NIL)
+          (SETQ TO.ARG.NAME NIL)
+          (RETURN GOBBLE.SAVE.CONC])
+
+(GOBBLE.TRIVIAL
+  [LAMBDA NIL                                            (* mjs "12-Jul-85 12:41")
+    (PROG (C SAVE.FILE.PTR PARSED.NAME)
+          (SKIP.WHITE.SPACE)
+          (SETQ SAVE.FILE.PTR (SUB1 (GETFILEPTR IM.INFILE)))
+          (SETQ C (if (EOFP IM.INFILE)
+                      then (IM.FILE.EOF)
+                    else (BIN IM.INFILE)))
+          (if (EQ C 'EOF)
+              then (if (NEQ TO.NAME NIL)
+                           then (IM.ERROR "EOF - closing bracket for " (DESCRIBE.CURRENT.TO))
+                              )
+                    (RETURN NIL)
+            elseif (EQ C (CHARCODE }))
+              then (if (AND TO.BEGIN.FLG (NOT TO.ARG.NAME))
+                           then (IM.ERROR "} closes " (DESCRIBE.CURRENT.TO)))
+                    (RETURN NIL)
+            elseif (EQ C (CHARCODE {))
+              then (if TO.ARG.NAME
+                           then (IM.ERROR "{ terminates trivial arg " (DESCRIBE.CURRENT.TO))
+                                 (SETFILEPTR IM.INFILE SAVE.FILE.PTR)
+                                 (RETURN NIL)
+                         else (SETQ PARSED.NAME (PARSE.TO.NAME))
+                               (if (AND (LISTP PARSED.NAME)
+                                            (EQ (CAR PARSED.NAME)
+                                                'END)
+                                            (TO.MATCH (CADR PARSED.NAME)
+                                                   T
+                                                   (CADDR PARSED.NAME)))
+                                   then (RETURN NIL)
+                                 else (IM.ERROR (if (LISTP PARSED.NAME)
+                                                        then (DESCRIBE.TO (CAR PARSED.NAME)
+                                                                        (CADR PARSED.NAME)
+                                                                        (CADDR PARSED.NAME))
+                                                      else (DESCRIBE.TO NIL PARSED.NAME NIL))
+                                                 " found in trivial "
+                                                 (DESCRIBE.CURRENT.TO)
+                                                 " --- auto-completed")
+                                       (SETFILEPTR IM.INFILE SAVE.FILE.PTR)
+                                       (RETURN NIL)))
+            else (IM.ERROR "garbage character found in trivial " (DESCRIBE.CURRENT.TO)
+                            " --- auto-completed")
+                  (SETFILEPTR IM.INFILE SAVE.FILE.PTR)
+                  (RETURN NIL])
+
+(IM.DUMP.CHARS
+  [LAMBDA (X)                                            (* mjs "13-APR-83 17:01")
+    (COND
+       [(AND (LISTP X)
+             (LISTP (CDR X)))
+        (COND
+           ((BOUNDP 'GOBBLE.SAVE.CONC)
+            (CONCCONC GOBBLE.SAVE.CONC X))
+           (T (for C in (CAR X) do (DUMP C]
+       (X (IM.DUMP.CHARS (MAKE.SAVE X])
+
+(IM.FILE.EOF
+  [LAMBDA NIL                                            (* mjs "25-Jul-85 10:49")
+    (if INFILE.STACK
+        then (IM.WARNING "EOF - included file: " IM.INFILE.FILENAME)
+              (PRINT.INFILE.NOTES)
+              (CLOSEF IM.INFILE)
+              (PROG ((LASTFILEINFO (pop INFILE.STACK)))
+                    (SETQ IM.INFILE (CAR LASTFILEINFO))
+                    (SETQ IM.INFILE.FILENAME (CDR LASTFILEINFO)))
+              (BIN IM.INFILE)
+      else (IM.WARNING "EOF - top-level file: " IM.INFILE.FILENAME)
+            (PRINT.INFILE.NOTES)
+            'EOF])
+
+(IM.PRINT.MESSAGE
+  [LAMBDA (WARNING.STRING PRINT.CONTEXT.FLAG MESSAGE.LIST)
+                                                             (* mjs "12-Sep-85 08:30")
+    (PROG NIL
+          [if [AND ERRFILE.NAME (OR (NULL ERRFILE)
+                                        (NOT (OPENP ERRFILE]
+              then (SETQ ERRFILE (OPENSTREAM ERRFILE.NAME 'OUTPUT 'NEW]
+          (for PRINTFILE in (LIST T ERRFILE) when PRINTFILE
+             do 
+
+         (* * print out identical warning on terminal <PRINTFILE=T> and in error file 
+       <PRINTFILE=ERRFILE>. If ERRFILE=NIL, warning is only printed on terminal)
+
+                   (PRIN3 WARNING.STRING PRINTFILE)
+                   (for Y in MESSAGE.LIST do (PRIN3 Y PRINTFILE))
+                   (TERPRI PRINTFILE)
+                   (if (AND PRINT.CONTEXT.FLAG (OPENP IM.INFILE)
+                                (NOT (EOFP IM.INFILE)))
+                       then (PROG ((SAVEPOS (GETFILEPTR IM.INFILE))
+                                       BEGINPOS ENDPOS)
+                                      (SETQ BEGINPOS (IMAX 0 (IDIFFERENCE SAVEPOS 100)))
+                                      (SETQ ENDPOS (IMIN (GETEOFPTR IM.INFILE)
+                                                         (IPLUS SAVEPOS 100)))
+                                      (SETFILEPTR IM.INFILE BEGINPOS)
+                                      (printout PRINTFILE "CONTEXT:" T)
+                                      (until (IGEQ (GETFILEPTR IM.INFILE)
+                                                       ENDPOS)
+                                         do (BOUT PRINTFILE (if (FIXP (BIN IM.INFILE))
+                                                                  else (CHARCODE ~)))
+                                               (if (EQ (GETFILEPTR IM.INFILE)
+                                                           SAVEPOS)
+                                                   then (printout PRINTFILE T "---->" T)))
+                                      (printout PRINTFILE T "ENDCONTEXT:" T T)
+                                      (SETFILEPTR IM.INFILE SAVEPOS])
+
+(IMTRAN
+  [LAMBDA (INFILE.NAME)                                  (* mjs "25-Jul-85 10:44")
+    (PROG ((IM.INFILE NIL)
+           (INFILE.STACK NIL)
+           (IM.INFILE.FILENAME)
+           (WARNING.COUNT.DOWN -1)
+           (SUBSEC.COUNT.LIST '(0))
+           (SUBSEC.LAST.SUB 0)
+           (FOOTNOTE.NUM 0)
+           (FIGURE.NUM 0)
+           (INITIAL.WIDTH 462)
+           (INITIAL.INDENT 0))
+          (DECLARE (SPECVARS IM.INFILE INFILE.STACK IM.INFILE.FILENAME WARNING.COUNT.DOWN 
+                              SUBSEC.COUNT.LIST SUBSEC.LAST.SUB FOOTNOTE.NUM FIGURE.NUM INITIAL.WIDTH
+                              INITIAL.INDENT))
+          (OPEN.IM.FILE INFILE.NAME)
+
+         (* * note%: SUBSEC.COUNT.LIST and SUBSEC.LAST.SUB set so that if no CHAPTER TO 
+       is given, this is treated like chapter 0)
+
+          (if IM.NOTE.FLG
+              then (IM.WARNING 
+                     "
+           WARNING: --- Note facility enabled --- Notes will be printed ---
+ "))
+          (do (PROG ((TO.NAME NIL)
+                         (TO.ORIG.NAME NIL)
+                         (TO.BEGIN.FLG NIL)
+                         (TO.TAG.LIST NIL)
+                         (TO.ARG.NAME NIL)
+                         (TO.ORIG.ARG.NAME NIL)
+                         (TO.ARGS.REMAINING NIL)
+                         (TO.DONE.FLG NIL)
+                         (TO.PROP.LIST (CONS)))
+                        (DECLARE (SPECVARS TO.NAME TO.ORIG.NAME TO.BEGIN.FLG TO.ARG.NAME 
+                                            TO.TAG.LIST TO.ORIG.ARG.NAME TO.DONE.FLG TO.PROP.LIST))
+                                                             (* set initial indentation and width)
+                        (PUT.MY.PROP 'WIDTH INITIAL.WIDTH)
+                        (PUT.MY.PROP 'INDENT INITIAL.INDENT)
+                                                             (* dump everything, including white 
+                                                           space at beginning)
+                        (DUMP.ARG T)) repeatuntil (COND
+                                                             ((AND (EOFP IM.INFILE)
+                                                                   (NULL INFILE.STACK)))
+                                                             (T (IM.ERROR 
+                                                    "unmatched right bracket at top level -- ignored"
+                                                                       )
+                                                                NIL)))
+          (CLOSEF IM.INFILE])
+
+(INCLUDE.FILE
+  [LAMBDA (FILENAME)                                     (* mjs "12-Jul-85 15:41")
+    (IM.WARNING)
+    (IM.WARNING)
+    (OPEN.IM.FILE FILENAME])
+
+(LIST.ORDER
+  [LAMBDA (A B)                                          (* mjs "20-JUN-83 16:33")
+    (if (AND (LISTP A)
+                 (LISTP B))
+        then (if (EQUAL (CAR A)
+                                (CAR B))
+                     then (LIST.ORDER (CDR A)
+                                     (CDR B))
+                   else (LIST.ORDER (CAR A)
+                                   (CAR B)))
+      else (ALPHORDER A B])
+
+(LIST.TO.STRING
+  [LAMBDA (LST)                                          (* mjs "26-SEP-83 15:20")
+    (PROG ((STR ""))
+          [for X on LST do (SETQ STR (CONCAT STR (CAR X)
+                                                        (if (CDR X)
+                                                            then " "
+                                                          else ""]
+          (RETURN STR])
+
+(MAKE.SAVE
+  [LAMBDA (X)                                            (* mjs "10-Apr-85 17:31")
+    (if (NULL X)
+        then NIL
+      elseif (LISTP X)
+        then (CONCCONC (MAKE.SAVE (CAR X))
+                        (MAKE.SAVE (CDR X)))
+      else (PROG [(S (if (IMAGEOBJP X)
+                             then (CONS X)
+                           else (CHCON X]
+                     (RETURN (CONS S (LAST S])
+
+(OPEN.IM.FILE
+  [LAMBDA (FILENAME)                                     (* mjs "10-Jul-86 15:31")
+    (PROG ((DIR.LIST (if IM.INFILE.FILENAME
+                         then (CONS (PACKFILENAME 'HOST (FILENAMEFIELD IM.INFILE.FILENAME
+                                                                   'HOST)
+                                               'DIRECTORY
+                                               (FILENAMEFIELD IM.INFILE.FILENAME 'DIRECTORY))
+                                        DIRECTORIES)
+                       else DIRECTORIES))
+           (OPEN.FILE.RESULT NIL)
+           NEW.FILENAME NEW.FILE)
+          (DECLARE (SPECVARS NEW.FILENAME NEW.FILE))
+          (SETQ NEW.FILENAME (if (INFILEP FILENAME)
+                               elseif (if (NULL (FILENAMEFIELD FILENAME 'EXTENSION))
+                                              then (FINDFILE (PACKFILENAME 'BODY FILENAME
+                                                                        'EXTENSION
+                                                                        'IM)
+                                                              T DIR.LIST))
+                               elseif (FINDFILE FILENAME T DIR.LIST)
+                               else NIL))
+          [if (NULL NEW.FILENAME)
+              then (IM.WARNING "Can't find file: " FILENAME "  --- using NULL file")
+                    (SETQ NEW.FILENAME '{NULL}FOO.IM)
+                    (SETQ NEW.FILE (OPENSTREAM '{NULL}FOO.IM 'INPUT))
+            else (for W in '(5000 10000 20000 40000 80000)
+                        do (IM.WARNING "Opening File: " NEW.FILENAME)
+                              [SETQ OPEN.FILE.RESULT (NLSETQ (SETQ NEW.FILE (OPENTEXTSTREAM 
+                                                                                   NEW.FILENAME]
+                              (if (NULL OPEN.FILE.RESULT)
+                                  then (IM.WARNING "Error opening file " NEW.FILENAME 
+                                                  "  -- waiting " W " msecs and trying again")
+                                        (BLOCK W)) repeatuntil OPEN.FILE.RESULT)
+                  (if (NULL OPEN.FILE.RESULT)
+                      then (IM.WARNING "Can't open file " FILENAME "  --- using NULL file")
+                            (SETQ NEW.FILENAME '{NULL}FOO.IM)
+                            (SETQ NEW.FILE (OPENSTREAM '{NULL}FOO.IM 'INPUT]
+          (if IM.INFILE
+              then (push INFILE.STACK (CONS IM.INFILE IM.INFILE.FILENAME)))
+          (SETQ IM.INFILE.FILENAME NEW.FILENAME)
+          (SETQ IM.INFILE NEW.FILE)
+          (for X in IM.INFILE.NOTE.TAGS do (PUTPROP IM.INFILE.FILENAME X NIL])
+
+(PARSE.ATOM
+  [LAMBDA (SAV)                                          (* mjs "19-MAY-83 12:20")
+
+         (* * note%: eventually, this should be modified so that it doesn't just throw 
+       away everything but the first atom, so that you can DEF things with multiple 
+       words (low priority))
+
+    (CAR (PARSE.LIST SAV])
+
+(PARSE.INDEX.SPEC
+  [LAMBDA (SAV END.FLG)                                  (* mjs "11-AUG-83 15:26")
+
+         (* * parses the argument to INDEX#TOPROG or REF#TOPROG, which may include an 
+       object type. For {index...}, the argument has the form "xxx xxx <object-type>" 
+       %. For {SectionRef ...} or {PageRef...}, the arg has the for "<object-type> xxx xxx" 
+       %. If END.FLG is true, the object-type is at the end of the arg.
+       PARSE.INDEX.SPEC returns a list (<list of arg words> . <object-type>))
+
+    (PROG ((BEGIN.PAREN (CHARCODE %())
+           (END.PAREN (CHARCODE %)))
+           (TYPE 'TERM)
+           (LST NIL)
+           TYPE.LST CHAR.LST TEMP (PARENS.TYPE.FLG NIL))
+          (SETQ CHAR.LST (APPEND (CAR SAV)))
+          (if END.FLG
+              then (SETQ CHAR.LST (DREVERSE CHAR.LST))
+                    (SETQ BEGIN.PAREN (CHARCODE %)))
+                    (SETQ END.PAREN (CHARCODE %()))
+          (while (MEMB (CAR CHAR.LST)
+                           (CHARCODE (SPACE TAB CR))) do (SETQ CHAR.LST (CDR CHAR.LST)))
+          (if (AND (EQ BEGIN.PAREN (CAR CHAR.LST))
+                       (SETQ TEMP (MEMB END.PAREN CHAR.LST)))
+              then (SETQ TYPE.LST (LDIFF (CDR CHAR.LST)
+                                             TEMP))
+                    (SETQ CHAR.LST (CDR TEMP))
+                    (if END.FLG
+                        then (SETQ TYPE.LST (REVERSE TYPE.LST)))
+                    [SETQ TYPE (PARSE.LIST (CONS TYPE.LST (LAST TYPE.LST]
+                    (if (NULL TYPE)
+                        then (SETQ TYPE 'TERM))
+                    (SETQ PARENS.TYPE.FLG T))
+          (if END.FLG
+              then (SETQ CHAR.LST (DREVERSE CHAR.LST)))
+          [SETQ LST (PARSE.LIST (CONS CHAR.LST (LAST CHAR.LST]
+          [if [AND (NOT PARENS.TYPE.FLG)
+                       (SETQ TEMP (TRANSLATE.SPECIAL.TYPES
+                                   (U-CASE (if END.FLG
+                                               then (CAR (LAST LST))
+                                             else (CAR LST]
+              then (SETQ TYPE TEMP)
+                    (SETQ LST (if END.FLG
+                                  then (CAR (LASTN LST 1))
+                                else (CDR LST]
+          (RETURN (CONS LST TYPE])
+
+(PARSE.LIST
+  [LAMBDA (SAV PAREN.FLG)                                (* mjs " 5-AUG-83 14:42")
+
+         (* * if PAREN.FLG then the left and right paren chars parse as self-delimiting 
+       atoms)
+
+    (if (NULL SAV)
+        then NIL
+      elseif (AND (LISTP SAV)
+                      (LISTP (CDR SAV)))
+        then [PROG [(CHARS (CAR SAV))
+                        (ELIST NIL)
+                        (CLIST NIL)
+                        (DELIM.CHARS (if PAREN.FLG
+                                         then (CHARCODE (SP TAB CR %( %)))
+                                       else (CHARCODE (SP TAB CR]
+                       [for X in CHARS when (SMALLP X)
+                          do (if (FMEMB X DELIM.CHARS)
+                                     then (if CLIST
+                                                  then (SETQ ELIST (CONS (PACKC (DREVERSE CLIST))
+                                                                             ELIST))
+                                                        (SETQ CLIST NIL))
+                                           (if [AND PAREN.FLG (FMEMB X (CHARCODE (%( %)]
+                                               then (SETQ ELIST (CONS (CHARACTER X)
+                                                                          ELIST)))
+                                   else (SETQ CLIST (CONS X CLIST]
+                       (RETURN (DREVERSE (if CLIST
+                                             then (CONS (PACKC (DREVERSE CLIST))
+                                                            ELIST)
+                                           else ELIST]
+      else NIL])
+
+(PARSE.NUMBER.OR.PERCENTAGE
+  [LAMBDA (SAV TOTAL IF.BAD.NUM)                         (* mjs "20-APR-83 11:47")
+    (PROG ((NUM (PARSE.ATOM SAV)))
+          (if (NUMBERP NUM)
+              then (RETURN (FIX NUM)))
+          [if (STRPOS "PERCENT" (U-CASE NUM))
+              then (SETQ NUM
+                        (PACK (for X in (UNPACK NUM)
+                                 while (MEMB X
+                                                 '(0 1 2 3 4 5 6 7 8 9 %.)) collect X]
+          [if (NUMBERP NUM)
+              then (RETURN (FIX (FTIMES 0.01 TOTAL NUM]
+          (RETURN IF.BAD.NUM])
+
+(PARSE.STRING
+  [LAMBDA (SAV)                                          (* mjs "20-APR-83 11:44")
+    (if (NULL SAV)
+        then ""
+      elseif (AND (LISTP SAV)
+                      (LISTP (CAR SAV)))
+        then (CONCATLIST (for X in (CAR SAV) when (SMALLP X)
+                                collect (CHARACTER X)))
+      else ""])
+
+(PARSE.TO.NAME
+  [LAMBDA NIL                                            (* mjs "12-Jul-85 12:48")
+
+         (* * PARSE.TO.NAME is called just after GOBBLE finds a left-bracket.
+       It scans the file for the TO name which should follow.
+       It also processes {Begin and {End constructs.
+       Note%: this function will not scan past the end of the current 
+       possibly-included file, so that GOBBLE can move the pointer back if necessary.)
+
+         (* * PARSE.TO.NAME returns%: (1) If the current word is not BEGIN or END, a 
+       litatom which is the upper-case version of the name, and leaves the file 
+       pointer to the next character after the name.
+       (2) If the current word is BEGIN/END, a list of the form
+       (BEGIN/END TONAME TAG.LIST) In this case, the file ptr is left after the 
+       closing }, or at the closing {, if one is found.)
+
+    (PROG (CLIST ELIST NAME C)
+          (SETQ CLIST NIL)
+          (until (EOFP IM.INFILE) do (SETQ C (BIN IM.INFILE))
+                                            (SETQ CLIST (CONS C CLIST)) repeatwhile (
+                                                                                       TO.NAME.CHAR
+                                                                                         C))
+          [COND
+             ((NOT (TO.NAME.CHAR C))
+              (SETQ CLIST (CDR CLIST))
+              (SETFILEPTR IM.INFILE (SUB1 (GETFILEPTR IM.INFILE]
+          [SETQ NAME (U-CASE (PACKC (DREVERSE CLIST]         (* if the scan was ternimated by end 
+                                                           of file, print warning)
+          (COND
+             ((EOFP IM.INFILE)
+              (IM.ERROR "TO Spec " (DESCRIBE.TO NIL NAME NIL)
+                     " terminated by EOF" " --- auto-completed")))
+          (COND
+             ((AND (NEQ NAME 'BEGIN)
+                   (NEQ NAME 'END))
+              (RETURN NAME)))
+          (SETQ ELIST NIL)
+          (SETQ CLIST NIL)
+          [until (EOFP IM.INFILE) do (SETQ C (BIN IM.INFILE))
+                                            [COND
+                                               [(FMEMB C (CHARCODE ({ } SP TAB CR)))
+                                                (COND
+                                                   (CLIST (SETQ ELIST
+                                                           (CONS (U-CASE (PACKC (DREVERSE CLIST)))
+                                                                 ELIST))
+                                                          (SETQ CLIST NIL]
+                                               (T (if (SMALLP C)
+                                                      then 
+                                                             (* ignore non-smallp chars in TO tag)
+                                                            (SETQ CLIST (CONS C CLIST]
+             repeatuntil (FMEMB C (CHARCODE ({ }]
+          (SETQ ELIST (DREVERSE ELIST))
+          (COND
+             ((AND (EOFP IM.INFILE)
+                   (EQ C (CHARCODE })))
+              (IM.ERROR "TO Spec " (DESCRIBE.TO NAME (CAR ELIST)
+                                          (CDR ELIST))
+                     " terminated by EOF" " --- auto-completed")))
+          [COND
+             ((EQ C (CHARCODE {))                            (* if {Begin or {End terminated by 
+                                                           {, auto-complete,)
+              (IM.ERROR "TO Spec " (DESCRIBE.TO NAME (CAR ELIST)
+                                          (CDR ELIST))
+                     " terminated by {" " --- auto-completed")
+              (SETFILEPTR IM.INFILE (SUB1 (GETFILEPTR IM.INFILE]
+          (RETURN (LIST NAME (CAR ELIST)
+                        (CDR ELIST])
+
+(PARTITION.LIST
+  [LAMBDA (LST EQUAL.FN MAKE.TOKEN.FN SORT.TOKEN.FN)     (* ; "Edited  8-Dec-91 15:03 by jds")
+
+    (* ;; "LST is a list of objects (X1 X2 X3 X4 ...);  PARTITION.LIST partitions them into sublists ((X1 X4 X7 ...) (X2 X56 ...) ...) where the members of each sublist are 'equal' as determined by EQUAL.FN (default EQUAL), and returns the resulting list")
+
+    (* ;; "if MAKE.TOKEN.FN is given, this is a function applied to each object to create 'tokens' , which are compared with EQUAL.FN .  This is done so that MAKE.TOKEN.FN is done as few times as possible, which is nice if MAKE.TOKEN.FN is expensive.  For example, (PARTITION.LIST L (QUOTE EQ) (QUOTE LENGTH)) is the same as (PARTITION L (QUOTE (LAMBDA (A B) (EQ (LENGTH A) (LENGTH B))))), but much less expensive, since LENGTH is only computed once for each element of L")
+
+    (* ;; "if SORT.TOKEN.FN is given, the list is sorted by the 'order' of the tokens as determined by essentially evaluating (SORT <tokenlist> SORT.TOKEN.FN)")
+
+    (PROG ((NEWLIST NIL)
+           SUBNEWLIST)
+          (DECLARE (SPECVARS SORT.TOKEN.FN))
+          (if (NULL EQUAL.FN)
+              then (SETQ EQUAL.FN 'EQUAL))
+          [if (NULL MAKE.TOKEN.FN)
+              then (SETQ MAKE.TOKEN.FN (FUNCTION (LAMBDA (X)
+                                                       X]
+          [for OBJECT in LST bind OBJECT.TOKEN
+             do (SETQ OBJECT.TOKEN (APPLY* MAKE.TOKEN.FN OBJECT)) 
+                                                             (* ; 
+                       "find first sublist in NEWLIST whose CAR is a token 'equal' to OBJECT.TOKEN")
+                   [SETQ SUBNEWLIST (for X in NEWLIST thereis (APPLY* EQUAL.FN 
+                                                                                 OBJECT.TOKEN
+                                                                                 (CAR X]
+                   (if SUBNEWLIST
+                       then                              (* ; 
+                              "if there is such a sublist, put OBJECT second in list <after token>")
+                             (RPLACD SUBNEWLIST (CONS OBJECT (CDR SUBNEWLIST)))
+                     else (SETQ NEWLIST (CONS (LIST OBJECT.TOKEN OBJECT)
+                                                  NEWLIST]   (* ; 
+                                          "if SORT.TOKEN.FN is given, sort the lists by the tokens")
+          [if SORT.TOKEN.FN
+              then (SORT NEWLIST (FUNCTION (LAMBDA (X Y)
+                                                 (APPLY* SORT.TOKEN.FN (CAR X)
+                                                        (CAR Y]
+                                                             (* ; 
+                                                    "get rid of token at beginning of each sublist")
+          (for X in NEWLIST do (RPLNODE2 X (CDR X)))
+          (RETURN NEWLIST])
+
+(PRINT.INFILE.NOTES
+  [LAMBDA NIL                                            (* mjs "25-Jul-85 10:48")
+    (for TYP in IM.INFILE.NOTE.TAGS bind LST when (SETQ LST (GETPROP 
+                                                                                   IM.INFILE.FILENAME
+                                                                                   TYP))
+       do (SETQ LST (SORT (INTERSECTION LST LST)))
+             (IM.WARNING " ----------  " (SELECTQ TYP
+                                             (UNDEF.FN "Undefined Functions")
+                                             (UNBOUND.VAR "Unbound Variables")
+                                             (IM.TAG "Tags")
+                                             (IM.NO.REFS "Unresolved References")
+                                             (MKSTRING TYP)))
+             (for X in LST do (IM.WARNING "     " X)) finally (IM.WARNING])
+
+(PUT.MY.PROP
+  [LAMBDA (PROPNAME VAL)                                 (* mjs "13-APR-83 10:30")
+    (LISTPUT TO.PROP.LIST PROPNAME VAL])
+
+(SAVE.ARG
+  [LAMBDA (NO.SKIP.FLG)                                  (* mjs "21-APR-83 14:14")
+    (PROG (SAVE)
+          (if (fetch TO.ARGS of TO.NAME)
+              then (if TO.ARG.NAME
+                           then (SETQ SAVE (GOBBLE.SAVE NO.SKIP.FLG))
+                                 (SETQ TO.ARG.NAME NIL)
+                         else (ERROR "TO PROG BUG: attempting to dump arg not yet gotten"))
+            else (if (NOT TO.DONE.FLG)
+                         then (SETQ SAVE (GOBBLE.SAVE NO.SKIP.FLG))
+                               (SETQ TO.DONE.FLG T)
+                       else (ERROR "TO PROG BUG: attempting to process unlabeled arg twice")))
+          (RETURN SAVE])
+
+(SAVE.ARGS
+  [NLAMBDA GOOD.ARGS                                     (* mjs "18-APR-83 16:55")
+
+         (* * gets and saves args with the names on GOOD.ARGS until an unknown name 
+       comes up. If duplicate names come up, the later arg replaces the formar.)
+
+    (PROG (ANAME (ARG.PROPLIST (CONS)))
+          (if TO.DONE.FLG
+              then (PUT.MY.PROP 'SAVE.ARGS.PROPLIST NIL)
+                    (RETURN NIL))
+      loop
+          (SETQ ANAME (GET.ARG))
+          (if (AND ANAME (FMEMB ANAME GOOD.ARGS))
+              then (LISTPUT ARG.PROPLIST ANAME (SAVE.ARG))
+                    (GO loop)
+            else (PUT.MY.PROP 'SAVE.ARGS.PROPLIST (COND
+                                                             ((CDR ARG.PROPLIST)
+                                                              ARG.PROPLIST)
+                                                             (T NIL)))
+                  (RETURN ANAME])
+
+(SAVE.ARGS.EMPTY
+  [LAMBDA NIL                                            (* mjs "13-APR-83 10:29")
+
+         (* if called right after a call to SAVE.ARGS, this will return T if SAVE.ARGS 
+       did not find any args, and the TO has been closed.)
+
+    (AND TO.DONE.FLG (NOT (GET.MY.PROP 'SAVE.ARGS.PROPLIST])
+
+(SAVE.INFILE.NOTE
+  [LAMBDA (TYP NAM)                                      (* mjs "29-Jul-85 16:29")
+    (PUTPROP IM.INFILE.FILENAME TYP (CONS NAM (GETPROP IM.INFILE.FILENAME TYP])
+
+(SCRUNCH.REFS
+  [LAMBDA (REFS)                                         (* mjs "28-SEP-83 12:01")
+    (PROG (REFS.BY.TYPE)
+
+         (* * REFS is list with elements of form%:
+       (type text info section file fileptr))
+
+         (* * REFS.BY.TYPE is list with elements of form%:
+       ((type text info section file fileptr) (type text info section file fileptr) 
+       ...) partioned by type, case-independent, sorted by ALPHORDER of U-CASE of type)
+
+          [SETQ REFS.BY.TYPE (PARTITION.LIST REFS NIL [FUNCTION (LAMBDA (A)
+                                                                      (U-CASE (CAR A]
+                                    (FUNCTION (LAMBDA (A B)
+                                                (LIST.ORDER A B]
+          (RETURN
+           (for REFS.ON.ONE.TYPE in REFS.BY.TYPE bind REFS.BY.FILE
+              collect
+
+         (* REFS.BY.FILE is list of refs partioned by file, case-independent, sorted by 
+       ALPHORDER of U-CASE of file)
+
+              (SETQ REFS.BY.FILE (PARTITION.LIST REFS.ON.ONE.TYPE NIL
+                                        [FUNCTION (LAMBDA (A)
+                                                    (U-CASE (CAR (CDDDDR A]
+                                        (FUNCTION ALPHORDER)))
+              (CONS
+               (if (NLISTP (CAAR REFS.ON.ONE.TYPE))
+                   then (MKSTRING (L-CASE (CAAR REFS.ON.ONE.TYPE)
+                                             T))
+                 else (LIST.TO.STRING (L-CASE (CAAR REFS.ON.ONE.TYPE)
+                                                     T)))
+               (for REFS.ON.ONE.FILE in REFS.BY.FILE
+                  collect
+                  (CONS [U-CASE (CAR (CDDDDR (CAR REFS.ON.ONE.FILE]
+                        (PROG [(SMALLREFS (for REF in REFS.ON.ONE.FILE
+                                             collect (LIST (if (MEMB '*PRIMARY* (CADDR REF))
+                                                                   then 'Primary
+                                                                 elseif (MEMB '*DEF* (CADDR
+                                                                                          REF))
+                                                                   then 'Definition
+                                                                 else NIL)
+                                                               (CADR (CDDDDR REF]
+                              [SORT SMALLREFS (FUNCTION (LAMBDA (A B)
+                                                          (IGEQ (CADR B)
+                                                                (CADR A]
+                              (RETURN (APPLY 'NCONC SMALLREFS])
+
+(SEND.IMPLICIT
+  [LAMBDA (NAME TYPE SAV)                                (* mjs " 5-AUG-83 13:55")
+
+         (* if IM.SEND.IMPLICIT is true and there are no references to this object in 
+       the index table, then send an implicit reference to this object)
+
+    (if (AND IM.SEND.IMPLICIT (for X in (GETHASH NAME IMPTR.HASH)
+                                     never (EQUAL (CAR X)
+                                                      TYPE)))
+        then (if (U-CASEP NAME)
+                     then (SEND.INFO NAME TYPE NIL '(*IMPLICIT*))
+                   else (SEND.INFO (U-CASE NAME)
+                                   TYPE NAME '(*IMPLICIT*])
+
+(SKIP.WHITE.SPACE
+  [LAMBDA NIL                                            (* mjs "10-Apr-85 10:09")
+    (PROG (X)
+          [do (SETQ X (if (EOFP IM.INFILE)
+                              then (IM.FILE.EOF)
+                            else (BIN IM.INFILE))) repeatwhile (FMEMB X
+                                                                              (CHARCODE (SPACE CR TAB
+                                                                                               ]
+          (COND
+             ((NEQ X 'EOF)
+              (SETFILEPTR IM.INFILE (SUB1 (GETFILEPTR IM.INFILE])
+
+(STANDARD.DUMMY.TO.PROG
+  [LAMBDA NIL                                            (* mjs " 9-Apr-85 16:00")
+    (IM.ERROR "Dummy TO - " TO.NAME)
+    (DUMP.ARG])
+
+(TAG.LIST.MATCH
+  [LAMBDA (TLIST1 TLIST2)                                (* mjs " 8-APR-83 15:56")
+    (EQUAL (U-CASE TLIST1)
+           (U-CASE TLIST2])
+
+(TO.MATCH
+  [LAMBDA (NAME BEGINFLG TAGLIST)                        (* mjs " 8-APR-83 15:58")
+    (AND (EQ NAME TO.NAME)
+         (EQ BEGINFLG TO.BEGIN.FLG)
+         (OR (NOT BEGINFLG)
+             (TAG.LIST.MATCH TAGLIST TO.TAG.LIST])
+
+(TO.NAME.CHAR
+  [LAMBDA (C)                                            (* mjs "12-Jul-85 12:43")
+                                                             (* returns true if C is the char 
+                                                           code of a legal TO name char)
+    (AND (SMALLP C)
+         (OR (AND (IGEQ C (CHARCODE A))
+                  (ILEQ C (CHARCODE Z)))
+             (AND (IGEQ C (CHARCODE a))
+                  (ILEQ C (CHARCODE z)))
+             (AND (IGEQ C (CHARCODE 0))
+                  (ILEQ C (CHARCODE 9])
+
+(TRANSLATE.SPECIAL.TYPES
+  [LAMBDA (X)                                            (* mjs " 9-NOV-83 12:17")
+    (SELECTQ (U-CASE X)
+        (FN '(Function))
+        (VAR '(Variable))
+        (PROP '(Property Name))
+        (BREAKCOM '(Break Command))
+        (EDITCOM '(Editor Command))
+        (PACOM '(Prog. Asst. Command))
+        (FILECOM '(File Package Command))
+        ((LITATOM ATOM) 
+             '(Litatom))
+        (ERROR '(Error Message))
+        (TERM 'TERM)
+        ((TAG FIGURE) 
+             'TAG)
+        NIL])
+
+(TRIVIAL.ARG
+  [LAMBDA NIL                                            (* mjs "21-APR-83 14:10")
+    (if (fetch TO.ARGS of TO.NAME)
+        then (if TO.ARG.NAME
+                     then (GOBBLE.TRIVIAL)
+                           (SETQ TO.ARG.NAME NIL)
+                   else (ERROR "TO PROG BUG: attempting to process ungotten arg "))
+      else (if (NOT TO.DONE.FLG)
+                   then (GOBBLE.TRIVIAL)
+                         (SETQ TO.DONE.FLG T)
+                 else (ERROR "TO PROG BUG: attempting to process unlabeled arg twice"])
+)
+(DECLARE%: EVAL@COMPILE
+
+(ATOMRECORD TO (TO.PROG TO.ARGS TO.ARG.SYNONYMS TO.TYPE TO.ARG.TYPE))
+)
+
+(RPAQQ IM.INFILE.NOTE.TAGS (UNDEF.FN UNBOUND.VAR IM.TAG IM.NO.REFS IM.FIGURE BAD.TO.NAME))
+
+(RPAQ? IM.NOTE.FLG NIL)
+
+(RPAQ? IM.DRAFT.FLG NIL)
+
+(RPAQ? IM.INDEX.FILE.FLG NIL)
+
+(RPAQ? IM.REF.FLG NIL)
+
+(RPAQ? IM.SEND.IMPLICIT NIL)
+
+(RPAQ? IM.EVEN.FLG NIL)
+
+(RPAQ? IM.CHECK.DEFS NIL)
+
+(PUTPROPS DUMPOUT INFO EVAL)
+(DECLARE%: EVAL@COMPILE 
+
+[PUTPROPS IM.ERROR MACRO (X `(IM.PRINT.MESSAGE "ERROR: " T %, (CONS 'LIST X]
+
+[PUTPROPS IM.WARNING MACRO (X `(IM.PRINT.MESSAGE "  Warning:  " NIL %, (CONS 'LIST X]
+)
+(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
+
+(ADDTOVAR NLAMA SAVE.ARGS)
+
+(ADDTOVAR NLAML GET.ARG.SAV)
+
+(ADDTOVAR LAMA )
+)
+(PUTPROPS IMTRAN COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986 1991))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (2346 60730 (ADD.ANY.PARENT.PROP.IF 2356 . 2594) (ADD.MY.PROP.IF 2596 . 2869) (
+ANC.INDENT 2871 . 3016) (ANC.WIDTH 3018 . 3161) (ANY.PARENT.CORRECT.ARG 3163 . 3345) (ANY.PARENT.EVAL 
+3347 . 3759) (ANY.PARENT.TO.MATCH 3761 . 4044) (ARGS.REMAINING 4046 . 4672) (ARGS.REMAINING.AFTER 4674
+ . 5269) (CHANGE.INDENT 5271 . 5677) (CONCCONC 5679 . 6170) (CORRECT.ARG 6172 . 6451) (CORRECT.TO 6453
+ . 8832) (DECODE.TO.ARG.NAME.SYNONYM 8834 . 9243) (DECODE.TO.NAME.SYNONYM 9245 . 9435) (DEFINED.TO 
+9437 . 9580) (DESCRIBE.CURRENT.TO 9582 . 9872) (DESCRIBE.TO 9874 . 10281) (DUMP.ARG 10283 . 10908) (
+DUMP.FORMAT 10910 . 11165) (FLUSH.ARG 11167 . 11771) (GET.ANY.PARENT.PROP 11773 . 11956) (GET.ARG 
+11958 . 16446) (GET.ARG.SAV 16448 . 16624) (GET.ARG.TYPE 16626 . 17103) (GET.MY.PROP 17105 . 17249) (
+GET.TO.TYPE 17251 . 17598) (GOBBLE 17600 . 23789) (GOBBLE.DUMP 23791 . 24094) (GOBBLE.DUMP.UNDEFINED 
+24096 . 24773) (GOBBLE.FLUSH 24775 . 25277) (GOBBLE.SAVE 25279 . 25694) (GOBBLE.TRIVIAL 25696 . 28421)
+ (IM.DUMP.CHARS 28423 . 28799) (IM.FILE.EOF 28801 . 29418) (IM.PRINT.MESSAGE 29420 . 31602) (IMTRAN 
+31604 . 34215) (INCLUDE.FILE 34217 . 34392) (LIST.ORDER 34394 . 34865) (LIST.TO.STRING 34867 . 35307) 
+(MAKE.SAVE 35309 . 35774) (OPEN.IM.FILE 35776 . 38565) (PARSE.ATOM 38567 . 38920) (PARSE.INDEX.SPEC 
+38922 . 41310) (PARSE.LIST 41312 . 43041) (PARSE.NUMBER.OR.PERCENTAGE 43043 . 43688) (PARSE.STRING 
+43690 . 44073) (PARSE.TO.NAME 44075 . 47932) (PARTITION.LIST 47934 . 50937) (PRINT.INFILE.NOTES 50939
+ . 51893) (PUT.MY.PROP 51895 . 52043) (SAVE.ARG 52045 . 52791) (SAVE.ARGS 52793 . 53768) (
+SAVE.ARGS.EMPTY 53770 . 54103) (SAVE.INFILE.NOTE 54105 . 54297) (SCRUNCH.REFS 54299 . 57088) (
+SEND.IMPLICIT 57090 . 57793) (SKIP.WHITE.SPACE 57795 . 58417) (STANDARD.DUMMY.TO.PROG 58419 . 58594) (
+TAG.LIST.MATCH 58596 . 58761) (TO.MATCH 58763 . 59013) (TO.NAME.CHAR 59015 . 59577) (
+TRANSLATE.SPECIAL.TYPES 59579 . 60118) (TRIVIAL.ARG 60120 . 60728)))))
+STOP
diff --git a/docs/Documentation Tools/IMTRAN.LCOM b/docs/Documentation Tools/IMTRAN.LCOM
new file mode 100644
index 00000000..b002ec65
Binary files /dev/null and b/docs/Documentation Tools/IMTRAN.LCOM differ
diff --git a/docs/Documentation Tools/INDEX-FORMAT.TEDIT b/docs/Documentation Tools/INDEX-FORMAT.TEDIT
new file mode 100644
index 00000000..096b1e36
Binary files /dev/null and b/docs/Documentation Tools/INDEX-FORMAT.TEDIT differ
diff --git a/docs/Documentation Tools/NONAME.IMPTR b/docs/Documentation Tools/NONAME.IMPTR
new file mode 100644
index 00000000..26a256ac
--- /dev/null
+++ b/docs/Documentation Tools/NONAME.IMPTR	
@@ -0,0 +1,2 @@
+(ASDF NIL NIL NIL ("1") 1)
+(ASDF NIL NIL NIL ("A") 2)
