(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(filecreated "30-Dec-87 11:33:52" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX-XREF.;3| 20185
|previous| |date:| "11-Nov-87 12:05:48" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX-XREF.;2|)
; Copyright (c) 1987 by Xerox Corporation. All rights reserved.
(prettycomprint tmax-xrefcoms)
(rpaqq tmax-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.")
(* |;;;| "TMAX-XREFNIL Image Object functions")
(fns xref xrefp xref.displayfn xref.imageboxfn xref.putfn xref.getfn
xref.copyfn xref.buttoneventinfn xref.whendeletedfn)
(fns xref.get.display.text xref.get.toobj tspobj.gettype)
(fns update.xrefs insert.ref get.ref get.reference.by tsp.list.refs
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 ngroup.xref.display.text 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."
)
(* |;;;| "TMAX-XREFNIL Image Object functions")
(defineq
(xref
(lambda (tag) (* |fsg| "23-Jul-87 13:33")
(* |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 \\xrefobj.imagefns)))
(imageobjprop newobj 'type 'xref)
newobj)))
(xrefp
(lambda (obj) (* |ss:| "27-Jun-87 16:39")
(* |Test| |whether| |something| |is|
|an| xref |imageobject.|)
(and (imageobjp obj)
(eq (imageobjprop obj 'type)
'xref))))
(xref.displayfn
(lambda (obj stream) (* |fsg| "17-Sep-87 11:19")
(* * |General| |purpose| |display| |function| |for| |an| xref |imageobject.|
|Relies| |on| xref.get.display.text |to| |get| |the| |actual| |text| |that|
|must| |be| |displayed.|)
(tmax.shadeobj obj stream)
(prin1 (xref.get.display.text obj)
stream)))
(xref.imageboxfn
(lambda (obj stream) (* |ss:| "27-Jun-87 16:39")
(* |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) (* |fsg| "29-Jul-87 09:08")
(prin2 (list 'xref (|fetch| objectdatum |of| obj)
(imageobjprop obj 'reference.by))
stream)))
(xref.getfn
(lambda (stream copy.object) (* |fsg| "20-Aug-87 14:59")
(let ((window (|with| textobj textobj (car \\window))))
(tsp.setup.fmmenu window))
(let* ((xref.args (or copy.object (cdr (read stream))))
(xref.obj (xref (car xref.args))))
(imageobjprop xref.obj 'reference.by (or (cadr xref.args)
'|Value|))
xref.obj)))
(xref.copyfn
(lambda (image.obj source.stream target.stream) (* |fsg| "12-Aug-87 11:07")
(* * |Here| |to| copy |an| xref |Image| |Object.|)
(selectq (imagestreamtype target.stream)
(text (let ((textobj (textobj target.stream)))
(apply* (imageobjprop image.obj 'getfn)
target.stream
(list (|fetch| objectdatum |of| image.obj)
(imageobjprop image.obj 'reference.by)))))
(error "Unknown TARGET stream type" (imagestreamtype target.stream)))))
(xref.buttoneventinfn
(lambda (xrefobj stream selection relx rely window hoststream button)
(* |fsg| "29-Jul-87 16:43")
(* * |Show| |what| tag |is| |being| |referenced| |and| |how| |it| |is|
|referenced.|)
(let ((xref.tag (|fetch| objectdatum |of| xrefobj))
(xref.display (imageobjprop xrefobj 'reference.by)))
(tedit.promptprint stream (concat "Reference to \"" xref.tag "\" by " xref.display)
t)
(and (mousestate middle)
(selectq (menu (|create| menu
title ← (concat xref.tag " Menu")
items ← '(|Change Reference| |Change Display|)
centerflg ← t))
(|Change Reference|
(let ((new.reference (get.ref window stream)))
(and new.reference (progn (|replace| objectdatum |of| xrefobj
|with| new.reference)
'changed))))
(|Change Display|
(progn (imageobjprop xrefobj 'reference.by (get.reference.by window t))
(tedit.promptprint stream "" t)
'changed))
nil)))))
(xref.whendeletedfn
(lambda (imobj targ.window.stream source.str targ.str) (* |fsg| "29-Jul-87 16:35")
(* * |Note| |that| |this| |function| |is| not |called| |when| \a |Reference|
|is| |deleted.| i\t |is| |called| |when| \a |NGroup| |or| |Endnote| |is|
|deleted.|)
(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) (* |fsg| "29-Jul-87 09:30")
(* |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.
i\f |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)))
(reference.by (imageobjprop obj 'reference.by))
specific.displayfn)
(cond
(toobj (cond
((setq specific.displayfn (xref.get.displayfn toobj))
(apply* specific.displayfn toobj reference.by))
(t (ringbells)
(error "Unknown XREF display method" (tspobj.gettype toobj))
"<Unknown Reference>")))
(t (concat "<Reference " (|fetch| objectdatum |of| obj)
"/" reference.by ">"))))))
(xref.get.toobj
(lambda (tag) (* |fsg| "13-Jul-87 11:13")
(* |This| |function| |is| |called| |in| \a |specific| |context| |where| \a
|reference| |must| |be| |displayed.| i\t |is| |called| |by| |an| xref |object|
|and| |should| |return| |the| imageobject |that| |the| xref |object| |is|
|referencing.|)
(gethash tag (windowprop (|with| textobj textobj (car \\window))
'tsp.code.array))))
(tspobj.gettype
(lambda (obj) (* |ss:| "27-Jun-87 16:36")
(imageobjprop obj 'type)))
)
(defineq
(update.xrefs
(lambda (window unupdating?) (* |fsg| "25-Sep-87 14:18")
(* * |Update| |all| |the| xref |objects| |in| |the| |window.|)
(let ((stream (textstream window))
(ref.list (tsp.list.of.objects (textobj window)
(function xrefp))))
(and ref.list (let ((textobj (textobj window)))
(tedit.promptprint stream (concat (cond
(unupdating? "Undoing Update of")
(t "Updating"))
" References...")
t)
(|for| ref |in| ref.list
|do| (let ((ref.tag (|fetch| objectdatum |of| (car ref))))
(cond
((or unupdating? (xref.get.toobj ref.tag))
(tedit.object.changed stream (car ref)))
(t (printout promptwindow t (concat
"Undefined Reference to \""
ref.tag
"\", delete it or just continte?"
)
t)
(flashwindow promptwindow)
(selectq (menu (|create| menu
title ← '|Undefined Ref|
items ← '(|Delete| |Continue|)
centerflg ← t))
(|Delete| (tedit.delete stream (cadr ref)
1))
nil)))))
(tedit.promptprint stream "done"))))))
(insert.ref
(lambda (stream display.prev) (* |fsg| "25-Sep-87 10:24")
(let* ((window (\\tedit.mainw stream))
(code (get.ref window stream display.prev))
(ref (and code (xref code))))
(and ref (progn (imageobjprop ref 'reference.by (get.reference.by window))
(tedit.insert.object ref stream))))))
(get.ref
(lambda (window stream display.prev) (* |fsg| " 2-Sep-87 11:24")
(* * i\f display.prev |is| |non-NIL| |then| |get| |the| |Reference| tag |from|
\a |menu.| |Else| |prompt| |the| |user| |for| |the| tag |name.|)
(cond
(display.prev (let ((prevrefs (tsp.list.refs window)))
(cond
(prevrefs (tedit.promptprint stream "" t)
(menu (|create| menu
title ← '|Reference Tags|
items ← (sort prevrefs 'ualphorder)
menucolumns ← (fix (sqrt (length prevrefs)))
centerflg ← t)))
(t (tedit.promptprint stream "There are no References in this document."
t)))))
(t (mkatom (tedit.getinput stream "Reference to:"))))))
(get.reference.by
(lambda (window ask?) (* \; "Edited 29-Sep-87 15:24 by fsg")
(* * |Get| |the| "Reference By" |value| |from| |the| |FreeMenu.|
i\f ask? |is| t |or| |the| |FreeMenu| |value| |is| "Ask" |then| |pop| |up| \a
|menu| |to| |get| |Value| |or| |Number.|)
(let ((reference.by (cond
(ask? '|Ask|)
(t (fm.itemprop (fm.getitem 'defaultref nil (windowprop window
'imageobj.menuw))
'label)))))
(selectq reference.by
(|Ask| (or (menu (|create| menu
title ← '|Reference By|
centerflg ← t
items ← '(|Value| |Page|)))
'|Value|))
reference.by))))
(tsp.list.refs
(lambda (window) (* |ss:| "27-Jun-87 16:36")
(* * |Used| |to| |collect| |index| |references| |here| |but| |now| |use|
index.list.refs |instead.|)
(let ((reflist nil))
(maphash (windowprop window 'tsp.code.array)
(function (lambda (val ky)
(setq reflist (cons ky reflist)))))
reflist)))
(tsp.get.incode
(lambda (stream) (* |fsg| " 4-Aug-87 16:13")
(* * |Get| \a |new| |Tag| id |and| |make| |sure| |it's| |not| |already|
|defined.|)
(let ((tag.id (mkatom (tedit.getinput stream "Tag name:"))))
(|while| (and tag.id (tsp.getcodeval tag.id (\\tedit.mainw stream)))
|do| (setq tag.id (mkatom (tedit.getinput stream (concat tag.id
" already exists...Tag name:"))))
)
(or tag.id (tedit.promptprint stream "" t))
tag.id)))
(tsp.getcodeval
(lambda (code window) (* |ss:| "27-Jun-87 16:35")
(let ((tsp.code.array (windowprop window 'tsp.code.array)))
(gethash code tsp.code.array))))
(tsp.putcode
(lambda (code value window) (* |ss:| "27-Jun-87 16:36")
(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.obj reference.by) (* |fsg| "29-Jul-87 10:25")
(* * |The| xref |display| |method| |for| ngroup |objects.|
i\f |the| |NGroup| |has| |been| |updated| |and| |it| |has| \a |trailing|
|delimiter,| |the| |delimiter| |is| |stripped| |off.|)
(|with| numberobj (|fetch| objectdatum |of| ngroup.obj)
(cond
(updated.obj (cond
((eq reference.by '|Page|)
(cond
(page.number (mkstring page.number))
(t (concat "<" (ngroup.xref.display.text template numstring)
"/" reference.by ">"))))
(t (ngroup.xref.display.text template numstring))))
(t (concat "<" ref.type "/" reference.by ">"))))))
(ngroup.xref.display.text
(lambda (template numstring) (* |fsg| "29-Jul-87 10:24")
(* * |Return| |the| |display| |text| |value| |for| |an| |updated| |NGroup|
|reference.|)
(|with| ngtemplate template (cond
(ng.text-after (substring numstring 1 (minus (add1 (nchars
ng.text-after
)))))
(t numstring)))))
(note.xref.displayfn
(lambda (note.obj reference.by) (* |fsg| "29-Jul-87 10:35")
(* * |The| xref |display| |method| |for| |Endnote| |objects.|
i\f |the| |ImageObj| |has| |not| |been| |updated| |yet,| |we| |enclose| |it|
|in| |angle| |brackets.|)
(|with| numberobj (|fetch| objectdatum |of| note.obj)
(cond
((and updated.obj (or (neq reference.by '|Page|)
page.number))
(cond
((eq reference.by '|Page|)
(mkstring page.number))
(t (mkstring numstring))))
(t (concat "<" numstring "/" reference.by ">"))))))
)
(readvar-from-string 'xref.display.methods
"{H(24 ERROR) 2 NOTE.XREF.DISPLAYFN NOTE NGROUP.XREF.DISPLAYFN NGROUP }
")
(putprops tmax-xref copyright ("Xerox Corporation" 1987))
(declare\: dontcopy
(filemap (nil (2842 8133 (xref 2852 . 3352) (xrefp 3354 . 3741) (xref.displayfn 3743 . 4177) (
xref.imageboxfn 4179 . 4831) (xref.putfn 4833 . 5079) (xref.getfn 5081 . 5555) (xref.copyfn 5557 .
6167) (xref.buttoneventinfn 6169 . 7632) (xref.whendeletedfn 7634 . 8131)) (8134 10118 (
xref.get.display.text 8144 . 9428) (xref.get.toobj 9430 . 9967) (tspobj.gettype 9969 . 10116)) (10119
16493 (update.xrefs 10129 . 12512) (insert.ref 12514 . 12926) (get.ref 12928 . 13983) (
get.reference.by 13985 . 14972) (tsp.list.refs 14974 . 15426) (tsp.get.incode 15428 . 16082) (
tsp.getcodeval 16084 . 16306) (tsp.putcode 16308 . 16491)) (16585 17556 (xref.add.displayfn 16595 .
17109) (xref.get.displayfn 17111 . 17554)) (17616 19978 (ngroup.xref.displayfn 17626 . 18586) (
ngroup.xref.display.text 18588 . 19224) (note.xref.displayfn 19226 . 19976)))))
stop