(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(filecreated "30-Dec-87 11:34:27" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX-NGROUP.;2| 47949
|previous| |date:| "11-Nov-87 11:57:39" |{POGO:AISNORTH:XEROX}<CUTTING>TMAX>TMAX-NGROUP.;1|)
; Copyright (c) 1987 by Xerox Corporation. All rights reserved.
(prettycomprint tmax-ngroupcoms)
(rpaqq tmax-ngroupcoms
((* |Developed| |under| |support| |from| nih |grant| rr-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(* * |Other| |unsorted| |functions|)
(fns insert.ngroup verify.ngroup.order get.previous.ngroups add.number.group
add.ngroup.to.dbase collect.ngroups list.font.props map.ngroup.looks ngroup.getfont
change.ngroup change.ngroup.font show.ngroup.font change.ngroup.format
show.ngroup.format change.ngroup.format.txtbefore change.ngroup.format.display
change.ngroup.format.txtafter get.ngroup.delimiter change.ngroup.format.abbrev
change.ngroup.format.start get.ngroup.start change.ngroup.format.toc
change.ngroup.format.manindex update.ngroup.manindex ngroup.fixup.records)
(* * |Table-of-Contents| |functions|)
(fns get.ngroup.textstring convert.tabs.to.spaces create.toc.file ngroup.toc.entries
view.toc.file get.toc.file write.toc.file write.toc.entry)))
(* |Developed| |under| |support| |from| nih |grant| rr-00785.)
(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
(* * |Other| |unsorted| |functions|)
(defineq
(insert.ngroup
(lambda (node graphw) (* |fsg| "26-Aug-87 14:37")
(* * |Insert| \a |NGroup| |build| |from| |the| |prototype| |definition.|)
(and node (let* ((twindow (windowprop graphw 'twindow))
(tstream (windowprop graphw 'tstream))
(label (|fetch| (graphnode nodeid) |of| node))
(oldlooks (|fetch| caretlooks |of| (textobj tstream)))
(newlooks (ngroup.getfont label twindow)))
(|with| numberobj (car (gethash label (tsp.get.ngroup.array twindow)))
(selectq label
(new.ngroup nil)
(let ((newobj (numberobj 'ngroup template (concat "[" label "]")
label newlooks (get.fromnodes label twindow)
abbrev-val)))
(tedit.caretlooks tstream newlooks)
(get.ngroup.textstring newobj label tstream twindow)
(imageobjprop newobj 'twindow twindow)
(tedit.insert.object newobj tstream)
(tedit.caretlooks tstream oldlooks)
(and (update? twindow)
(update.numberobjs twindow tstream 'ngroupp))
(verify.ngroup.order twindow newobj))))))))
(verify.ngroup.order
(lambda (window ngroup.obj) (* |fsg| "28-Jul-87 15:59")
(* * |Verify| |the| |NGroup| |order| |before| |inserting| \a |new| |NGroup.|
|The| |order| |is| |valid| |if| |the| |new| |NGroup| |is| \a |top| |level|
|node| |or| |its| |parent| |Ngroup| |has| |already| |been| |inserted.|)
(let* ((mother (|with| numberobj (|fetch| objectdatum |of| ngroup.obj)
ngroup.mother))
(selection (tedit.getsel (textstream window)))
(ch# (and selection (|fetch| ch# |of| selection))))
(cond
((or (eq mother 'new.ngroup)
(and ch# (|for| prev.ngroup |in| (tsp.list.of.objects (textobj window)
(function get.previous.ngroups)
ch#)
|thereis| (eq mother (|with| numberobj (|fetch| objectdatum
|of| (car prev.ngroup))
ref.type)))))
(tedit.promptprint (textstream window)
"" t))
(t (tedit.promptprint (textstream window)
(concat "Warning...\"" (|with| numberobj (|fetch| objectdatum |of| ngroup.obj)
ref.type)
"\" is not preceded by \"" mother "\" NGroup.")
t)
(flashwindow (|with| textobj (textobj window)
promptwindow)
2))))))
(get.previous.ngroups
(lambda (ngroup.obj char.pos) (* |fsg| "28-Jul-87 14:01")
(* * |Called| |from| tsp.list.of.objects |to| |collect| |all| |the| |NGroup|
|ImageObjs| |that| |exist| |before| |the| |character| |position| char.pos.)
(and (ngroupp ngroup.obj)
(ilessp ch# char.pos))))
(add.number.group
(lambda (twindow stream) (* \; "Edited 30-Sep-87 14:34 by fsg")
(or (ngroupmenu.enabled? twindow)
(progn (fm.changestate (fm.getitem 'ngroup.menu nil (windowprop twindow 'imageobj.menuw))
t
(windowprop twindow 'imageobj.menuw))
(graphmenu stream twindow)))
(let* ((prev.items (collect.ngroups twindow))
(new.groupid (mkatom (tsp.legalid (cons 'new.ngroup prev.items)
stream)))
template dependent.class new.node)
(prog1 (cond
(new.groupid (setq dependent.class
(or (mkatom (and prev.items
(menu (|create| menu
title ← "Parent Group?"
items ← (sort prev.items 'ualphorder)
))))
'new.ngroup))
(or template
(setq template
(|create| ngtemplate
ng.chartype ← '|Number|
ng.text-before ← nil
ng.text-after ← "."
ng.start ← 1
ng.addtotoc ← t
ng.currentval ← nil
ng.manualindex ← nil)))
(setq new.node (nodecreate new.groupid new.groupid nil nil (list
dependent.class
)))
(add.ngroup.to.dbase new.groupid template dependent.class |GP.DefaultFont|
new.node twindow)
(add.node.to.graph new.node (windowprop twindow 'ngroup.graph)
twindow))
(t nil))
(tedit.promptprint stream "" t)))))
(add.ngroup.to.dbase
(lambda (new.groupid template dependent.class font ngroup.node twindow)
(* |fsg| " 3-Aug-87 16:43")
(let ((ngroup.array (tsp.get.ngroup.array twindow)))
(or (gethash new.groupid ngroup.array)
(progn (windowprop twindow 'rebuild.graphflg t)
(puthash new.groupid
(list (|create| numberobj
ngroup.mother ← dependent.class
font ← font
ref.type ← new.groupid
template ← template)
ngroup.node)
(list ngroup.array)))))))
(collect.ngroups
(lambda (twindow) (* |ss:| "31-Mar-86 13:53")
(let ((graph (windowprop twindow 'ngroup.graph)))
(|for| node |in| (|fetch| (graph graphnodes) |of| graph) |collect| (|fetch| (graphnode
nodeid)
|of| node)
|unless| (eq (|fetch| (graphnode nodeid) |of| node)
'new.ngroup)))))
(list.font.props
(lambda (fontdes) (* |fsg| " 3-Aug-87 10:03")
(and (fontp fontdes)
(list (fontprop fontdes 'family)
(fontprop fontdes 'size)
(fontprop fontdes 'face)))))
(map.ngroup.looks
(lambda (label new.font twindow new.template) (* |fsg| " 5-Aug-87 13:40")
(* * |Here| |to| |change| |the| |font| |or| |format| |of| |an| |NGroup.|
i\f new.template |is| |non-NIL| |then| |we| |are| |changing| |the| |format,|
|else| |we| |are| |changing| |the| |font.|)
(tedit.promptprint (textstream twindow)
(concat "Updating " (cond
(new.template "FORMAT")
(t "FONT"))
" for \"" label "\" Ngroups...")
t)
(|for| ngroup.obj |in| (tsp.list.of.objects (textobj twindow)
`(lambda (obj)
(and (ngroupp obj)
(eq (fetch ref.type of (fetch objectdatum of obj))
\,
(kwote label)))))
|do| (|with| numberobj (|fetch| objectdatum |of| (car ngroup.obj))
(cond
(new.template (setq template new.template))
(t (tedit.looks (textstream twindow)
new.font
(cadr ngroup.obj)
1)
(setq font new.font)))))
(tedit.promptprint (textstream twindow)
"Done.")))
(ngroup.getfont
(lambda (ngroup.name window ngroup.obj) (* |fsg| " 4-Aug-87 15:00")
(* * |Get| |an| |NGroup's| |font.| i\f ngroup.obj |is| |non-NIL| |then| |we|
|get| |the| |font| |from| |this| |ImageObj's| objectdatum.
|Else| |we| |get| |the| |font| |from| |the| |NGroup| |graph| |prototype|
|NGroup.|)
(|fetch| (numberobj font) |of| (cond
(ngroup.obj (|fetch| objectdatum |of| ngroup.obj))
(t (car (gethash ngroup.name (tsp.get.ngroup.array window))))))
))
(change.ngroup
(lambda (node graphw) (* |fsg| "30-Jul-87 13:52")
(* * |Here| |when| |number| |group| |node| |is| |middle| |buttoned.|
|Allow| |user| |to| |change| |the| |font| |and/or| |format| |of| |the|
|ngroup.|)
(and node (let ((label (|fetch| (graphnode nodeid) |of| node)))
(selectq label
(new.ngroup nil)
(menu (|create| menu
title ← (mkstring label)
centerflg ← t
items ← (eval ngroup.graph.menu.items))))))))
(change.ngroup.font
(lambda (label graphw font.field ngroup.obj) (* |fsg| " 4-Aug-87 15:09")
(* * |Change| \a |NGroup| |font.| i\f |NGROUP.OBJis| |non-NIL| |then| |we|
|are| |working| |on| |an| |inserted| |NGroup.|
|Else| |we| |are| |working| |on| |the| |graph| |prototype| |NGroups.|)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
new.font)
(show.ngroup.font label graphw ngroup.obj)
(tedit.promptprint stream (selectq font.field
(family ", change Family to...")
(size ", change Size to...")
(face ", change Face to...")
", change to..."))
(|with| numberobj (cond
(ngroup.obj (|fetch| objectdatum |of| ngroup.obj))
(t (car (gethash label (tsp.get.ngroup.array window)))))
(setq new.font (fontcreate (get.tsp.font window font font.field)))
(tedit.promptprint stream "" t)
(and (neq font new.font)
(progn (setq font new.font)
(cond
(ngroup.obj new.font)
(t (map.ngroup.looks label new.font window)))))))))
(show.ngroup.font
(lambda (label graphw ngroup.obj) (* |fsg| " 4-Aug-87 14:57")
(* * |Show| |this| |NGroup's| |font| |specification.|)
(let* ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
(font.list (abbreviate.font (ngroup.getfont label window ngroup.obj))))
(tedit.promptprint stream (concat label ": Family=" (|pop| font.list)
" Size="
(|pop| font.list)
" Face="
(|pop| font.list))
t))))
(change.ngroup.format
(lambda (label graphw format.field) (* |fsg| " 1-Sep-87 15:39")
(* * |Change| |the| |entire| |format| |or| \a |selected| |field| |of| |an|
|NGroup.|)
(let ((window (windowprop graphw 'twindow))
(new.format (|for| field |in| (cond
(format.field (list format.field))
(t '(txtbefore display txtafter abbrevval start toc
manindex)))
|collect| (selectq field
(txtbefore (change.ngroup.format.txtbefore label graphw))
(display (change.ngroup.format.display label graphw))
(txtafter (change.ngroup.format.txtafter label graphw))
(abbrevval (change.ngroup.format.abbrev label graphw))
(start (change.ngroup.format.start label graphw))
(toc (change.ngroup.format.toc label graphw))
(manindex (change.ngroup.format.manindex label graphw))
(error "Unknown NGroup Format field" field)))))
(and (apply 'or new.format)
(let ((nbrobj (car (gethash label (tsp.get.ngroup.array window)))))
(map.ngroup.looks label (|fetch| (numberobj font) |of| nbrobj)
window
(|fetch| (numberobj template) |of| nbrobj)))))))
(show.ngroup.format
(lambda (label graphw) (* |fsg| "26-Aug-87 12:02")
(* * |Show| |this| |NGroup's| |format| |specification.|)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow)))
(|with| numberobj (car (gethash label (tsp.get.ngroup.array window)))
(|with| ngtemplate template (tedit.promptprint stream
(concat label ": 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")
" Start=" ng.start " TOC=" (cond
(ng.addtotoc
"Yes")
(t "No"))
(cond
((manualindex.enabled? window)
(cond
(ng.manualindex " ManIndex=Yes")
(t " ManIndex=No")))
(t "")))
t))))))
(change.ngroup.format.txtbefore
(lambda (label graphw ngroup.obj) (* |fsg| " 5-Aug-87 10:11")
(* * |Show| |and| |possibly| |reset| |the| |delimiter| |preceding| |this|
|NGroup.| |Return| nil |if| |nothing| |changed| |else| |return| |the| |new|
|delimiter.| i\f ngroup.obj |is| |non-NIL| |then| |we| |are| |working| |on|
|an| |inserted| |NGroup.| |Else| |we're| |working| |on| |the| |graph|
|prototype.|)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
new.delimiter)
(|with| ngtemplate (|fetch| (numberobj template) |of| (cond
(ngroup.obj (|fetch| objectdatum
|of| ngroup.obj))
(t (car (gethash label (
tsp.get.ngroup.array
window)))))
)
(and (setq new.delimiter (get.ngroup.delimiter stream label ng.text-before
'before))
(not (strequal new.delimiter ng.text-before))
(setq ng.text-before new.delimiter))))))
(change.ngroup.format.display
(lambda (label graphw ngroup.obj) (* |fsg| " 5-Aug-87 10:12")
(* * |Show| |and| |possibly| |reset| |how| |this| |NGroup| |is| |displayed.|
|Return| nil |if| |nothing| |changed| |else| |returm| |the| |new| |display|
|type.| i\f ngroup.obj |is| |non-NIL| |then| |we| |are| |working| |on| |an|
|inserted| |NGroup.| |Else| |we're| |working| |on| |the| |graph| |prototype.|)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
new.display)
(|with| ngtemplate (|fetch| (numberobj template) |of| (cond
(ngroup.obj (|fetch| objectdatum
|of| ngroup.obj))
(t (car (gethash label (
tsp.get.ngroup.array
window)))))
)
(tedit.promptprint stream (concat "\"" label "\" displayed as " ng.chartype
", change to...")
t)
(|until| (or (null (setq new.display
(menu (|create| menu
title ← "NGroup Displays"
centerflg ← t
items ← '(|Number| |Null String| uppercase\ letter
|lowercase letter| uppercase\ roman
|lowercase roman|)))))
(selectq new.display
((|Number| |Null String|)
t)
(igreaterp ng.start 0)))
|do| (tedit.promptprint stream (concat "Starting value (=" ng.start
") must be > 0 for \"" new.display
"\". Try again.")
t))
(tedit.promptprint stream "" t)
(and new.display (neq new.display ng.chartype)
(kwote (setq ng.chartype new.display)))))))
(change.ngroup.format.txtafter
(lambda (label graphw ngroup.obj) (* |fsg| " 5-Aug-87 10:12")
(* * |Show| |and| |possibly| |reset| |the| |delimiter| |following| |this|
|NGroup.| |Return| nil |if| |nothing| |changed| |else| |return| |the| |new|
|delimiter.| i\f ngroup.obj |is| |non-NIL| |then| |we| |are| |working| |on|
|an| |inserted| |NGroup.| |Else| |we're| |working| |on| |the| |graph|
|prototype.|)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
new.delimiter)
(|with| ngtemplate (|fetch| (numberobj template) |of| (cond
(ngroup.obj (|fetch| objectdatum
|of| ngroup.obj))
(t (car (gethash label (
tsp.get.ngroup.array
window)))))
)
(and (setq new.delimiter (get.ngroup.delimiter stream label ng.text-after
'after))
(not (strequal new.delimiter ng.text-after))
(setq ng.text-after new.delimiter))))))
(get.ngroup.delimiter
(lambda (stream label delimiter before/after) (* |fsg| "17-Aug-87 15:12")
(* * |Show| |and| |possibly| |reset| |the| |delimiter| |before/after| |this|
|NGroup.| |Return| nil |if| |nothing| |changed| |else| |return| |the| |new|
|delimiter.|)
(tedit.promptprint stream (concat "Delimiter " (selectq before/after
(before "preceding ")
"following ")
label "\" is " (cond
(delimiter (concat "\"" delimiter "\""))
(t '|Unspecified|))
", change to...")
t)
(prog1 (menu (|create| menu
title ← "NGroup Delimiters"
centerflg ← t
items ← '((|Period| ".")
(|Colon| ":")
(|Dash| "-")
(|Null String| "")
(|Other| (tedit.getinput stream (concat "Specify delimiter "
(selectq before/after
(before "preceding ")
"following ")
label ":"))))))
(tedit.promptprint stream "" t))))
(change.ngroup.format.abbrev
(lambda (label graphw ngroup.obj) (* |fsg| "26-Aug-87 11:48")
(* * |Change| |the| |display| |level| |of| \a |NGroup.|
|Let| |the| |user| |decide| |how| |far| |up| |the| |parent| |tree| |to| |go|
|wrt| |printing| |values.| |This| |allows| |user| |to| |number| |things| |as|
|2.a,| |b,| |c,| |etc.| |Thanks| |to| |Michael| |Wescoat| |at| |Xerox| |for|
|suggesting| |this.|)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow)))
(|with| numberobj (cond
(ngroup.obj (|fetch| objectdatum |of| ngroup.obj))
(t (car (gethash label (tsp.get.ngroup.array window)))))
(let ((parents (list.ancestors label nil window)))
(cond
(parents (tedit.promptprint stream (concat label (cond
(abbrev-val (concat
" abbreviation starts at "
abbrev-val))
(t " not abbreviated"))
". Select starting level.")
t)
(let ((new.abrev (menu (|create| menu
title ← (concat label " Levels")
items ← (append parents (list label))
centerflg ← t))))
(and new.abrev (neq new.abrev abbrev-val)
(true (setq abbrev-val (cond
((eq new.abrev (car parents))
nil)
(t new.abrev)))))))
(t (tedit.promptprint stream (concat "Cannot abbreviate top level NGroup \""
label "\"")
t))))))))
(change.ngroup.format.start
(lambda (label graphw) (* |fsg| " 9-Jul-87 15:45")
(* * |Show| |and| |possibly| |reset| |this| |NGroup's| |starting| |value.|
|Return| nil |if| |nothing| |changed| |else| |return| |the| |new| |starting|
|value.|)
(let ((window (windowprop graphw 'twindow))
new.start)
(|with| ngtemplate (|fetch| (numberobj template) |of| (car (gethash label (
tsp.get.ngroup.array
window))))
(and (setq new.start (get.ngroup.start label ng.chartype ng.start (windowprop
graphw
'tstream)))
(neq new.start ng.start)
(setq ng.start new.start))))))
(get.ngroup.start
(lambda (label display start stream) (* |fsg| "23-Jul-87 14:38")
(* * |Get| |the| |starting| |value| |for| |this| |NGroup.|
|Any| |value| |is| |ok| |for| \a |Number| |display| |but| |Letter/Roman|
|numeral| |values| |must| |be| |greater| |than| |zero.|)
(let ((prompt.string (concat "Starting value of \"" label "\" is " start))
new.start)
(|until| (or (null (setq new.start (mkatom (tedit.getinput stream (concat prompt.string
". New starting value:"
)))))
(cond
((not (fixp new.start))
(setq prompt.string (concat new.start " is not an integer"))
nil)
(t (selectq display
((|Number| |Null String|)
t)
(cond
((ileq new.start 0)
(setq prompt.string (concat "Start (=" new.start
") must be > 0 for \"" display "\""))
nil)
(t t)))))))
new.start)))
(change.ngroup.format.toc
(lambda (label graphw) (* |fsg| " 7-Jul-87 09:12")
(* * |Show| |and| |possibly| |reset| |whether| |this| |NGroup| |is| |included|
|in| |the| |Table-Of←Contents.| |Return| nil |if| |no| |change| |else| |return|
t.)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
new.addtotoc)
(|with| ngtemplate (|fetch| (numberobj template) |of| (car (gethash label (
tsp.get.ngroup.array
window))))
(tedit.promptprint stream (concat "\"" label "\" is " (cond
(ng.addtotoc "")
(t "NOT "))
"included in the TOC. Do you want it included?")
t)
(setq new.addtotoc (menu (|create| menu
title ← "In TOC?"
centerflg ← t
items ← '((yes t)
(no nil))
whenselectedfn ← (function (lambda (item)
item)))))
(tedit.promptprint stream "" t)
(and new.addtotoc (neq (cadr new.addtotoc)
ng.addtotoc)
(progn (setq ng.addtotoc (cadr new.addtotoc))
t))))))
(change.ngroup.format.manindex
(lambda (label graphw) (* |fsg| " 1-Sep-87 15:39")
(* * |Show| |and| |possibly| |reset| |whether| |this| |NGroup| |is| |included|
|in| |the| |manual| |index.| |Return| nil |if| |no| |change| |else| |return| t.)
(let ((stream (windowprop graphw 'tstream))
(window (windowprop graphw 'twindow))
new.manualindex)
(and (manualindex.enabled? window)
(|with| ngtemplate (|fetch| (numberobj template) |of| (car (gethash label (
tsp.get.ngroup.array
window))))
(tedit.promptprint stream (concat "\"" label "\" is " (cond
(ng.manualindex "")
(t "NOT"))
" included in the Manual Index. Do you want it included?"
)
t)
(setq new.manualindex (menu (|create| menu
title ← "Manual Index?"
centerflg ← t
items ← '((yes t)
(no nil))
whenselectedfn ← (function (lambda (item)
item)))))
(tedit.promptprint stream "" t)
(and new.manualindex (neq (cadr new.manualindex)
ng.manualindex)
(true (cond
((setq ng.manualindex (cadr new.manualindex))
(windowaddprop window 'manualgroups label))
(t (windowdelprop window 'manualgroups label))))))))))
(update.ngroup.manindex
(lambda (template label window) (* |ss:| "27-Jun-87 16:22")
(* * |Update| |the| |NGroup| |template| |list| |wrt| |the| |current| |NGroup|
|level.| |Note| |that| |when| \a |new| |NGroup| |is| |seen,| |all| |it's|
|children| |become| |undefined.| |Furthermore| |we| |know| |the| |NGroups|
|are| |in| |order| |since| |the| |order| |is| |verified| |when| |the| |NGroup|
|is| |inserted.|)
(and (manualindex.enabled? window)
(let* ((man.groups (windowprop window 'manualgroups))
(label.groups (memb label man.groups)))
(and label.groups (let* ((label.offset (add1 (idifference (length man.groups)
(length label.groups))))
(man.templates (windowprop window 'manualtemplates))
(template.sublist (nth man.templates label.offset)))
(cond
(template.sublist (rplnode template.sublist template))
(t (windowaddprop window 'manualtemplates template)))))))))
(ngroup.fixup.records
(lambda (ngroup.record copyflg) (* |fsg| " 3-Sep-87 15:35")
(* * |Function| |to| "fix up" |the| |NGroup| |record.|
|This| |allows| |us| |to| |expand| |the| |NGroup| |record| |and| |still|
|maintain| |backwatd| |compatability.| i\f copyflg |is| |non-NIL,| |we| |are|
|doing| \a copy. i\n |this| |case| |un-update| |the| |record;|
|Copied| |NGroups| |are| |always| |unupdated.|)
(let ((template (|fetch| (numberobj template) |of| ngroup.record)))
(|create| numberobj
ref.type ← (|fetch| (numberobj ref.type) |of| ngroup.record)
numstring ← (cond
(copyflg (selectq (|fetch| (numberobj use) |of| ngroup.record)
(ngroup (concat "[" (|fetch| (numberobj ref.type)
|of| ngroup.record)
"]"))
(note "Note#")
nil))
(t (|fetch| (numberobj numstring) |of| ngroup.record)))
use ← (|fetch| (numberobj use) |of| ngroup.record)
ngroup.mother ← (|fetch| (numberobj ngroup.mother) |of| ngroup.record)
template ← (|create| ngtemplate
ng.chartype ← (|fetch| (ngtemplate ng.chartype) |of| template)
ng.text-before ← (|fetch| (ngtemplate ng.text-before) |of| template
)
ng.text-after ← (|fetch| (ngtemplate ng.text-after) |of| template)
ng.start ← (|fetch| (ngtemplate ng.start) |of| template)
ng.addtotoc ← (|fetch| (ngtemplate ng.addtotoc) |of| template)
ng.currentval ← (cond
(copyflg nil)
(t (|fetch| (ngtemplate ng.currentval)
|of| template)))
ng.manualindex ← (|fetch| (ngtemplate ng.manualindex) |of| template
))
updated.obj ← (cond
(copyflg nil)
(t (|fetch| (numberobj updated.obj) |of| ngroup.record)))
text.after# ← (|fetch| (numberobj text.after#) |of| ngroup.record)
page.number ← (|fetch| (numberobj page.number) |of| ngroup.record)
font ← (|fetch| (numberobj font) |of| ngroup.record)
text.before# ← (|fetch| (numberobj text.before#) |of| ngroup.record)
abbrev-val ← (|fetch| (numberobj abbrev-val) |of| ngroup.record)))))
)
(* * |Table-of-Contents| |functions|)
(defineq
(get.ngroup.textstring
(lambda (nbrobj label stream window) (* |fsg| " 5-Aug-87 10:36")
(* * |Get| |the| |Table-Of-Contents| |before/after| |text| |string| |for|
|this| |NGroup.| |Because| |the| write.toc.file |function| |uses| \a |tab| |to|
|align| |the| |page| |numbers,| |any| |tabs| |in| |the| toc |strings| |are|
|converted| |to| |spaces.|)
(and (textbefore.enabled? window)
(let ((toc.string (tedit.getinput stream (concat "Text before " label ":")
(mkstring label))))
(and toc.string (|replace| (numberobj text.before#) |of| (|fetch| objectdatum
|of| nbrobj)
|with| (concat (convert.tabs.to.spaces toc.string)
" ")))))
(and (textafter.enabled? window)
(let ((toc.string (tedit.getinput stream (concat "Text after " label ":"))))
(and toc.string (|replace| (numberobj text.after#) |of| (|fetch| objectdatum
|of| nbrobj)
|with| (concat " " (convert.tabs.to.spaces toc.string))))))))
(convert.tabs.to.spaces
(lambda (string) (* |fsg| "10-Mar-87 11:01")
(* * |Returns| \a |string| |with| |all| |tabs| |converted| |to| |spaces.|
w\e |do| |this| |because| |some| |features| |like| |the| |Table-Of-Contents|
|use| \a |tab| |to| |align| |the| |page| |numbers.|)
(and (stringp string)
(mkstring (pack (|for| char |in| (unpack string) |collect| (cond
((eq char (character
(charcode tab)))
(character (charcode space)))
(t char))))))))
(create.toc.file
(lambda (stream window) (* |fsg| "16-Jul-87 11:46")
(* * |Here| |to| |print| |the| |Table| o\f |Contents.|
|Each| |Line| |of| |the| toc |consists| |of| |the| |NGroup,| |the|
|corresponding| |text,| |followed| |by| |the| |current| |listing| |page|
|number.|)
(let ((toc.list (tsp.list.of.objects (textobj window)
(function ngroup.toc.entries)))
(toc.file (get.toc.file (windowprop window 'imageobj.menuw)))
(toc.tabstop (list 'paralooks (list 'tabs (list nil (cons (fixr (times 72.27 6.125))
'dottedleft)))))
toc.stream)
(cond
((and toc.list toc.file)
(setq toc.stream (opentextstream nil nil nil nil toc.tabstop))
(tedit.promptprint stream (concat "Putting Table-Of-Contents into file " toc.file "...")
t)
(write.toc.file toc.stream toc.list window)
(tedit.promptprint stream "done")
(tedit.put toc.stream toc.file)
(closef? toc.file)
toc.file)
(toc.list (tedit.promptprint stream
"Specify a file name for the Table-Of-Contents first." t)
nil)
(t (tedit.promptprint stream "There are no NGroups included in the Table-Of-Contents." t)
nil)))))
(ngroup.toc.entries
(lambda (nbrobj) (* |fsg| "16-Jul-87 11:20")
(* * |Check| |if| nbrobj |is| \a |NGroup| |ImageObject| |and| |its| ng.addtotoc
|flag| |is| |on.|)
(and (ngroupp nbrobj)
(|fetch| (ngtemplate ng.addtotoc) |of| (|fetch| (numberobj template)
|of| (|fetch| objectdatum |of| nbrobj))))))
(view.toc.file
(lambda (stream window) (* |fsg| "12-Aug-87 16:36")
(* * |Writes| |out| |the| toc |file| |via| create.toc.file |and| |then| |opens|
|another| |TEdit| |window| |where| |this| |new| |file| |is| |displayed.|)
(let ((toc.file (create.toc.file stream window)))
(and toc.file (progn (or (windowprop window 'toc.window)
(windowprop window 'toc.window (createw nil (concat
"Viewing TOC file: "
toc.file))))
(tedit toc.file (windowprop window 'toc.window)))))))
(get.toc.file
(lambda (menuw) (* \; "Edited 29-Sep-87 15:17 by fsg")
(* * |Return| |the| |user| |specified| |Table-Of-Contents| |file| |name.|)
(let ((filename (fm.itemprop (fm.getitem 'toc.file nil menuw)
'label)))
(and (not (strequal filename ""))
(mkatom filename)))))
(write.toc.file
(lambda (toc.stream toc.list window) (* |fsg| "26-Aug-87 15:37")
(* * |Here| |to| |speficy| |the| |order| |of| |the| |Table-Of-Contents.|
|The| toc |is| |ordered| |by| |the| |top-level| |sister| |nodes.|)
(dspfont (fontcreate '(helvetica 14 brr))
toc.stream)
(printout toc.stream "Table of Contents" t)
(|for| toc.mother |in| (toplevel.sisters window)
|do| (dspfont |GP.DefaultFont| toc.stream)
(printout toc.stream t)
(|for| toc.item |in| toc.list |when| (|with| numberobj (|fetch| objectdatum
|of| (car toc.item))
(eq (get.ngroup.mother ref.type window)
toc.mother))
|do| (write.toc.entry toc.item toc.stream window)))))
(write.toc.entry
(lambda (toc.item toc.stream window) (* |fsg| "27-Jul-87 14:55")
(* * |Write| |one| |line| |to| |the| |Table-Of-Contents| |file.|)
(let* ((datum (|fetch| objectdatum |of| (car toc.item)))
(item.level (length (list.ancestors (|fetch| (numberobj ref.type) |of| datum)
nil window))))
(dspfont |GP.DefaultFont| toc.stream)
(cond
((zerop item.level)
(printout toc.stream t))
(t (rptq item.level (printout toc.stream " "))))
(dspfont (|fetch| (numberobj font) |of| datum)
toc.stream)
(printout toc.stream (concat (or (|fetch| (numberobj text.before#) |of| datum)
"")
(|fetch| (numberobj numstring) |of| datum)
(or (|fetch| (numberobj text.after#) |of| datum)
"")))
(dspfont |GP.DefaultFont| toc.stream)
(printout toc.stream (character (charcode tab))
(|fetch| (numberobj page.number) |of| datum)
t))))
)
(putprops tmax-ngroup copyright ("Xerox Corporation" 1987))
(declare\: dontcopy
(filemap (nil (1604 40075 (insert.ngroup 1614 . 3225) (verify.ngroup.order 3227 . 5020) (
get.previous.ngroups 5022 . 5391) (add.number.group 5393 . 7758) (add.ngroup.to.dbase 7760 . 8566) (
collect.ngroups 8568 . 9165) (list.font.props 9167 . 9435) (map.ngroup.looks 9437 . 10926) (
ngroup.getfont 10928 . 11578) (change.ngroup 11580 . 12281) (change.ngroup.font 12283 . 13741) (
show.ngroup.font 13743 . 14461) (change.ngroup.format 14463 . 16189) (show.ngroup.format 16191 . 18768
) (change.ngroup.format.txtbefore 18770 . 20309) (change.ngroup.format.display 20311 . 22959) (
change.ngroup.format.txtafter 22961 . 24495) (get.ngroup.delimiter 24497 . 26186) (
change.ngroup.format.abbrev 26188 . 28780) (change.ngroup.format.start 28782 . 29860) (
get.ngroup.start 29862 . 31334) (change.ngroup.format.toc 31336 . 33220) (
change.ngroup.format.manindex 33222 . 35562) (update.ngroup.manindex 35564 . 36860) (
ngroup.fixup.records 36862 . 40073)) (40120 47866 (get.ngroup.textstring 40130 . 41509) (
convert.tabs.to.spaces 41511 . 42375) (create.toc.file 42377 . 43901) (ngroup.toc.entries 43903 .
44375) (view.toc.file 44377 . 45172) (get.toc.file 45174 . 45572) (write.toc.file 45574 . 46576) (
write.toc.entry 46578 . 47864)))))
stop