(FILECREATED "18-Feb-87 15:48:37" {SUMEX-AIM}PS:<TMAX.SOURCES>XREF.;6 13018
changes to: (VARS XREF.DISPLAY.METHODS)
(FNS XREF.IMAGEBOXFN INSERT.REF)
previous date: " 5-Feb-87 14:57:51" {SUMEX-AIM}PS:<GILMURRAY.LISP>XREF.;5)
(* Copyright (c) 1987 by Leland Stanford Junior University. All rights reserved.)
(PRETTYCOMPRINT XREFCOMS)
(RPAQQ XREFCOMS ((* Developed under support from NIH grant RR-00785.)
(* Written by Frank Gilmurray and Sami Shaio.)
(* An XREF is a general-purpose cross-referencing imageobject. In order to create
an instance of an XREF one simply calls the function XREF with a TAG that is
supposed to link it with some imageobject that it is referencing. In order to
add to the class of imageobjects that can be referenced with XREF one uses the
function XREF.ADD.DISPLAYFN with the type of the imageobject and a function
that operates on it to return some string that XREF will then display in the
document.)
(FNS XREF XREFP XREF.DISPLAYFN XREF.IMAGEBOXFN XREF.PUTFN XREF.GETFN
XREF.BUTTONEVENTINFN XREF.WHENDELETEDFN)
(FNS XREF.GET.DISPLAY.TEXT XREF.GET.TOOBJ TSPOBJ.GETTYPE)
(FNS UPDATE.XREFS REBUILD.TAG.ARRAY INSERT.REF GET.REF TSP.LIST.REFS
XREF.TAG.OBJECT TSP.GET.INCODE TSP.GETCODEVAL TSP.PUTCODE)
(* Functions for adding and retrieving the method for a gven imageobject.)
(FNS XREF.ADD.DISPLAYFN XREF.GET.DISPLAYFN)
(* Examples of some XREF display methods.)
(FNS NGROUP.XREF.DISPLAYFN NOTE.XREF.DISPLAYFN)
(UGLYVARS XREF.DISPLAY.METHODS)))
(* Developed under support from NIH grant RR-00785.)
(* Written by Frank Gilmurray and Sami Shaio.)
(* An XREF is a general-purpose cross-referencing imageobject. In order to create an instance
of an XREF one simply calls the function XREF with a TAG that is supposed to link it with some
imageobject that it is referencing. In order to add to the class of imageobjects that can be
referenced with XREF one uses the function XREF.ADD.DISPLAYFN with the type of the imageobject
and a function that operates on it to return some string that XREF will then display in the
document.)
(DEFINEQ
(XREF
(LAMBDA (TAG) (* edited: "28-Jan-87 12:53")
(* Returns a new XREF imageobject. The TAG argument is obligatory and should be the tag that is used to reference
the object that this XREF object is referencing.)
(LET ((NEWOBJ (IMAGEOBJCREATE TAG (IMAGEFNSCREATE (FUNCTION XREF.DISPLAYFN)
(FUNCTION XREF.IMAGEBOXFN)
(FUNCTION XREF.PUTFN)
(FUNCTION XREF.GETFN)
(FUNCTION NILL)
(FUNCTION XREF.BUTTONEVENTINFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)))))
(IMAGEOBJPROP NEWOBJ 'TYPE
'XREF)
NEWOBJ)))
(XREFP
(LAMBDA (OBJ) (* edited: "22-Jan-87 21:20")
(* Test whether something is an XREF imageobject.)
(AND (IMAGEOBJP OBJ)
(EQ (IMAGEOBJPROP OBJ 'TYPE)
'XREF))))
(XREF.DISPLAYFN
(LAMBDA (OBJ STREAM) (* edited: "22-Jan-87 21:09")
(* General purpose display function for an XREF
imageobject. Relies on XREF.GET.DISPLAY.TEXT to get
the actual text that must be displayed.)
(LET* ((TEXT.TO.DISPLAY (XREF.GET.DISPLAY.TEXT OBJ)))
(PRIN3 TEXT.TO.DISPLAY STREAM))))
(XREF.IMAGEBOXFN
(LAMBDA (OBJ STREAM) (* fsg "18-Feb-87 15:35")
(* Returns the size of an XREF imageobject based on
the string that will be used to display it which is
found using XREF.GET.DISPLAY.TEXT.)
(DSPFONT (CURRENT.DISPLAY.FONT STREAM)
STREAM)
(create IMAGEBOX
XSIZE ←(TEDIT.STRINGWIDTH (XREF.GET.DISPLAY.TEXT OBJ)
STREAM)
YSIZE ←(FONTPROP STREAM 'HEIGHT)
YDESC ←(FONTPROP STREAM 'DESCENT)
XKERN ← 0)))
(XREF.PUTFN
(LAMBDA (OBJ STREAM) (* edited: "28-Jan-87 12:54")
(PRIN1 (LIST 'XREF
(fetch OBJECTDATUM of OBJ))
STREAM)))
(XREF.GETFN
(LAMBDA (STREAM) (* edited: "28-Jan-87 13:14")
(XREF (CADR (READ STREAM)))))
(XREF.BUTTONEVENTINFN
(LAMBDA (OBJ STREAM) (* edited: "28-Jan-87 14:51")
(* Bogus buttoneventinfn to tell you what the tag of
this XREF object is.)
(TEDIT.PROMPTPRINT STREAM (CONCAT "Reference to: " (fetch OBJECTDATUM of OBJ))
T)))
(XREF.WHENDELETEDFN
(LAMBDA (IMOBJ TARG.WINDOW.STREAM SOURCE.STR TARG.STR) (* fsg " 4-Feb-87 13:26")
(TSP.PUTCODE (IMAGEOBJPROP IMOBJ 'TAG)
NIL TARG.WINDOW.STREAM)
(AND (UPDATE? TARG.WINDOW.STREAM)
(UPDATE.XREFS TARG.WINDOW.STREAM))))
)
(DEFINEQ
(XREF.GET.DISPLAY.TEXT
(LAMBDA (OBJ) (* edited: "22-Jan-87 21:11")
(* This function will first lookup a "TOOBJ", in other words, the imageobject that the XREF object OBJ is
referencing. Then, if there is such an object, a suitable XREF display method is found using XREF.GET.DISPLAYFN.
If such a function is found, then it is applied to TOOBJ and a string to be displayed is returned.)
(LET ((TOOBJ (XREF.GET.TOOBJ (fetch OBJECTDATUM of OBJ)))
SPECIFIC.DISPLAYFN)
(COND
(TOOBJ (COND
((SETQ SPECIFIC.DISPLAYFN (XREF.GET.DISPLAYFN TOOBJ))
(APPLY* SPECIFIC.DISPLAYFN TOOBJ))
(T (RINGBELLS)
(CONCAT "??? Unknown XREF display method for " (TSPOBJ.GETTYPE TOOBJ)
" ???"))))
(T (CONCAT "<reference to: " (fetch OBJECTDATUM of OBJ)
">"))))))
(XREF.GET.TOOBJ
(LAMBDA (TAG) (* edited: "22-Jan-87 19:41")
(* This function is called in a specific context where a reference must be displayed. It is called by an XREF
object and should return the IMAGEOBJECT that the XREF object is referencing.)
(LET ((WINDOW (CAR (fetch \WINDOW of TEXTOBJ))))
(GETHASH TAG (WINDOWPROP WINDOW 'TSP.CODE.ARRAY)))))
(TSPOBJ.GETTYPE
(LAMBDA (OBJ) (* edited: "22-Jan-87 20:16")
(IMAGEOBJPROP OBJ 'TYPE)))
)
(DEFINEQ
(UPDATE.XREFS
(LAMBDA (WINDOW) (* edited: "22-Jan-87 21:05")
(* Update all the XREF objects in the window.)
(LET* ((TEXTOBJ (TEXTOBJ WINDOW))
(STREAM (TEXTSTREAM WINDOW)))
(TEDIT.PROMPTPRINT STREAM "Updating XRefs..." T)
(for REF in (TSP.LIST.OF.OBJECTS TEXTOBJ (FUNCTION XREFP))
do (TEDIT.OBJECT.CHANGED STREAM (CAR REF)))
(TEDIT.PROMPTPRINT STREAM "done."))))
(REBUILD.TAG.ARRAY
(LAMBDA (WINDOW) (* edited: "28-Jan-87 13:24")
(for TAG in (TSP.LIST.OF.OBJECTS (TEXTOBJ WINDOW)
(FUNCTION (LAMBDA (OBJ)
(AND (NUMBEROBJP OBJ)
(OR (IMAGEOBJPROP OBJ 'TAG)
(EQ (fetch USE
of (fetch OBJECTDATUM
of OBJ))
'NGROUP))))))
do (PROGN (SETQ TAG (CAR TAG))
(TSP.PUTCODE (OR (IMAGEOBJPROP TAG 'TAG)
(fetch LINK.TO of (fetch OBJECTDATUM of TAG)))
TAG WINDOW)))))
(INSERT.REF
(LAMBDA (STREAM DISPLAY.PREV) (* edited: "22-Jan-87 21:01")
(LET* ((WINDOW (\TEDIT.MAINW STREAM))
(CODE (GET.REF WINDOW STREAM "Reference to: " DISPLAY.PREV))
(REF (XREF CODE)))
(AND CODE (TEDIT.INSERT.OBJECT REF STREAM))
(TEDIT.PROMPTPRINT STREAM "" T))))
(GET.REF
(LAMBDA (WINDOW STREAM PROMPTSTR DISPLAY.PREV) (* ss: " 9-Aug-85 14:49")
(LET ((PREVREFS (TSP.LIST.REFS WINDOW)))
(COND
((AND PREVREFS DISPLAY.PREV)
(LET ((NMENU (create MENU
TITLE ← "Known Ref Codes"
ITEMS ← PREVREFS)))
(MENU NMENU)))
(T (MKATOM (TEDIT.GETINPUT STREAM "Reference to: ")))))))
(TSP.LIST.REFS
(LAMBDA (WINDOW) (* fsg "15-Jan-87 14:08")
(* * Don't collect the Index or IndexEntry references here. Use the INDEX.LIST.REFS function.)
(LET ((REFLIST NIL))
(MAPHASH (WINDOWPROP WINDOW 'TSP.CODE.ARRAY)
(FUNCTION (LAMBDA (VAL KY)
(SETQ REFLIST (CONS KY REFLIST)))))
REFLIST)))
(XREF.TAG.OBJECT
(LAMBDA (OBJ STREAM TAG) (* fsg " 4-Feb-87 16:35")
(* TAG an arbitrary imageobject for later cross-referencing. given an imageobject OBJ, a textstream STREAM, and a
tag TAG. If TAG is nil then the user will be asked for a tag via TSP.GET.INCODE.)
(OR TAG (SETQ TAG (TSP.GET.INCODE WINDOW)))
(IMAGEOBJPROP OBJ 'TAG
TAG)
(TSP.PUTCODE TAG OBJ WINDOW)))
(TSP.GET.INCODE
(LAMBDA (STREAM) (* ss: "24-Apr-86 15:46")
(LET ((CODE (MKATOM (TEDIT.GETINPUT STREAM "Codeword to use as a tag:"))))
(COND
(CODE (COND
((TSP.GETCODEVAL CODE (\TEDIT.MAINW STREAM))
(TEDIT.PROMPTPRINT STREAM "[Codeword already in use: Please try again]")
(TSP.GET.INCODE STREAM))
(T (TEDIT.PROMPTPRINT STREAM "" T)
CODE)))
(T (TEDIT.PROMPTPRINT STREAM "" T))))))
(TSP.GETCODEVAL
(LAMBDA (CODE WINDOW) (* fsg " 4-Feb-87 14:32")
(LET ((TSP.CODE.ARRAY (WINDOWPROP WINDOW 'TSP.CODE.ARRAY)))
(GETHASH CODE TSP.CODE.ARRAY))))
(TSP.PUTCODE
(LAMBDA (CODE VALUE WINDOW) (* fsg " 4-Feb-87 14:34")
(PUTHASH CODE VALUE (LIST (WINDOWPROP WINDOW 'TSP.CODE.ARRAY)))))
)
(* Functions for adding and retrieving the method for a gven imageobject.)
(DEFINEQ
(XREF.ADD.DISPLAYFN
(LAMBDA (OBJTYPE NAME.OF.FUNCTION) (* edited: "22-Jan-87 21:08")
(* Adds an XREF display method for an imageobject of the given type. This means that the function NAME.OF.FUNCTION
will be used to display text when an XREF object references an imageobject of type OBJTYPE.)
(PUTHASH OBJTYPE NAME.OF.FUNCTION XREF.DISPLAY.METHODS)))
(XREF.GET.DISPLAYFN
(LAMBDA (OBJ) (* edited: "22-Jan-87 21:11")
(* Returns the XREF display method for an imageobject
OBJ.)
(GETHASH (fetch USE of (fetch OBJECTDATUM of OBJ))
XREF.DISPLAY.METHODS)))
)
(* Examples of some XREF display methods.)
(DEFINEQ
(NGROUP.XREF.DISPLAYFN
(LAMBDA (NGROUP) (* edited: "29-Jan-87 16:07")
(* A sample XREF display method for NGROUP objects.)
(MKSTRING (fetch NUMSTRING of (fetch OBJECTDATUM of NGROUP)))))
(NOTE.XREF.DISPLAYFN
(LAMBDA (OBJ) (* edited: "29-Jan-87 16:07")
(* A sample XREF display method for NOTE objects.)
(MKSTRING (fetch NUMSTRING of (fetch OBJECTDATUM of OBJ)))))
)
(READVARS XREF.DISPLAY.METHODS)
({H(20 ERROR) 2 NGROUP.XREF.DISPLAYFN NGROUP NOTE.XREF.DISPLAYFN NOTE })
(PUTPROPS XREF COPYRIGHT ("Leland Stanford Junior University" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2277 5656 (XREF 2289 . 3153) (XREFP 3157 . 3470) (XREF.DISPLAYFN 3474 . 3944) (
XREF.IMAGEBOXFN 3948 . 4595) (XREF.PUTFN 4599 . 4803) (XREF.GETFN 4807 . 4965) (XREF.BUTTONEVENTINFN
4969 . 5359) (XREF.WHENDELETEDFN 5363 . 5653)) (5658 7258 (XREF.GET.DISPLAY.TEXT 5670 . 6625) (
XREF.GET.TOOBJ 6629 . 7100) (TSPOBJ.GETTYPE 7104 . 7255)) (7260 11182 (UPDATE.XREFS 7272 . 7850) (
REBUILD.TAG.ARRAY 7854 . 8516) (INSERT.REF 8520 . 8889) (GET.REF 8893 . 9308) (TSP.LIST.REFS 9312 .
9730) (XREF.TAG.OBJECT 9734 . 10217) (TSP.GET.INCODE 10221 . 10753) (TSP.GETCODEVAL 10757 . 10984) (
TSP.PUTCODE 10988 . 11179)) (11272 12087 (XREF.ADD.DISPLAYFN 11284 . 11708) (XREF.GET.DISPLAYFN 11712
. 12084)) (12145 12817 (NGROUP.XREF.DISPLAYFN 12157 . 12487) (NOTE.XREF.DISPLAYFN 12491 . 12814)))))
STOP