(FILECREATED "23-Jan-86 14:26:21" {ERIS}<CUTTING>LISP>XQPM.;28 23757  

      changes to:  (FNS XQPM.CREF XQPM.UPDATE.FROM.CREF XQPM.CREF.TO.ID XQPM.HELP XQPM.MANUAL)

      previous date: "21-Jan-86 20:07:22" {ERIS}<CUTTING>LISP>XQPM.;26)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT XQPMCOMS)

(RPAQQ XQPMCOMS ((FILES DINFO)
                 (RECORDS XQPMREF)
                 [COMS (* Runtime code)
                       (FNS (* called from prolog)
                            XQPM.HELP XQPM.MANUAL)
                       (FNS (* called from lisp)
                            XQPM.GET.GRAPH XQPM.CREF XQPM.UPDATE.FROM.CREF XQPM.CREF.TO.ID 
                            XQPM.LOOKUP XQPM.BSEARCH XQPM.CHOOSE.REF XQPM.GATHER.REFS \XQPM.RESET)
                       (MACROS XQPM.SUBSTRINGP)
                       (INITVARS (PROLOGHELPDIRECTORY)
                              (XQPM.FONT (FONTCREATE (QUOTE TERMINAL)
                                                10)))
                       (GLOBALVARS PROLOGHELPDIRECTORY XQPM.FONT)
                       (ADDVARS (DINFO.GRAPHS ("Xerox Quintus Prolog Manual" (XQPM.GET.GRAPH T]
                 (COMS (* MAKESYS time code)
                       (FNS XQPM.SETUP XQPM.MAKEINDEX XQPM.MAKEGRAPH XQPM.MAKE.NODE 
                            XQPM.GET.PARENT.ID)
                       (INITVARS (\XQPM.INDEX.ARRAY)
                              (\XQPM.DINFO.GRAPH))
                       (GLOBALVARS \XQPM.INDEX.ARRAY \XQPM.DINFO.GRAPH))))
(FILESLOAD DINFO)
[DECLARE: EVAL@COMPILE 

(DATATYPE XQPMREF (ITEM TYPE NODEID))
]
(/DECLAREDATATYPE (QUOTE XQPMREF)
       (QUOTE (POINTER POINTER POINTER))
       (QUOTE ((XQPMREF 0 POINTER)
               (XQPMREF 2 POINTER)
               (XQPMREF 4 POINTER)))
       (QUOTE 6))



(* Runtime code)

(DEFINEQ

(XQPM.HELP
  [LAMBDA (ATOM)                                                          (* drc: 
                                                                          "23-Jan-86 14:06")
            
            (* * Lookup ATOM in the index of the online manual.
            Called by prolog predicate "help(Topic)")

    (LET ((GRAPH (XQPM.GET.GRAPH)))
         (RESETFORM (TTYDISPLAYSTREAM (GETPROMPTWINDOW (fetch (DINFOGRAPH WINDOW) of GRAPH)))
                (XQPM.LOOKUP (MKSTRING ATOM)
                       GRAPH))
     NIL])

(XQPM.MANUAL
  [LAMBDA (SECTION)                                                       (* drc: 
                                                                          "23-Jan-86 14:06")
            
            (* * Visit SECTION of the online manual.
            Called by prolog predicate "manual(Section)")

    (LET ((GRAPH (XQPM.GET.GRAPH)))
         (RESETFORM (TTYDISPLAYSTREAM (GETPROMPTWINDOW (fetch (DINFOGRAPH WINDOW) of GRAPH)))
                (XQPM.UPDATE.FROM.CREF (MKSTRING SECTION)
                       GRAPH))
     NIL])
)
(DEFINEQ

(XQPM.GET.GRAPH
  [LAMBDA (FROMBACKGROUND?)                                               (* drc: 
                                                                          "21-Jan-86 19:46")
            
            (* * Returns the DInfo graph for the XQPM, initializing if necesary.)

    (DECLARE (GLOBALVARS PROLOGHELPDIRECTORY \XQPM.DINFO.GRAPH))          (* drc: 
                                                                          "19-Dec-85 17:47")
    (if (AND (type? DINFOGRAPH \XQPM.DINFO.GRAPH)
             (WINDOWP (fetch (DINFOGRAPH WINDOW) of \XQPM.DINFO.GRAPH)))
        then \XQPM.DINFO.GRAPH
      elseif (INFILEP (PACKFILENAME (QUOTE NAME)
                             (QUOTE R0101)
                             (QUOTE BODY)
                             PROLOGHELPDIRECTORY))
        then (OR (type? DINFOGRAPH \XQPM.DINFO.GRAPH)
                 (ERROR "XQPM DInfo graph not installed!" "Try (XQPM.SETUP >>HOST&DIR<<)."))
             (replace (DINFOGRAPH DEFAULTHOST) of \XQPM.DINFO.GRAPH with (FILENAMEFIELD 
                                                                                PROLOGHELPDIRECTORY
                                                                                (QUOTE HOST)))
             (replace (DINFOGRAPH DEFAULTDEVICE) of \XQPM.DINFO.GRAPH with (FILENAMEFIELD
                                                                            PROLOGHELPDIRECTORY
                                                                            (QUOTE DEVICE)))
             (replace (DINFOGRAPH DEFAULTDIR) of \XQPM.DINFO.GRAPH with (FILENAMEFIELD 
                                                                               PROLOGHELPDIRECTORY
                                                                               (QUOTE DIRECTORY)))
             (replace (DINFOGRAPH TEXTPROPS) of \XQPM.DINFO.GRAPH with (LIST (QUOTE FONT)
                                                                             XQPM.FONT))
             (replace (DINFOGRAPH MENUFONT) of \XQPM.DINFO.GRAPH with XQPM.FONT)
             (replace (DINFOGRAPH WINDOW) of \XQPM.DINFO.GRAPH
                with (CREATEW (GETBOXREGION 500 300 NIL NIL NIL "Specify region for XQPM DInfo Graph"
                                     )
                            "XQPM DInfo Graph"))
             (OR FROMBACKGROUND? (DINFO \XQPM.DINFO.GRAPH NIL T T))
             \XQPM.DINFO.GRAPH
      else (ERROR "Set PROLOGHELPDIRECTORY to the location of the manual files.")
           NIL])

(XQPM.CREF
  [LAMBDA (ITEM FM.WINDOW BUTTONS)                                        (* drc: 
                                                                          "23-Jan-86 14:16")
    (LET*((GRAPH (DINFOGRAPH FM.WINDOW))
          (W (fetch (DINFOGRAPH WINDOW) of GRAPH))
          (TEXTSTREAM (WINDOWPROP W (QUOTE TEXTSTREAM)))
          (TEXTOBJ (TEXTOBJ TEXTSTREAM))
          CREF SEL)
     (RESETFORM (TTYDISPLAYSTREAM (GETPROMPTWINDOW W))
            (CLEARW T)
            (SELECTQ (FM.ITEMPROP ITEM (QUOTE ID))
                (GOTOREF (SETQ SEL (TEDIT.SEL.AS.STRING TEXTSTREAM (TEDIT.GETSEL TEXTSTREAM)))
                         (if (AND (STRING-EQUAL (SUBSTRING SEL 1 8)
                                         "{manual(")
                                  (STRING-EQUAL (SUBSTRING SEL -2)
                                         ")}"))
                             then (XQPM.UPDATE.FROM.CREF (SUBSTRING SEL 9 -3)
                                         GRAPH)
                           else (PRINTOUT T T "No cross reference selected.  Try NextRef!")))
                (NEXTREF (PRINTOUT T "Searching...")
                         (SETQ CREF (TEDIT.FIND TEXTOBJ "{manual(*)}" NIL NIL T))
                         (if CREF
                             then (TEDIT.NORMALIZECARET TEXTOBJ (SETQ SEL
                                                                 (TEDIT.SETSEL
                                                                  TEXTSTREAM
                                                                  (CAR CREF)
                                                                  (ADD1 (IDIFFERENCE (CADR CREF)
                                                                               (CAR CREF)))
                                                                  (QUOTE RIGHT)
                                                                  T)))
                                  (PRINTOUT T T "OK.  Select GoToRef! to go to "
                                         (SUBSTRING (TEDIT.SEL.AS.STRING TEXTSTREAM SEL)
                                                2 -2)
                                         ".")
                           else (PRINTOUT T T "No more cross references in this node")
                                (TEDIT.NORMALIZECARET TEXTOBJ (TEDIT.SETSEL TEXTSTREAM 0 0))))
                (SHOULDNT])

(XQPM.UPDATE.FROM.CREF
  [LAMBDA (STRING GRAPH)                                                  (* drc: 
                                                                          "23-Jan-86 14:24")
            
            (* Go to node in GRAPH denoted by STRING.
            STRING should be a string encoding the nodeid of the cross referenced 
            node, where "ref-1-11" encodes nodeid R0111.)

    (LET*[(ID (XQPM.CREF.TO.ID STRING))
          (NODE (FASSOC ID (fetch (DINFOGRAPH NODELST) of GRAPH]
     (if NODE
         then (DINFO.UPDATE GRAPH NODE)
       else (printout T T "Section " STRING " not found."])

(XQPM.CREF.TO.ID
  [LAMBDA (CREF)                                                          (* drc: 
                                                                          "23-Jan-86 14:24")
            
            (* * converts a ref-1-2 style cross reference
            (CREF) to a R0102 style ID.)

    (LET ((L (UNPACK CREF)))
         (PACK (CONS (U-CASE (CAR L))
                     (for TAIL on L bind FLG
                        join (if (SMALLP (CAR TAIL))
                                 then (if FLG
                                          then (SETQ FLG)
                                               (LIST (CAR TAIL))
                                        elseif (SMALLP (CADR TAIL))
                                          then (SETQ FLG T)
                                               (LIST (CAR TAIL))
                                        else (LIST 0 (CAR TAIL)))
                               else NIL])

(XQPM.LOOKUP
  [LAMBDA (STRING GRAPH)                                                  (* drc: 
                                                                          "15-Jan-86 23:11")
            
            (* LOOKUPFN for XQPM DInfo graph. All index entries for which STRING is an 
            initial substring of are gathered and put in the manual for the user to 
            select which one to lookup.)

    (LET*[(W (fetch (DINFOGRAPH WINDOW) of GRAPH))
          [SAME? (STRING-EQUAL STRING (WINDOWPROP W (QUOTE XQPM.LAST.LOOKUP]
          (REFS (if SAME?
                    then (WINDOWPROP W (QUOTE XQPM.LAST.REFS))
                  else (XQPM.BSEARCH (L-CASE STRING]
     (WINDOWPROP W (QUOTE XQPM.LAST.LOOKUP)
            STRING)
     (WINDOWPROP W (QUOTE XQPM.LAST.REFS)
            REFS)
     (if REFS
         then [LET ((REF (XQPM.CHOOSE.REF REFS W SAME?)))
                   (AND REF (DINFO.UPDATE GRAPH (FASSOC (fetch (XQPMREF NODEID) of REF)
                                                       (fetch (DINFOGRAPH NODELST) of GRAPH))
                                   (MKSTRING (fetch (XQPMREF ITEM) of REF]
       else (PRINTOUT T T STRING " not found in index"])

(XQPM.BSEARCH
  [LAMBDA (ITEM)                                                          (* drc: 
                                                                          "15-Jan-86 23:15")
            
            (* * returns the list of XQPMREF's in \XQPM.INDEX.ARRAY whose ITEM fields' 
            initial substrings match ITEM. Binary searches until it finds a match, 
            then gathers all the matches neighboring it.
            Algorithm courtesy of Knuth, Volume 3, Sorting and Searching, page 407)

    (RESETFORM (CURSOR WAITINGCURSOR)
           (PROG ((ARRAY (GETTOPVAL (QUOTE \XQPM.INDEX.ARRAY)))
                  (ITEMLEN (NCHARS ITEM))
                  (L 1)
                  U I REF FLG)
                 (SETQ U (ARRAYSIZE ARRAY))
             LOOP
                 (if (LESSP U L)
                     then (RETURN NIL))
                 (SETQ I (IQUOTIENT (IPLUS L U)
                                2))
                 (SETQ REF (ELT ARRAY I))
                 (SETQ FLG (ALPHORDER ITEM (fetch (XQPMREF ITEM) of REF)))
                 (if (NULL FLG)
                     then (SETQ L (ADD1 I))
                          (GO LOOP)
                   elseif (OR (EQ FLG (QUOTE EQUAL))
                              (XQPM.SUBSTRINGP ITEM ITEMLEN (fetch (XQPMREF ITEM) of REF)))
                     then (RETURN (XQPM.GATHER.REFS ITEM ITEMLEN REF I ARRAY))
                   else (SETQ U (SUB1 I))
                        (GO LOOP])

(XQPM.CHOOSE.REF
  [LAMBDA (REFS W SAME?)                                                  (* drc: 
                                                                          "15-Jan-86 23:11")
    (if (NULL (CDR REFS))
        then (CAR REFS)
      else (LET [(MENU (if SAME?
                           then (WINDOWPROP W (QUOTE XQPM.LOOKUP.MENU))
                         else (create MENU
                                     CENTERFLG _ T
                                     TITLE _ STRING
                                     ITEMS _(for REF in REFS collect (LIST (fetch (XQPMREF TYPE)
                                                                              of REF)
                                                                           REF]
                (WINDOWPROP W (QUOTE XQPM.LOOKUP.MENU)
                       MENU)
                (MENU MENU])

(XQPM.GATHER.REFS
  [LAMBDA (ITEM ITEMLEN REF POINT ARRAY)                                  (* drc: 
                                                                          "18-Dec-85 18:57")
            
            (* Assumes that REF (which is at POINT in ARRAY) matches ITEM, and 
            collects the references on either side of REF which also match ITEM.
            As we are matching ITEM with initial substring's of the ITEM fields of the 
            XQPMREF's in ARRAY, and we know that ARRAY is sorted alphabetically by 
            this field, we can be sure that all matches will be adjacent.)

    (LET ((BEFORE (for I from (SUB1 POINT) to 1 by -1 bind REF eachtime (AND (GEQ I 1)
                                                                             (SETQ REF
                                                                              (ELT ARRAY I)))
                     while (XQPM.SUBSTRINGP ITEM ITEMLEN (fetch (XQPMREF ITEM) of REF)) collect
                                                                                        REF))
          (AFTER (for I from (ADD1 POINT) to (ARRAYSIZE ARRAY) bind REF
                    eachtime (AND (LEQ I (ARRAYSIZE ARRAY))
                                  (SETQ REF (ELT ARRAY I))) while (XQPM.SUBSTRINGP
                                                                   ITEM ITEMLEN (fetch (XQPMREF
                                                                                        ITEM)
                                                                                   of REF))
                    collect REF)))
         (NCONC (DREVERSE BEFORE)
                (LIST REF)
                AFTER])

(\XQPM.RESET
  [LAMBDA NIL                                                             (* drc: 
                                                                          "16-Jan-86 15:25")
    (if (type? DINFOGRAPH \XQPM.DINFO.GRAPH)
        then (LET ((W (fetch (DINFOGRAPH WINDOW) of \XQPM.DINFO.GRAPH)))
                  (OPENW W)
                  (CLOSEW W)))
    (SETQ PROLOGHELPDIRECTORY)
    (SETQ \XQPM.DINFO.GRAPH)
    (SETQ \XQPM.INDEX.ARRAY])
)
(DECLARE: EVAL@COMPILE 
[PUTPROPS XQPM.SUBSTRINGP MACRO ((X XLEN Y)
                                 (STREQUAL X (SUBSTRING Y 1 XLEN]
)

(RPAQ? PROLOGHELPDIRECTORY )

(RPAQ? XQPM.FONT (FONTCREATE (QUOTE TERMINAL)
                        10))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS PROLOGHELPDIRECTORY XQPM.FONT)
)

(ADDTOVAR DINFO.GRAPHS ("Xerox Quintus Prolog Manual" (XQPM.GET.GRAPH T)))



(* MAKESYS time code)

(DEFINEQ

(XQPM.SETUP
  [LAMBDA (HOST&DIR)                                                      (* drc: 
                                                                          "16-Jan-86 15:23")
            
            (* * Sets up the XQPM. To be called when assembling a prolog sysout.
            HOST&DIR should be the prolog sources directory and should contain files 
            XQPM.FILETITLES and XQPM.INDEX.)

    (XQPM.MAKEGRAPH HOST&DIR)
    (XQPM.MAKEINDEX HOST&DIR])

(XQPM.MAKEINDEX
  [LAMBDA (HOST&DIR)                                                      (* drc: 
                                                                          "16-Jan-86 21:20")
            
            (* * Reads the file named XQPM.INDEX on HOST&DIR sorts its contents, and 
            makes \XQPM.INDEX.ARRAY out of it. File should contain a sequence of
            (ItemAtom TypeString NodeID) where NodeID is the name of the file
            (and the nodeid of the node) containing the reference to ItemAtom as a 
            TypeString.)

    (DECLARE (GLOBALVARS \XQPM.INDEX.ARRAY))
    (PRINTOUT T "Making index array...")
    (PRINTOUT T "reading...")
    (LET*((ENTRIES (READFILE (PACKFILENAME (QUOTE NAME)
                                    (QUOTE XQPM.INDEX)
                                    (QUOTE BODY)
                                    HOST&DIR)))
          (#ENTRIES (FLENGTH ENTRIES)))
     [MAP ENTRIES (FUNCTION (LAMBDA (TAIL)
                              (RPLACA TAIL (L-CASE (CAR TAIL]             (* L-CASE the ITEM 
                                                                          fields before sorting)
     (PRINTOUT T "sorting...")
     [SORT ENTRIES (FUNCTION (LAMBDA (A B)
                               (ALPHORDER (CAR A)
                                      (CAR B]
     (SETQ \XQPM.INDEX.ARRAY (ARRAY #ENTRIES))
     (printout T "inserting...")
     [for ENTRY in ENTRIES as I from 1 to #ENTRIES do (SETA \XQPM.INDEX.ARRAY I
                                                            (create XQPMREF
                                                                   ITEM _(CAR ENTRY)
                                                                   TYPE _(CADR ENTRY)
                                                                   NODEID _(U-CASE (CADDR ENTRY]
     (printout T "OK." T])

(XQPM.MAKEGRAPH
  [LAMBDA (HOST&DIR)                                                      (* drc: 
                                                                          "21-Jan-86 19:57")
            
            (* Expects HOST&DIR to contain a file called XQPM.FILETITLES which 
            contains a sequence of (filename/nodeid nodename fileexists?) lists, where 
            filename/nodeid is both (possibly) the name of a documentation file, and 
            an encoded graph position. Encoding of reference manual section 4-12-2 
            would be R041202. The file is expected to be ordered in the order the 
            corresponding sections of the manual occur in.)

    (DECLARE (GLOBALVARS \XQPM.DINFO.GRAPH))
    (PRINTOUT T "Making DInfo graph...")
    (PRINTOUT T "reading...")
    (LET*((FILETITLES (READFILE (PACKFILENAME (QUOTE NAME)
                                       (QUOTE XQPM.FILETITLES)
                                       (QUOTE BODY)
                                       HOST&DIR)))
          (TOPNODE (create DINFONODE
                          ID _(CAAR FILETITLES)
                          LABEL _(CADAR FILETITLES)))
          (NODELST (LIST TOPNODE)))
     [SETQ \XQPM.DINFO.GRAPH (create DINFOGRAPH
                                    NAME _"XQPM"
                                    TOPNODEID _(fetch (DINFONODE ID) of TOPNODE)
                                    LOOKUPFN _(FUNCTION XQPM.LOOKUP)
                                    FREEMENUITEMS _(QUOTE ((ID NEXTREF LABEL "NextRef!" SELECTEDFN 
                                                               XQPM.CREF FONT (HELVETICA 10 BOLD)
                                                               MESSAGE 
                                                             "Find next cross reference in this node"
                                                               )
                                                           (ID GOTOREF LABEL "GoToRef!" SELECTEDFN 
                                                               XQPM.CREF FONT (HELVETICA 10 BOLD)
                                                               MESSAGE 
                                                           "Go to currently selected cross reference"
                                                               ]
     (PRINTOUT T "creating NODELST...")                                   (* chug through the 
                                                                          nodes...)
     (for X in (CDR FILETITLES) do (XQPM.MAKE.NODE (CAR X)
                                          (CADR X)
                                          (CADDR X)
                                          NODELST HOST&DIR))
     (replace (DINFOGRAPH NODELST) of \XQPM.DINFO.GRAPH with NODELST)
     (PRINTOUT T "OK." T])

(XQPM.MAKE.NODE
  [LAMBDA (ID LABEL FILE? NODELST HOST&DIR)                               (* drc: 
                                                                          "21-Jan-86 20:00")
            
            (* * Takes filename/nodeid ID, and node label LABEL, creates a DINFONODE 
            for them, and inserts it into NODELST appropriatly.
            FILE? is T if there really is a file (named ID) for the node.)

    (if (AND (EQ (MKATOM (SUBSTRING ID -2))
                 0)
             (STRING-EQUAL LABEL "Overview"))
        then                                                              (* zeroth sections named 
                                                                          "Overview" don't get 
                                                                          turned into nodes --
                                                                          their text is just slid 
                                                                          up into their textless 
                                                                          parent.)
             (replace (DINFONODE FILE) of (FASSOC (XQPM.GET.PARENT.ID ID NODELST)
                                                 NODELST) with ID)
      else (LET ((PREVIOUS (CAR NODELST))
                 NODE)
                (replace (DINFONODE NEXTNODE) of PREVIOUS with ID)
                [LET*((PARENTID (XQPM.GET.PARENT.ID ID NODELST))
                      (PARENT (FASSOC PARENTID NODELST)))
                 (replace (DINFONODE CHILDREN) of PARENT with (ATTACH ID (fetch (DINFONODE CHILDREN)
                                                                            of PARENT)))
                 (SETQ NODE (create DINFONODE
                                   LABEL _ LABEL
                                   FILE _(AND FILE? ID)
                                   ID _ ID
                                   PARENT _ PARENTID
                                   PREVIOUSNODE _(fetch (DINFONODE ID) of PREVIOUS]
                (ATTACH NODE NODELST])

(XQPM.GET.PARENT.ID
  [LAMBDA (ID NODELST)                                                    (* drc: 
                                                                          "18-Dec-85 19:11")
            
            (* * Decodes the ID of the node whose ID is ID and returns the ID of its 
            Parent node.)

    (if (EQ (NCHARS ID)
            1)
        then                                                              (* Parent is top node, 
                                                                          which should be last in 
                                                                          nodelst.)
             (fetch (DINFONODE ID) of (CAR (FLAST NODELST)))
      else (MKATOM (SUBSTRING (MKSTRING ID)
                          1 -3])
)

(RPAQ? \XQPM.INDEX.ARRAY )

(RPAQ? \XQPM.DINFO.GRAPH )
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \XQPM.INDEX.ARRAY \XQPM.DINFO.GRAPH)
)
(PUTPROPS XQPM COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1840 2932 (XQPM.HELP 1850 . 2385) (XQPM.MANUAL 2387 . 2930)) (2933 15082 (
XQPM.GET.GRAPH 2943 . 5452) (XQPM.CREF 5454 . 7826) (XQPM.UPDATE.FROM.CREF 7828 . 8454) (
XQPM.CREF.TO.ID 8456 . 9396) (XQPM.LOOKUP 9398 . 10594) (XQPM.BSEARCH 10596 . 12060) (XQPM.CHOOSE.REF 
12062 . 12931) (XQPM.GATHER.REFS 12933 . 14623) (\XQPM.RESET 14625 . 15080)) (15507 23535 (XQPM.SETUP 
15517 . 15991) (XQPM.MAKEINDEX 15993 . 17851) (XQPM.MAKEGRAPH 17853 . 20675) (XQPM.MAKE.NODE 20677 . 
22752) (XQPM.GET.PARENT.ID 22754 . 23533)))))
STOP