(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(filecreated "30-Dec-87 11:35:45" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX-NGRAPH.;2| 25361
|previous| |date:| "11-Nov-87 11:56:01" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX-NGRAPH.;1|)
; Copyright (c) 1987 by Xerox Corporation. All rights reserved.
(prettycomprint tmax-ngraphcoms)
(rpaqq tmax-ngraphcoms
((* |Developed| |under| |support| |from| nih |grant| rr-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(* * |Number| |Group| graph |functions|)
(fns graphmenu initial.ngroup.graph ngroup.make.rootnode tspgraphregion close.ngroup.graph
ngroup.graph.closefn add.ngroup.to.mother.node add.node.to.graph collect.hasharray
create.ngroup.node get.fromnodes get.tonodes find.node tsp.get.ngroup.array tsp.legalid
list.ancestors toplevel.sisters get.ngroup.mother)
(* * |Number| |counting| |functions|)
(fns downdate.numberobjs update.numberobjs reset.dependent.classes reset.ncounter
get.ncounter ncounter? flatten.tree.to.string ngroup.chartype ngroup.chartype.convert
number.to.letter remove.all.counters)))
(* |Developed| |under| |support| |from| nih |grant| rr-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(* * |Number| |Group| graph |functions|)
(defineq
(graphmenu
(lambda (tstream twindow) (* |fsg| "11-Jul-87 12:17")
(let* ((graph (or (and (not (windowprop twindow 'rebuild.graphflg))
(windowprop twindow 'ngroup.graph))
(initial.ngroup.graph twindow)))
(region (tspgraphregion graph twindow t))
(graphw (createw region "Number Group Graph" nil t)))
(and (ngroupmenu.enabled? twindow)
(close.ngroup.graph twindow))
(windowprop graphw 'repaintfn nil)
(attachwindow graphw twindow 'top 'justify 'localclose)
(showgraph graph graphw (function insert.ngroup)
(function change.ngroup))
(windowprop twindow 'rebuild.graphflg nil)
(windowprop twindow 'ngroupw graphw)
(windowprop twindow 'ngroup.graph graph)
(windowprop graphw 'closefn (function ngroup.graph.closefn))
(windowprop graphw 'twindow twindow)
(windowprop graphw 'tstream tstream))))
(initial.ngroup.graph
(lambda (window) (* |ss:| "27-Jun-87 16:56")
(let* ((rootnode (ngroup.make.rootnode))
(nodelst (|for| node |in| (collect.hasharray (tsp.get.ngroup.array window))
|collect| (cadr node))))
(or (find.node 'new.ngroup window)
(progn (setq nodelst (cons rootnode nodelst))
(add.ngroup.to.dbase 'new.ngroup nil nil nil rootnode window)))
(layoutgraph nodelst '(new.ngroup)))))
(ngroup.make.rootnode
(lambda nil (* |ss:| "27-Jun-87 16:14")
(nodecreate 'new.ngroup '|NGroups| nil nil nil (fontcreate 'helvetica 10 'brr)
1)))
(tspgraphregion
(lambda (graph main.window titleflg border) (* |ss:| " 2-Apr-86 16:28")
(let ((r (graphregion graph))
(main.r (windowregion main.window)))
(|replace| (region width) |of| r |with| (widthifwindow (|fetch| (region width) |of| r)))
(|replace| (region height) |of| r |with| (heightifwindow (|fetch| (region height)
|of| r)
titleflg border))
r)))
(close.ngroup.graph
(lambda (twindow) (* |fsg| "11-Jul-87 12:51")
(* * |Program| |invoked| |close| |of| |the| |NGroup| |menu| |graph| |window.|
program.close |is| |used| |to| |distinguish| |between| |our| |closing| |the|
|window| |and| |the| |user| |buttoning| |the| |Window| |Menu| close |command.|)
(let ((graph.window (windowprop twindow 'ngroupw)))
(windowprop graph.window 'program.close t)
(freeattachedwindow graph.window)
(closew graph.window))))
(ngroup.graph.closefn
(lambda (graph.window) (* \; "Edited 29-Sep-87 15:04 by fsg")
(* * |Clean| |up| \a |few| |things| |when| |user| close\s |the| |NGroup| |menu|
|graph| |window.|)
(or (windowprop graph.window 'program.close)
(let ((twindow (windowprop graph.window 'twindow)))
(fm.changestate (fm.getitem 'ngroup.menu nil (windowprop twindow 'imageobj.menuw))
nil
(windowprop twindow 'imageobj.menuw))
(freeattachedwindow graph.window)))))
(add.ngroup.to.mother.node
(lambda (id motherid w) (* |ss:| " 3-Apr-86 17:50")
(let* ((mother.node (find.node motherid w))
(tonodes (|fetch| (graphnode tonodes) |of| mother.node)))
(or (member id tonodes)
(|replace| (graphnode tonodes) |of| mother.node |with| (cons id tonodes))))))
(add.node.to.graph
(lambda (node graph window) (* |ss:| "27-Jun-87 15:57")
(let* ((parent.node (find.node (car (|fetch| (graphnode fromnodes) |of| node))
window))
(tonodes (|fetch| (graphnode tonodes) |of| node)))
(or (member (|fetch| (graphnode nodeid) |of| node)
tonodes)
(progn (|replace| (graphnode tonodes) |of| parent.node
|with| (cons (|fetch| (graphnode nodeid) |of| node)
(|fetch| (graphnode tonodes) |of| parent.node)))
(|replace| (graph graphnodes) |of| graph |with| (cons node (|fetch| (graph
graphnodes)
|of| graph)))))
(layoutgraph (|fetch| (graph graphnodes) |of| graph)
'(new.ngroup)))))
(collect.hasharray
(lambda (harray) (* |ss:| "27-Jun-87 16:03")
(let ((result nil))
(maphash harray (function (lambda (val ky)
(setq result (cons val result)))))
result)))
(create.ngroup.node
(lambda (id mother userdata w) (* |fsg| "22-Jun-87 13:27")
(let* ((ngroup.harray (tsp.get.ngroup.array w))
(node (gethash id ngroup.harray)))
(or node (let ((new.node (selectq id
(new.ngroup (ngroup.make.rootnode))
(nodecreate id id nil nil (list mother)))))
(puthash id (list userdata new.node)
(list ngroup.harray))
new.node))
(or (and node (car node))
(and userdata node (rplaca node userdata))))))
(get.fromnodes
(lambda (ngid window) (* |ss:| " 3-Apr-86 16:00")
(car (|fetch| (graphnode fromnodes) |of| (find.node ngid window)))))
(get.tonodes
(lambda (ngid window) (* |fsg| "28-Jul-87 10:54")
(* * i\f ngid |has| |only| |one| |child| |then| |return| |that| |child's|
|name| |as| |an| |atom.| |Else| |return| |the| |list| |of| |NGID's| |children.|)
(* * a\s |of| |the| |date| |above,| |this| |function| |is| not |called.|)
(let ((tonodes (|fetch| (graphnode tonodes) |of| (find.node ngid window))))
(cond
((cdr tonodes)
(reverse tonodes))
(t (car tonodes))))))
(find.node
(lambda (ngid window) (* |fsg| " 4-Mar-87 10:22")
(cadr (gethash ngid (tsp.get.ngroup.array window)))))
(tsp.get.ngroup.array
(lambda (window) (* |ss:| "27-Jun-87 16:21")
(windowprop window 'tsp.ngroup.array)))
(tsp.legalid
(lambda (prev.ngroups stream) (* |fsg| " 3-Aug-87 17:04")
(* * |Get| \a |new| |NGroup| id |and| |make| |sure| |it's| |not| |already|
|defined.|)
(let ((ngroup.id (mkatom (tedit.getinput stream "Group name:"))))
(|while| (member ngroup.id prev.ngroups)
|do| (setq ngroup.id (mkatom (tedit.getinput stream (concat ngroup.id
(cond
((eq ngroup.id 'new.ngroup)
" is a reserved name...Group name:"
)
(t
" already exists...Group name:"
)))))))
ngroup.id)))
(list.ancestors
(lambda (nid ancestors window) (* |ss:| "27-Jun-87 16:09")
(* * |Return| \a |list| |of| |the| |parents| |of| |the| |given| |node.|)
(let ((mother (get.fromnodes nid window)))
(cond
((and mother (neq mother 'new.ngroup))
(list.ancestors mother (cons mother ancestors)
window))
(t ancestors)))))
(toplevel.sisters
(lambda (window) (* |ss:| "27-Jun-87 16:21")
(* * |Returns| \a |list| |of| |the| |top| |level| |NGroup| |nodes.|
a |top| |level| |node| |is| \a |node| |whose| |mother| |is| new.ngroup.)
(reverse (|fetch| (graphnode tonodes) |of| (find.node 'new.ngroup window)))))
(get.ngroup.mother
(lambda (ngid window) (* |fsg| " 4-Mar-87 11:24")
(* * |Return| |the| |top| |level| |mother| |of| \a |branch| |of| |the| |Ngroup|
|tree.|)
(let ((ancestors (list.ancestors ngid nil window)))
(cond
(ancestors (car ancestors))
(t (cond
((find.node ngid window)
ngid)
(t nil)))))))
)
(* * |Number| |counting| |functions|)
(defineq
(downdate.numberobjs
(lambda (window stream objselectfn) (* |fsg| "25-Sep-87 09:45")
(* * |Undoes| |what| update.numberobjs |does.|)
(let ((nbrobj.list (tsp.list.of.objects (textobj window)
objselectfn)))
(and nbrobj.list
(progn (tedit.promptprint stream (concat "Undoing Update of " (selectq objselectfn
(ngroupp
"Number Groups")
(endnotep "Endnotes")
"Number Groups and Endnotes"
)
"...")
t)
(|for| nbrobj |in| nbrobj.list
|do| (let ((datum (|fetch| objectdatum |of| (car nbrobj))))
(|with| numberobj datum (setq page.number nil)
(and updated.obj
(progn (setq updated.obj nil)
(|replace| (ngtemplate ng.currentval)
|of| template |with| nil)
(setq numstring
(selectq use
(ngroup (concat "[" ref.type "]"))
(note "Note#")
nil))
(tedit.object.changed stream (car nbrobj)))))))
(tedit.promptprint stream "done"))))))
(update.numberobjs
(lambda (window stream objselectfn) (* |fsg| "25-Sep-87 09:34")
(* * |Convert| |the| |NGroup| |and| |Endnote| |markers| |to| |their|
|corresponding| |numeric| |values.|)
(let ((nbrobj.list (tsp.list.of.objects (textobj window)
objselectfn)))
(and nbrobj.list (progn (tedit.promptprint stream (concat "Updating " (selectq objselectfn
(ngroupp
"Number Groups")
(endnotep
"Endnotes")
"Number Groups and Endnotes"
)
"...")
t)
(|for| nbrobj |in| nbrobj.list
|do| (let ((datum (|fetch| objectdatum |of| (car nbrobj)))
new.count)
(|with| numberobj datum (reset.dependent.classes window
use ref.type)
(setq new.count
(get.ncounter window use ref.type ngroup.mother
template datum))
(and (neq new.count numstring)
(progn (setq numstring new.count)
(setq updated.obj t)
(tedit.object.changed stream
(car nbrobj))))))
|finally| (remove.all.counters window))
(tedit.promptprint stream "done"))))))
(reset.dependent.classes
(lambda (window use ref.type) (* |fsg| "12-Dec-86 10:50")
(|for| dependent |in| (|fetch| (graphnode tonodes) |of| (find.node ref.type window))
|do| (progn (reset.ncounter window use dependent)
(reset.dependent.classes window use dependent)))))
(reset.ncounter
(lambda (window use ref.type) (* |fsg| "12-Dec-86 11:07")
(let* ((template (selectq use
(ngroup (|fetch| (numberobj template) |of| (car (gethash ref.type
(tsp.get.ngroup.array
window)))))
nil))
(counter (ncounter? window use ref.type template)))
(|replace| ncount |of| counter |with| (cond
(template (sub1 (|fetch| ng.start |of| template)))
(t 0))))))
(get.ncounter
(lambda (window use ref.type mother.class template nbr.datum)
(* |fsg| "11-Aug-87 15:26")
(let ((counter (ncounter? window use ref.type template)))
(and counter (progn (|with| ngcounter counter (|add| ncount 1)
(and (eq use 'ngroup)
template
(|replace| (ngtemplate ng.currentval) |of| template
|with| ncount)))
(cond
(mother.class (flatten.tree.to.string window use ref.type nbr.datum))
(t (mkstring (|fetch| ncount |of| counter)))))))))
(ncounter?
(lambda (window use ref.type template) (* |fsg| "14-Jul-87 14:10")
(* * |Return| |the| |record| |for| |this| |number| |counter.|
i\f |the| |record| |doesn't| |exist,| |we| |create| |one| |based| |on| |the|
use |value.|)
(let ((counter.id (mkatom (concat (selectq use
(ngroup (concat "NGROUP." ref.type "."))
(note "ENDNOTE.")
(error "Unknown NUMBER type" use))
"COUNTER"))))
(or (windowprop window counter.id)
(progn (windowprop window counter.id (|create| ngcounter
ncount ← (cond
((and (eq use 'ngroup)
template)
(sub1 (|fetch| ng.start
|of| template)))
(t 0))
ancestry ←
(selectq use
(ngroup (list.ancestors ref.type nil
window))
nil)))
(windowaddprop window 'counters counter.id)
(windowprop window counter.id))))))
(flatten.tree.to.string
(lambda (window use ref.type nbr.datum) (* |fsg| " 5-Aug-87 14:12")
(let* ((ngroup.counter (ncounter? window use ref.type))
(ngroup.list (append (|fetch| (ngcounter ancestry) |of| ngroup.counter)))
(abbrevval (|with| numberobj nbr.datum (and abbrev-val (list.ancestors abbrev-val nil
window))))
(flat.tree "")
ancestor)
(and ngroup.list (|while| (setq ancestor (|pop| ngroup.list))
|do| (or (and abbrevval (memb ancestor abbrevval))
(setq flat.tree (concat flat.tree
(ngroup.chartype window ancestor
(|fetch| (ngcounter ncount)
|of| (ncounter? window use
ancestor))
(or (car ngroup.list)
ref.type)))))))
(setq flat.tree (concat flat.tree (ngroup.chartype window ref.type (|fetch| (ngcounter
ncount)
|of| ngroup.counter)
nil))))))
(ngroup.chartype
(lambda (window ref.type ncount next.ngroup) (* |fsg| "11-Aug-87 15:23")
(* * |Convert| |the| |number| ncount |to| |the| |format| |specified| |in|
template. delimitflg |is| |the| |next| |NGroup's| |preceding| |delimiter| |or|
nil |if| |either| |the| |next| |NGroup| |has| |no| |preceding| |delimiter| |or|
|there| |is| |no| |next| |NGroup.|)
(let ((delimitflg (and next.ngroup (|with| ngtemplate (|fetch| (numberobj template)
|of| (car (gethash next.ngroup
(tsp.get.ngroup.array
window))))
ng.text-before))))
(|with| ngtemplate (|fetch| (numberobj template) |of| (car (gethash ref.type (
tsp.get.ngroup.array
window))))
(concat (or ng.text-before "")
(ngroup.chartype.convert ng.chartype ncount)
(cond
(delimitflg "")
(t (or ng.text-after ""))))))))
(ngroup.chartype.convert
(lambda (chartype ncount) (* |fsg| "28-Jul-87 11:12")
(* * |Convert| |the| |value| ncount |to| |the| |type| |specified| |by|
chartype. i\f ncount < 1 |and| chartype |is| |Letter/Roman| |then| |we|
|return| nil. |This| |anomaly| |is| |usually| |caused| |by| |out-of-order|
|NGroups.|)
(cond
((fixp ncount)
(cond
((or (igreaterp ncount 0)
(eq chartype '|Number|)
(eq chartype '|Null String|))
(selectq chartype
(uppercase\ letter
(number.to.letter ncount t))
(|lowercase letter|
(number.to.letter ncount))
(uppercase\ roman
(romannumerals ncount t))
(|lowercase roman|
(romannumerals ncount))
(|Null String| "")
(|Number| (mkstring ncount))
(error "Unknown display type" chartype)))
(t (mkstring nil))))
(t (error "Invalid integer" ncount)))))
(number.to.letter
(lambda (number ucflg) (* |fsg| " 5-Dec-86 10:18")
(* * |Convert| number |to| |equivalent| |letter| |code.|)
(let ((ltrlst (mkstring (character (iplus (charcode a)
(iremainder (sub1 number)
26)))))
(ltrnbr (iquotient (sub1 number)
26)))
(|until| (zerop ltrnbr) |do| (setq ltrlst (concat (character (sub1 (iplus (charcode a)
(iremainder ltrnbr
26))))
ltrlst))
(setq ltrnbr (iquotient ltrnbr 26)))
(cond
(ucflg (u-case ltrlst))
(t (l-case ltrlst))))))
(remove.all.counters
(lambda (window) (* |ss:| "30-Sep-85 09:38")
(|for| counter |in| (windowprop window 'counters) |do| (windowprop window counter nil)
|finally| (windowprop window 'counters nil))))
)
(putprops tmax-ngraph copyright ("Xerox Corporation" 1987))
(declare\: dontcopy
(filemap (nil (1425 11144 (graphmenu 1435 . 2488) (initial.ngroup.graph 2490 . 3059) (
ngroup.make.rootnode 3061 . 3282) (tspgraphregion 3284 . 3876) (close.ngroup.graph 3878 . 4462) (
ngroup.graph.closefn 4464 . 5065) (add.ngroup.to.mother.node 5067 . 5461) (add.node.to.graph 5463 .
6568) (collect.hasharray 6570 . 6856) (create.ngroup.node 6858 . 7535) (get.fromnodes 7537 . 7737) (
get.tonodes 7739 . 8326) (find.node 8328 . 8501) (tsp.get.ngroup.array 8503 . 8669) (tsp.legalid 8671
. 9832) (list.ancestors 9834 . 10278) (toplevel.sisters 10280 . 10662) (get.ngroup.mother 10664 .
11142)) (11189 25278 (downdate.numberobjs 11199 . 13348) (update.numberobjs 13350 . 15883) (
reset.dependent.classes 15885 . 16258) (reset.ncounter 16260 . 17044) (get.ncounter 17046 . 17876) (
ncounter? 17878 . 19663) (flatten.tree.to.string 19665 . 21370) (ngroup.chartype 21372 . 22825) (
ngroup.chartype.convert 22827 . 24000) (number.to.letter 24002 . 24992) (remove.all.counters 24994 .
25276)))))
stop