github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-26 04:08:08 +00:00
Code Issues Projects Releases Wiki Activity

initial checkin for lispusers

Browse Source
This commit is contained in:
Larry Masinter
2020-08-29 18:28:07 -07:00
parent feaf0a556f
commit b58c88bda3
594 changed files with 7043 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

236
lispusers/TMAX-XREF Normal file
View File

@@ -0,0 +1,236 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED " 6-May-2000 14:26:45" |{DSK}<project>medley3.5>lispusers>TMAX-XREF.;3| 22168
|changes| |to:| (FNS XREF.TEDIT-TO-TEX-FN)
|previous| |date:| " 6-May-2000 10:40:07" |{DSK}<project>medley3.5>lispusers>TMAX-XREF.;2|)
; Copyright (c) 1987, 1997, 2000 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 XREF.TEDIT-TO-TEX-FN)
(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)
(IMAGEOBJPROP NEWOBJ 'TEDIT-TO-TEX-FN (FUNCTION XREF.TEDIT-TO-TEX-FN))
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)
(* \; "Edited 9-Nov-97 08:09 by rmk:")
(* |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 _ '(|Find Definition| |Change Reference| |Change Display|)
CENTERFLG _ T))
(|Find Definition|
(LET ((DEF (TSP.LIST.OF.OBJECTS (TEXTOBJ HOSTSTREAM)
(FUNCTION (LAMBDA (OBJ TAG)
(AND (NUMBEROBJP OBJ)
(EQ TAG (IMAGEOBJPROP OBJ 'TAG)))))
(IMAGEOBJPROP XREFOBJ 'OBJECTDATUM))))
(IF DEF
THEN (CL:WHEN (CDR DEF)
(TEDIT.PROMPTPRINT STREAM
"NOTE: Reference has multipled definitions!!"
T))
(TEDIT.SETSEL HOSTSTREAM (CADR (CAR DEF))
1
'RIGHT NIL T 'INVERTED)
(AND NIL (TEDIT.SHOWSEL HOSTSTREAM T)
(TEDIT.NORMALIZECARET HOSTSTREAM))
(RETFROM (FUNCTION TEDIT.SELECT.LINE.SCANNER)
(TEDIT.GETSEL HOSTSTREAM))
ELSE (TEDIT.PROMPTPRINT STREAM "Reference has not definition!" T))
NIL))
(|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))))
(XREF.TEDIT-TO-TEX-FN
(LAMBDA (OBJ STREAM)
(LET ((TOOBJ (XREF.GET.TOOBJ (IMAGEOBJPROP OBJ 'OBJECTDATUM)))
DATUM)
(CL:WHEN (AND (SETQ DATUM (IMAGEOBJPROP TOOBJ 'OBJECTDATUM))
TOOBJ)
(PRIN3 "\\exref{" STREAM)
(PRIN3 (CAR DATUM)
STREAM)
(PRIN3 (CADR DATUM)
STREAM)
(PRIN3 "}" STREAM)
T))))
)
(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