(FILECREATED "24-Jan-86 00:05:26" {ERIS}<CUTTING>LISP>KOTO>XQPM.;5 18913
changes to: (FNS XQPM.GET.GRAPH)
previous date: "23-Jan-86 17:10:36" {ERIS}<CUTTING>LISP>KOTO>XQPM.;4)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT XQPMCOMS)
(RPAQQ XQPMCOMS ((FILES (* * NOTE: XQPINFO is a Koto-ized version of LispCore DINFO. To get this
package to run in Lute just replace all occurences of "XQPINFO" with
"DINFO"
and "XQPInfo" with "DInfo" , load it, MAKEFILE and BCOMPL.)
XQPINFO)
(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 (XQPINFO.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.XQPINFO.GRAPH))
(GLOBALVARS \XQPM.INDEX.ARRAY \XQPM.XQPINFO.GRAPH))))
(FILESLOAD XQPINFO)
[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 (XQPINFOGRAPH 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 (XQPINFOGRAPH WINDOW)
of GRAPH)))
(XQPM.UPDATE.FROM.CREF (MKSTRING SECTION)
GRAPH))
NIL])
)
(DEFINEQ
(XQPM.GET.GRAPH
[LAMBDA (FROMBACKGROUND?) (* drc: "24-Jan-86 00:03")
(* * Returns the XQPInfo graph for the XQPM, initializing if necesary.)
(DECLARE (GLOBALVARS PROLOGHELPDIRECTORY \XQPM.XQPINFO.GRAPH))
(* drc: "19-Dec-85 17:47")
(if (AND (type? XQPINFOGRAPH \XQPM.XQPINFO.GRAPH)
(WINDOWP (fetch (XQPINFOGRAPH WINDOW) of \XQPM.XQPINFO.GRAPH)))
then (OPENW (fetch (XQPINFOGRAPH WINDOW) of \XQPM.XQPINFO.GRAPH))
(AND FROMBACKGROUND? (XQPINFO.UPDATE \XQPM.XQPINFO.GRAPH))
\XQPM.XQPINFO.GRAPH
elseif (INFILEP (PACKFILENAME (QUOTE NAME)
(QUOTE R0101)
(QUOTE BODY)
PROLOGHELPDIRECTORY))
then (OR (type? XQPINFOGRAPH \XQPM.XQPINFO.GRAPH)
(ERROR "XQPM XQPInfo graph not installed!" "Try (XQPM.SETUP >>HOST&DIR<<)."))
(replace (XQPINFOGRAPH DEFAULTHOST) of \XQPM.XQPINFO.GRAPH
with (FILENAMEFIELD PROLOGHELPDIRECTORY (QUOTE HOST)))
(replace (XQPINFOGRAPH DEFAULTDEVICE) of \XQPM.XQPINFO.GRAPH
with (FILENAMEFIELD PROLOGHELPDIRECTORY (QUOTE DEVICE)))
(replace (XQPINFOGRAPH DEFAULTDIR) of \XQPM.XQPINFO.GRAPH
with (FILENAMEFIELD PROLOGHELPDIRECTORY (QUOTE DIRECTORY)))
(replace (XQPINFOGRAPH TEXTPROPS) of \XQPM.XQPINFO.GRAPH
with (LIST (QUOTE FONT)
XQPM.FONT))
(replace (XQPINFOGRAPH MENUFONT) of \XQPM.XQPINFO.GRAPH with XQPM.FONT)
(replace (XQPINFOGRAPH WINDOW) of \XQPM.XQPINFO.GRAPH
with (CREATEW (GETBOXREGION 500 300 NIL NIL NIL
"Specify region for XQPInfo window")
"XQPInfo"))
(XQPINFO \XQPM.XQPINFO.GRAPH NIL (if FROMBACKGROUND?
then NIL
else T))
\XQPM.XQPINFO.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 (XQPINFOGRAPH FM.WINDOW))
(W (fetch (XQPINFOGRAPH 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 (XQPINFOGRAPH NODELST) of GRAPH]
(if NODE
then (XQPINFO.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 XQPInfo 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 (XQPINFOGRAPH 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 (XQPINFO.UPDATE GRAPH (FASSOC (fetch (XQPMREF NODEID)
of REF)
(fetch (XQPINFOGRAPH
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? XQPINFOGRAPH \XQPM.XQPINFO.GRAPH)
then (LET ((W (fetch (XQPINFOGRAPH WINDOW) of \XQPM.XQPINFO.GRAPH)))
(OPENW W)
(CLOSEW W)))
(SETQ PROLOGHELPDIRECTORY)
(SETQ \XQPM.XQPINFO.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 XQPINFO.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.XQPINFO.GRAPH))
(PRINTOUT T "Making XQPInfo graph...")
(PRINTOUT T "reading...")
(LET* ((FILETITLES (READFILE (PACKFILENAME (QUOTE NAME)
(QUOTE XQPM.FILETITLES)
(QUOTE BODY)
HOST&DIR)))
(TOPNODE (create XQPINFONODE
ID ←(CAAR FILETITLES)
LABEL ←(CADAR FILETITLES)))
(NODELST (LIST TOPNODE)))
[SETQ \XQPM.XQPINFO.GRAPH (create XQPINFOGRAPH
NAME ← "XQPM"
TOPNODEID ←(fetch (XQPINFONODE 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 (XQPINFOGRAPH NODELST) of \XQPM.XQPINFO.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 XQPINFONODE 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 (XQPINFONODE FILE) of (FASSOC (XQPM.GET.PARENT.ID ID NODELST)
NODELST)
with ID)
else (LET ((PREVIOUS (CAR NODELST))
NODE)
(replace (XQPINFONODE NEXTNODE) of PREVIOUS with ID)
[LET* ((PARENTID (XQPM.GET.PARENT.ID ID NODELST))
(PARENT (FASSOC PARENTID NODELST)))
(replace (XQPINFONODE CHILDREN) of PARENT
with (ATTACH ID (fetch (XQPINFONODE CHILDREN) of PARENT)))
(SETQ NODE (create XQPINFONODE
LABEL ← LABEL
FILE ←(AND FILE? ID)
ID ← ID
PARENT ← PARENTID
PREVIOUSNODE ←(fetch (XQPINFONODE 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 (XQPINFONODE ID) of (CAR (FLAST NODELST)))
else (MKATOM (SUBSTRING (MKSTRING ID)
1 -3])
)
(RPAQ? \XQPM.INDEX.ARRAY )
(RPAQ? \XQPM.XQPINFO.GRAPH )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \XQPM.INDEX.ARRAY \XQPM.XQPINFO.GRAPH)
)
(PUTPROPS XQPM COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1678 2621 (XQPM.HELP 1688 . 2148) (XQPM.MANUAL 2150 . 2619)) (2622 12496 (
XQPM.GET.GRAPH 2632 . 4774) (XQPM.CREF 4776 . 6566) (XQPM.UPDATE.FROM.CREF 6568 . 7124) (
XQPM.CREF.TO.ID 7126 . 7874) (XQPM.LOOKUP 7876 . 9036) (XQPM.BSEARCH 9038 . 10319) (XQPM.CHOOSE.REF
10321 . 10929) (XQPM.GATHER.REFS 10931 . 12094) (\XQPM.RESET 12096 . 12494)) (12896 18679 (XQPM.SETUP
12906 . 13282) (XQPM.MAKEINDEX 13284 . 14694) (XQPM.MAKEGRAPH 14696 . 16681) (XQPM.MAKE.NODE 16683 .
18132) (XQPM.GET.PARENT.ID 18134 . 18677)))))
STOP