(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