(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(filecreated "30-Dec-87 11:36:36" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX-NUMBER.;2| 34569
|previous| |date:| "11-Nov-87 11:54:01" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX-NUMBER.;1|)
; Copyright (c) 1987 by Xerox Corporation. All rights reserved.
(prettycomprint tmax-numbercoms)
(rpaqq tmax-numbercoms ((* |Developed| |under| |support| |from| nih |grant| rr-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(* * tmax-numbernil |ImageObject| |functions|)
(fns numberobj numberobjp ngroupp number.displayfn number.imageboxfn
number.putfn number.getfn number.copyfn number.buttoneventinfn)
(fns copy.ngroup.branch dump.ngroup.graph ngroup.buttoneventinfn
ngroup.define.tag number.delete.tag ngroup.show.tag
change.inserted.ngroup.format change.ngroup.format.#text
show.inserted.ngroup.format)
(* * |Variable| |and| |Record| |definitions|)
(vars ngroup.graph.menu.items ngroup.inserted.menu.items
ngroup.inserted.notag.items ngroup.inserted.tag.items)
(records ngcounter ngtemplate numberobj)))
(* |Developed| |under| |support| |from| nih |grant| rr-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(* * tmax-numbernil |ImageObject| |functions|)
(defineq
(numberobj
(lambda (use template numstring ref.type font mother abbrev.level)
(* |fsg| "26-Aug-87 14:29")
(let ((newobj (imageobjcreate (|create| numberobj
ref.type ← ref.type
numstring ← (or numstring "Note#")
use ← use
ngroup.mother ← mother
template ← template
updated.obj ← nil
text.after# ← nil
page.number ← nil
font ← font
text.before# ← nil
abbrev-val ← abbrev.level)
\\numberobj.imagefns)))
(imageobjprop newobj 'type 'numberobj)
newobj)))
(numberobjp
(lambda (imobj) (* |ss:| "27-Jun-87 16:21")
(* * |Tests| |an| |imageobj| |to| |see| |if| |it| |is| \a |number|
|imageobject.| |The| |only| |number| |imageobjects| |so| |far| |are| |NGroups|
|and| |Endnotes.| b\y |convention,| |testing| |functions| |for| |an|
|imageobject| |will| |be| |named| (concat |<type| |of| |imageobj>| "P"))
(and imobj (eq (imageobjprop imobj 'type)
'numberobj))))
(ngroupp
(lambda (imobj) (* |ss:| "27-Jun-87 16:15")
(* * |Like| numberobjp |but| |also| |checks| |for| |NGroup| |ImageObject.|)
(and (numberobjp imobj)
(eq (|fetch| (numberobj use) |of| (|fetch| objectdatum |of| imobj))
'ngroup))))
(number.displayfn
(lambda (image.obj stream) (* |fsg| "24-Sep-87 14:56")
(* |Display| |function| |for| |numberobjs.|
|Allows| |different| |formats| |for| |display| |according| |to| |the| |use|
|to| |which| |the| |numberobj| |is| |being| |put.|
i\f |no| |specific| |action| |is| |specified,| |displaying| |defaults| |to|
|printing| |out| |as| \a |plain| |number.*|)
(|with| numberobj (|fetch| objectdatum |of| image.obj)
(let* ((main.window (|with| textobj textobj (car \\window)))
(image.tag (imageobjprop image.obj 'tag))
(old.font (dspfont nil stream))
(nbr.font (selectq use
(note (|fetch| (endnotefonts number.font) |of| (get.endnote.fonts
main.window)))
(ngroup font)
(error "Undefined USE field" use))))
(and image.tag (or (tsp.getcodeval image.tag main.window)
(tsp.putcode image.tag image.obj main.window)))
(and (fontp nbr.font)
(dspfont (fontcreate (fontprop nbr.font 'family)
(fontprop nbr.font 'size)
(fontprop nbr.font 'face))
stream))
(or (imagestreamtypep stream 'display)
(setq page.number (car formattingstate)))
(tmax.shadeobj image.obj stream)
(selectq use
(ngroup (prin1 (concat (or text.before# "")
(mkstring numstring)
(or text.after# ""))
stream)
(or (imagestreamtypep stream 'display)
(update.ngroup.manindex template ref.type main.window)))
(note (let ((current.ypos (dspyposition nil stream))
(imagebox (listget (|fetch| imageobjplist |of| image.obj)
'boundbox)))
(dspyposition (iplus current.ypos (idifference (|fetch| ysize
|of| imagebox)
(fontprop stream
'height)))
stream)
(prin1 (mkstring numstring)
stream)
(dspyposition current.ypos stream)))
nil)
(dspfont old.font stream)))))
(number.imageboxfn
(lambda (obj stream currentx rightmargin) (* |fsg| " 4-Aug-87 14:56")
(* * |For| |Endnote| |numbers,| |the| |YSize| |is| |the| |current| |font|
|height| |plus| 0.25 |times| |the| |Endnote| |number| |font| |height.|
w\e |do| |this| |so| |the| |the| |Endnote| |number| |will| |be| |superscripted|
|but| |not| |too| |much.|)
(* * |The| |YSize| |is| |computed| |as| |the| |current| |font| |height| |plus|
|half| |of| |the| note |or| |NGroup| |font.|
|The| |reason| |is| |weird.| |Ask| |Sami| |for| |more| |details.|)
(|with| numberobj (|fetch| objectdatum |of| obj)
(let* ((main.window (|with| textobj textobj (car \\window)))
(imobj.string (mkstring numstring))
(nbr.font (selectq use
(note (|fetch| (endnotefonts number.font) |of| (get.endnote.fonts
main.window)))
(ngroup font)
(error "Undefined USE field" use))))
(and (eq use 'ngroup)
(progn (and (stringp text.before#)
(setq imobj.string (concat text.before# imobj.string)))
(and (stringp text.after#)
(setq imobj.string (concat imobj.string text.after#)))))
(and (fontp nbr.font)
(dspfont (fontcreate (fontprop nbr.font 'family)
(fontprop nbr.font 'size)
(fontprop nbr.font 'face))
stream))
(|create| imagebox
xsize ← (stringwidth imobj.string stream)
ysize ← (selectq use
(note (fix (plus (times (dspscale nil stream)
(fontprop (current.display.font stream)
'height))
(times 0.25 (fontprop stream 'height)))))
(fontprop stream 'height))
ydesc ← (fontprop stream 'descent)
xkern ← 0)))))
(number.putfn
(lambda (obj stream) (* |fsg| " 5-Aug-87 08:24")
(let ((window (|with| textobj textobj (car \\window)))
(use (|with| numberobj (|fetch| objectdatum |of| obj)
use))
(old.font (|with| numberobj (|fetch| objectdatum |of| obj)
font)))
(selectq use
(note (note.putfn obj stream window))
(ngroup (let ((ngroup.rec (copy (|fetch| objectdatum |of| obj))))
(|with| numberobj ngroup.rec (setq font (list.font.props font))
(prin4 (list '|NGroup| (and (windowprop window 'dumpngroupgraph)
(dump.ngroup.graph window))
(imageobjprop obj 'tag)
ngroup.rec)
stream))))
(error "Unknown NUMBER ImageObject type" use)))))
(number.getfn
(lambda (stream copy.object) (* |fsg| " 3-Sep-87 15:17")
(* * i\f copy.object |is| |non-NIL| |then| |we| |are| |COPYing| |it| |to|
|this| |window.|)
(let ((nbrobj.datum (or copy.object (cdr (read stream))))
(newobj (numberobj))
(window (|with| textobj textobj (car \\window))))
(tsp.setup.fmmenu window)
(and (ilessp (length nbrobj.datum)
3)
(setq nbrobj.datum (cons nil nbrobj.datum)))
(and (car nbrobj.datum)
(not (and (boundp 'tmax.prune.ngraph)
tmax.prune.ngraph))
(copy.ngroup.branch (car nbrobj.datum)
window))
(and (cadr nbrobj.datum)
(not (gethash (cadr nbrobj.datum)
(windowprop window 'tsp.code.array)))
(progn (tsp.putcode (cadr nbrobj.datum)
newobj window)
(imageobjprop newobj 'tag (cadr nbrobj.datum))))
(|with| numberobj (setq nbrobj.datum (ngroup.fixup.records (caddr nbrobj.datum)
copy.object))
(selectq use
(note (note.getfn newobj nbrobj.datum window))
(ngroup (and (listp font)
(setq font (fontcreate font)))
(create.ngroup.node ref.type ngroup.mother nbrobj.datum window)
(create.ngroup.node ngroup.mother nil nil window)
(add.ngroup.to.mother.node ref.type ngroup.mother window)
(windowprop window 'rebuild.graphflg t)
(and (|fetch| (ngtemplate ng.manualindex) |of| template)
(windowaddprop window 'manualgroups ref.type))
(|replace| objectdatum |of| newobj |with| nbrobj.datum))
(error "Unknown USE type in NUMBER.GETFN" use)))
newobj)))
(number.copyfn
(lambda (image.obj source.stream target.stream) (* |fsg| " 4-Aug-87 09:46")
(* * |Here| |to| copy \a |Number| |Image| |Object.|
i\f |we| |are| |copying| |to| |our| |own| |window,| |we| |delete| |the| tag
|if| |any| |so| |we| |don't| |get| |two| |ImageObjs| |with| |the| |same| tag
|name.|)
(selectq (imagestreamtype target.stream)
(text (let ((source.window (|with| textobj textobj (car \\window)))
(textobj (textobj target.stream)))
(apply* (imageobjprop image.obj 'getfn)
target.stream
(list (|with| numberobj (|fetch| objectdatum |of| image.obj)
(and (eq use 'ngroup)
(neq source.stream target.stream)
(|for| parent |in| (append (list.ancestors ref.type nil
source.window)
(list ref.type))
|collect| (car (gethash parent (tsp.get.ngroup.array
source.window))))))
(and (neq source.stream target.stream)
(imageobjprop image.obj 'tag))
(|fetch| objectdatum |of| image.obj)))))
(error "Unknown TARGET stream type" (imagestreamtype target.stream)))))
(number.buttoneventinfn
(lambda (obj stream sel relx rely window hoststream button)(* |fsg| " 2-Sep-87 11:09")
(* * |Here| |when| \a |NumberOBJ| |is| |left| |or| |middle| |buttoned.|
|Left| |just| |dislays| |the| |Tag| |if| |any| |in| |the| |prompt| |window.|
|Middle| |pops| |up| \a |menu| |allowing| |this| |user| |to| |do| |various|
|things.|)
(and (mousestate left)
(cond
((imageobjprop obj 'tag)
(|with| numberobj (|fetch| objectdatum |of| obj)
(tedit.promptprint stream (concat "Tag for this " (selectq use
(note "Endnote")
(ngroup ref.type)
(error "Undefined USE code"
use))
" is \""
(imageobjprop obj 'tag)
"\"")
t)))
(t (tedit.promptprint stream "" t))))
(and (mousestate middle)
(let* ((datum (|fetch| objectdatum |of| obj))
(use (|fetch| (numberobj use) |of| datum))
(ref.type (|fetch| (numberobj ref.type) |of| datum)))
(and (selectq use
(note (note.buttoneventinfn obj stream window))
(ngroup (ngroup.buttoneventinfn ref.type obj stream window))
(error "Undefined USE code" use))
(progn (tedit.promptprint stream "" t)
'changed))))))
)
(defineq
(copy.ngroup.branch
(lambda (ngroup.parents window) (* |fsg| "11-Aug-87 09:36")
(* * |Build| |the| |NGroup| |database| |for| |the| |parents| |of| \a |copied|
|NGroup| |or| |the| |entire| |NGroup| |database| |on| \a get.)
(|for| parent |in| ngroup.parents |do| (and parent (|with| numberobj parent (and (listp font)
(setq font
(fontcreate
font)))
(or ngroup.mother (setq ngroup.mother
'new.ngroup))
(create.ngroup.node ref.type
ngroup.mother parent window)
(create.ngroup.node ngroup.mother nil
nil window)
(add.ngroup.to.mother.node ref.type
ngroup.mother window))))))
(dump.ngroup.graph
(lambda (window) (* |fsg| " 3-Aug-87 16:03")
(* * |Return| \a |list| |of| |the| |NGroup| |graph| |data| |that| |is| put
|along| |with| |the| |NGroup| |Imageobject.|
w\e |can| |then| |rebuild| |the| |entire| |NGroup| |graph| |on| \a get.)
(let ((graph.list (tconc nil)))
(maphash (tsp.get.ngroup.array window)
(function (lambda (val key)
(and (neq key 'new.ngroup)
(let ((ngroup.rec (copy (car val))))
(|with| numberobj ngroup.rec (setq font (list.font.props font))
(tconc graph.list ngroup.rec)))))))
(windowprop window 'dumpngroupgraph nil)
(cdar graph.list))))
(ngroup.buttoneventinfn
(lambda (ref.type ngroup.obj stream window) (* |fsg| " 5-Aug-87 08:31")
(* * |Here| |when| |an| |inserted| |NGroup| |is| |middle| |buttoned.|)
(let ((tag (imageobjprop ngroup.obj 'tag))
(graphw (windowprop window 'imageobj.menuw)))
(menu (|create| menu
title ← (concat ref.type " Menu")
items ← (append (cond
(tag ngroup.inserted.tag.items)
(t ngroup.inserted.notag.items))
ngroup.inserted.menu.items)
centerflg ← t)))))
(ngroup.define.tag
(lambda (ref.type window ngroup.obj) (* |fsg| " 5-Aug-87 09:26")
(* * |Define| \a tag |for| |this| |NGroup| |or| |Change| |the| tag |if| |it|
|already| |exists.|)
(let ((old.tag (imageobjprop ngroup.obj 'tag))
(new.tag (tsp.get.incode (textstream window))))
(and new.tag (neq new.tag old.tag)
(progn (and old.tag (number.delete.tag window ngroup.obj))
(tsp.putcode new.tag ngroup.obj window)
(imageobjprop ngroup.obj 'tag new.tag))))))
(number.delete.tag
(lambda (window ngroup.obj) (* |fsg| " 5-Aug-87 09:27")
(* * |Delete| |this| |Imageobj's| tag.)
(tsp.putcode (imageobjprop ngroup.obj 'tag nil)
nil window)
nil))
(ngroup.show.tag
(lambda (ref.type window ngroup.obj) (* |fsg| " 5-Aug-87 08:43")
(* * |Show| |this| |NGroup's| tag.)
(tedit.promptprint (textstream window)
(concat ref.type ": Tag=\"" (imageobjprop ngroup.obj 'tag)
"\"")
t)))
(change.inserted.ngroup.format
(lambda (ref.type ngroup.obj stream window format.field) (* |fsg| " 1-Sep-87 15:33")
(* * |Change| |an| |inserted| |NGroup's| |entire| |format| |or| \a |selected|
|field.|)
(let ((graphw (windowprop window 'imageobj.menuw))
(new.format (|for| field |in| (cond
(format.field (list format.field))
(t '(txtbefore display txtafter abbrevval before#txt
after#txt)))
|collect| (selectq field
(txtbefore (change.ngroup.format.txtbefore ref.type graphw
ngroup.obj))
(display (change.ngroup.format.display ref.type graphw
ngroup.obj))
(txtafter (change.ngroup.format.txtafter ref.type graphw
ngroup.obj))
(abbrevval (change.ngroup.format.abbrev ref.type graphw
ngroup.obj))
(before#txt (change.ngroup.format.#text ref.type window
ngroup.obj 'before))
(after#txt (change.ngroup.format.#text ref.type window
ngroup.obj 'after))
(error "Unknown NGroup Format field" field)))))
(apply 'or new.format))))
(change.ngroup.format.#text
(lambda (ref.type window ngroup.obj flavor) (* |fsg| "25-Aug-87 14:48")
(* * |Change| |the| |text| |before| |or| |after| |an| |inserted| |NGroup|
|regardless| |of| |the| |Text| |Before| |or| |Text| |After| |toggle|
|settings.|)
(|with| numberobj (|fetch| objectdatum |of| ngroup.obj)
(let ((old.string (selectq flavor
(before text.before#)
text.after#))
(new.string (tedit.getinput (textstream window)
(concat (selectq flavor
(before "Text before ")
"Text after ")
ref.type ":"))))
(and new.string (setq new.string (concat (selectq flavor
(before "")
" ")
(convert.tabs.to.spaces new.string)
(selectq flavor
(before " ")
""))))
(selectq flavor
(before (setq text.before# new.string))
(setq text.after# new.string))
(not (strequal old.string new.string))))))
(show.inserted.ngroup.format
(lambda (ref.type ngroup.obj stream window) (* |fsg| "26-Aug-87 12:05")
(* * |Show| |the| |format| |of| |an| |inserted| |NGroup.|)
(|with| numberobj (|fetch| objectdatum |of| ngroup.obj)
(|with| ngtemplate template (tedit.promptprint stream
(concat ref.type ": Display="
(concat (cond
(ng.text-before (concat "\""
ng.text-before
"\""))
(t "\"\""))
ng.chartype
(cond
(ng.text-after (concat "\""
ng.text-after
"\""))
(t "\"\"")))
" Abbrev="
(or abbrev-val "None"))
t)))))
)
(* * |Variable| |and| |Record| |definitions|)
(rpaqq ngroup.graph.menu.items `((|Change Font| (change.ngroup.font label graphw)
"Change this NGroup's entire FONT."
(subitems (|Family| (change.ngroup.font label graphw
'family)
"Change this NGroup's font family.")
(|Size| (change.ngroup.font label graphw 'size)
"Change this NGroup's font size.")
(|Face| (change.ngroup.font label graphw 'face)
"Change this NGroup's font face.")))
(|Show Font| (show.ngroup.font label graphw)
"Show this NGroup's FONT.")
(|Change Format| (change.ngroup.format label graphw)
"Change this NGroup's entire FORMAT."
(subitems (|Delimiter Before| (change.ngroup.format
label graphw 'txtbefore)
"Change the delimiter preceding this NGroup."
)
(|Display Type| (change.ngroup.format label graphw
'display)
"Change how this NGroup is displayed.")
(|Delimiter After| (change.ngroup.format label graphw
'txtafter)
"Change the delimiter following this NGroup.")
(|Abbreviate Level| (change.ngroup.format label graphw
'abbrevval)
"Specify the starting level of this NGroup value."
)
(|Starting Value| (change.ngroup.format label graphw
'start)
"Change this NGroup's starting value.")
(|Table-Of-Contents| (change.ngroup.format
label graphw 'toc)
"Include this NGroup in the Table-Of-Contents."
)
\,@
(and (manualindex.enabled? (windowprop graphw
'twindow))
(list (list '|Manual Index|
(function (change.ngroup.format
label graphw 'manindex))
"Include this NGroup in the Manual Index page numbers."
)))))
(|Show Format| (show.ngroup.format label graphw)
"Show this NGroup's FORMAT.")))
(rpaqq ngroup.inserted.menu.items ((|Change Font| (change.ngroup.font ref.type graphw nil ngroup.obj)
"Change this NGroup's entire FONT."
(subitems (|Family| (change.ngroup.font ref.type graphw
'family ngroup.obj)
"Change this NGroup's font family.")
(|Size| (change.ngroup.font ref.type graphw
'size ngroup.obj)
"Change this NGroup's font size.")
(|Face| (change.ngroup.font ref.type graphw
'face ngroup.obj)
"Change this NGroup's font face.")))
(|Show Font| (show.ngroup.font ref.type graphw ngroup.obj)
"Show this NGroup's FONT.")
(|Change Format| (change.inserted.ngroup.format ref.type
ngroup.obj stream window)
"Change this NGroup's entire FORMAT."
(subitems (|Delimiter Before| (
change.inserted.ngroup.format
ref.type ngroup.obj stream
window 'txtbefore)
"Change the delimiter preceding this NGroup."
)
(|Display Type| (change.inserted.ngroup.format
ref.type ngroup.obj stream window
'display)
"Change how this NGroup is displayed.")
(|Delimiter After| (change.inserted.ngroup.format
ref.type ngroup.obj stream
window 'txtafter)
"Change the delimiter following this NGroup."
)
(|Abbreviate Level| (change.inserted.ngroup.format
ref.type ngroup.obj stream
window 'abbrevval)
"Specify the starting level of this NGroup value."
)
(|Text Before| (change.inserted.ngroup.format
ref.type ngroup.obj stream window
'before#txt)
"Change the text preceding this NGroup.")
(|Text After| (change.inserted.ngroup.format
ref.type ngroup.obj stream window
'after#txt)
"Change the text following this NGroup.")))
(|Show Format| (show.inserted.ngroup.format ref.type ngroup.obj
stream window)
"Show this NGroup's FORMAT.")))
(rpaqq ngroup.inserted.notag.items ((|Define Tag| (ngroup.define.tag ref.type window ngroup.obj)
"Define a TAG for this NGroup.")))
(rpaqq ngroup.inserted.tag.items ((|Change Tag| (ngroup.define.tag ref.type window ngroup.obj)
"Change this NGroup's TAG.")
(|Delete Tag| (number.delete.tag window ngroup.obj)
"Delete this NGroup's TAG.")
(|Show Tag| (ngroup.show.tag ref.type window ngroup.obj)
"Show this NGroup's TAG.")))
(declare\: eval@compile
(record ngcounter (ncount . ancestry))
(record ngtemplate (ng.chartype ng.text-after ng.start ng.addtotoc ng.currentval ng.manualindex
ng.text-before))
(record numberobj (ref.type numstring use ngroup.mother template updated.obj text.after# page.number
font text.before# abbrev-val))
)
(putprops tmax-number copyright ("Xerox Corporation" 1987))
(declare\: dontcopy
(filemap (nil (1616 15917 (numberobj 1626 . 2651) (numberobjp 2653 . 3193) (ngroupp 3195 . 3549) (
number.displayfn 3551 . 6590) (number.imageboxfn 6592 . 9085) (number.putfn 9087 . 10171) (
number.getfn 10173 . 12309) (number.copyfn 12311 . 14008) (number.buttoneventinfn 14010 . 15915)) (
15918 25089 (copy.ngroup.branch 15928 . 17384) (dump.ngroup.graph 17386 . 18262) (
ngroup.buttoneventinfn 18264 . 18964) (ngroup.define.tag 18966 . 19569) (number.delete.tag 19571 .
19830) (ngroup.show.tag 19832 . 20154) (change.inserted.ngroup.format 20156 . 21951) (
change.ngroup.format.#text 21953 . 23539) (show.inserted.ngroup.format 23541 . 25087)))))
stop