(FILECREATED "18-Feb-87 15:48:37" {SUMEX-AIM}PS:<TMAX.SOURCES>XREF.;6
 12717  

      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 ((7675) (2226 5527 (XREF 2236 . 3078) (XREFP 3080 . 3388) (XREF.DISPLAYFN 3390 . 3854) (
XREF.IMAGEBOXFN 3856 . 4491) (XREF.PUTFN 4493 . 4693) (XREF.GETFN 4695 . 4851) (XREF.BUTTONEVENTINFN 
4853 . 5238) (XREF.WHENDELETEDFN 5240 . 5525)) (5528 7093 (XREF.GET.DISPLAY.TEXT 5538 . 6475) (
XREF.GET.TOOBJ 6477 . 6940) (TSPOBJ.GETTYPE 6942 . 7091)) (7094 NIL (UPDATE.XREFS 7104 . 7674)))))
STOP
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