2 # set the global variables
3 set nextId 0 ;# gets incremented before each use
5 set errorCount 0 ;# number of user errors
6 set warningCount 0 ;# number of user warnings
8 set havePartIntro 0 ;# need to emit a hometopic
10 set firstPInBlock 0 ;# allows a different SSI for first P
11 set inBlock "" ;# holds "</BLOCK>\n" when in a BLOCK
12 set inVirpage "" ;# holds "</VIRPAGE>\n" when in a VIRPAGE
13 set needFData "" ;# holds "<FDATA>\n" if needed (starting a FORM)
14 set inP 0 ;# flag that we're in an SDL paragraph
16 set formStack {} ;# need to stack FORMs when they contain others
18 set listStack {} ;# holds type of list and spacing for ListItem
20 # create some constants for converting list count to ordered label
21 set ROMAN0 [list "" I II III IV V VI VII VIII IX]
22 set ROMAN10 [list "" X XX XXX XL L LX LXX LXXX XC]
23 set ROMAN100 [list "" C CC CCC CD D DC DCC DCCC CM]
24 set roman0 [list "" i ii iii iv v vi vii viii ix]
25 set roman10 [list "" x xx xxx xl l lx lxx lxxx xc]
26 set roman100 [list "" c cc ccc cd d dc dcc dccc cm]
27 set ALPHABET [list "" A B C D E F G H I J K L M N O P Q R S T U V W X Y Z]
28 set alphabet [list "" a b c d e f g h i j k l m n o p q r s t u v w x y z]
29 set DIGITS [list 0 1 2 3 4 5 6 7 8 9]
30 set NZDIGITS [list "" 1 2 3 4 5 6 7 8 9]
32 # specify the "level" value to be given to VIRPAGEs (based on SSI);
33 # the indexes for this associative array are also used to determine
34 # whether the closing of a DocBook Title should re-position the
35 # snbLocation (because the SNB follows HEADs, if any)
36 set virpageLevels(FOOTNOTE) 0
37 set virpageLevels(TITLE) 0
38 set virpageLevels(AUTHORGROUP) 0
39 set virpageLevels(ABSTRACT) 0
40 set virpageLevels(REVHISTORY) 0
41 set virpageLevels(LEGALNOTICE) 0
42 set virpageLevels(PARTINTRO) 1
43 set virpageLevels(CHAPTER) 2
44 set virpageLevels(APPENDIX) 2
45 set virpageLevels(BIBLIOGRAPHY) 2
46 set virpageLevels(GLOSSARY) 2
47 set virpageLevels(INDEX) 2
48 set virpageLevels(LOT) 2
49 set virpageLevels(PREFACE) 2
50 set virpageLevels(REFENTRY) 2
51 set virpageLevels(REFERENCE) 2
52 set virpageLevels(TOC) 2
53 set virpageLevels(SECT1) 3
54 set virpageLevels(SECT2) 4
55 set virpageLevels(SECT3) 5
56 set virpageLevels(SECT4) 6
57 set virpageLevels(SECT5) 7
59 # assume the first ID used is SDL-RESERVED1 - if we get a INDEXTERM
60 # before anything has started, default to the assumed ID
61 set mostRecentId "SDL-RESERVED1"
63 # a counter for use in pre-numbering footnotes - will create an
64 # associative array indexed by "FOOTNOTE ID=" values to hold
65 # the number of the FOOTNOTE for use by FOOTNOTEREF
68 # the absolute byte offset into the output file where the SNB should be
69 # inserted by the second pass - the location and snb get saved at
70 # the end of each VIRPAGE with a little special handling for the
71 # SDLDOC SNB, the entire snb gets written to the .snb file at
72 # the close of the document after the saved locations get incremented
73 # by the size of the index
76 # normally, we dafault paragraphs to no TYPE= attribute; when in an
77 # EXAMPLE, for instance, we need to default to TYPE="LITERAL"
78 set defaultParaType ""
81 # print internal error message and exit
82 proc InternalError {what} {
89 # print a warning message
90 proc UserWarning {what location} {
93 puts stderr "DtDocBook User Warning: $what"
101 # print an error message plus the location in the source file of the
102 # error; if we get more than 100 errors, quit
103 proc UserError {what location} {
106 puts stderr "DtDocBook User Error: $what"
110 if {[incr errorCount] >= 100} {
111 puts stderr "Too many errors - quitting"
117 # set up a default output string routine so everything works even
118 # if run outside of instant(1)
119 if {[info commands OutputString] == ""} {
120 proc OutputString {string} {
121 puts -nonewline "$string"
126 # emit a string to the output stream
132 # push an item onto a stack (a list); return item pushed
133 proc Push {stack item} {
140 # pop an item from a stack (i.e., a list); return the popped item
145 InternalError "Stack underflow in Pop"
148 set item [lindex $s $top]
150 set s [lrange $s 0 $top]
155 # return the top of a stack (the stack is a list)
160 set item [lindex $s $top]
164 # replace the top of the stack with the new item; return the item
165 proc Poke {stack item} {
169 set s [lreplace $s $top $top $item]
174 # emit an ID and save it for reference as the most recently emitted ID;
175 # the saved value will be used to mark locations for index entries
179 set mostRecentId $name
180 return "ID=\"$name\""
184 # emit an ANCHOR into the SDL stream; if the passed id is empty, don't
188 Emit "<ANCHOR [Id $id]>"
193 # emit an ANCHOR into the SDL stream; if the passed id is empty, don't
194 # emit the anchor; if we're not in an SDL P yet, start one and use
195 # the id there rather than emitting an SDL ANCHOR
196 proc AnchorInP {id} {
201 StartParagraph $id "P" ""
203 Emit "<ANCHOR [Id $id]>"
209 # set up containers for the IDs of the blocks holding marks - clear
210 # on entry to each <virpage> but re-use within the <virpage> as much as
211 # possible; we need two each of the regular and loose versions because
212 # we need to alternate to avoid the <form> runtime code thinking we're
213 # trying to span columns
215 # specify a routine to (re-)initialize all the variables for use
217 proc ReInitPerMarkInfo {} {
218 global validMarkArray
220 foreach mark [array names validMarkArray] {
221 global FIRSTTIGHT${mark}Id
222 set FIRSTTIGHT${mark}Id ""
224 global FIRSTLOOSE${mark}Id
225 set FIRSTLOOSE${mark}Id ""
227 global TIGHT${mark}Id0
228 set TIGHT${mark}Id0 ""
230 global TIGHT${mark}Id1
231 set TIGHT${mark}Id1 ""
233 global LOOSE${mark}Id0
234 set LOOSE${mark}Id0 ""
236 global LOOSE${mark}Id1
237 set LOOSE${mark}Id1 ""
239 global TIGHT${mark}num
240 set TIGHT${mark}num 1
242 global LOOSE${mark}num
243 set LOOSE${mark}num 1
248 # add a new mark to the mark array and initialize all the variables
249 # that depend on the mark; the index for the mark is just the mark
250 # itself with the square brackets removed and whitespace deleted;
251 # we've already guaranteed that the mark will be of the form
252 # "[??????]" (open-square, 6 characters, close-square) and that this
253 # mark isn't in the array already
254 proc AddToMarkArray {mark} {
255 global validMarkArray
257 set m [string range $mark 1 6]
258 set m [string trim $m]
260 set validMarkArray($m) $mark
262 global FIRSTTIGHT${m}Id
263 set FIRSTTIGHT${m}Id ""
265 global FIRSTLOOSE${m}Id
266 set FIRSTLOOSE${m}Id ""
290 # start a new paragraph; start a block if necessary
291 proc StartParagraph {id ssi type} {
292 global inBlock firstPInBlock inP defaultParaType
294 # close any open paragraph
295 if {$inP} { Emit "</P>\n" }
297 # if not in a BLOCK, open one
298 if {$inBlock == ""} { StartBlock "" "" "" 1 }
301 if {$id != ""} { Emit " [Id $id]" }
303 # don't worry about whether we're the first para if there's no SSI
306 if {$firstPInBlock} {
312 Emit " SSI=\"$ssi$firstString\""
316 Emit $defaultParaType
318 Emit " TYPE=\"$type\""
324 set inBlock "</P>\n</BLOCK>\n"
328 # conditionally start a paragraph - that is, only start a new
329 # paragraph if we aren't in one already
330 proc StartParagraphMaybe {id ssi type} {
336 StartParagraph $id $ssi $type
341 # start a compound paragraph - a compound paragraph is when a Para
342 # contains some other element that requires starting its own SDL
343 # BLOCK or FORM, e.g., VariableList; we need to create a FORM to hold
344 # the Para and its parts - put the id and ssi on the FORM rather than
346 proc StartCompoundParagraph {id ssi type} {
350 if {$firstPInBlock} {
355 PushForm "" $ssi$firstString $id
360 StartParagraph "" "" ""
364 # given the path of parentage of an element, return its n'th ancestor
365 # (parent == 1), removing the child number (if any); e.g., convert
366 # "PART CHAPTER(0) TITLE" into "CHAPTER" if level is 2
367 proc Ancestor {path level} {
368 if {$level < 0} { return "_UNDERFLOW_" }
370 set last [llength $path]
373 if {$level > $last} { return "_OVERFLOW_" }
375 # invert "level" about "last" so we count from the end
376 set level [expr "$last - $level"]
378 set parent [lindex $path $level]
379 set parent [lindex [split $parent "("] 0] ;# remove child #
383 # start a HEAD element for the DocBook Title - use the parent's
384 # GI in the SSI= of the HEAD except that all titles to things in
385 # their own topic (VIRPAGE) will use an SSI of CHAPTER-TITLE;
386 # if we are in a topic with a generated id (e.g., _glossary or
387 # _title), we might have saved an id or two in savedId to be
388 # emitted in the HEAD
389 proc Title {id parent} {
390 global virpageLevels partID inP savedId
398 # if we are the Title of a PartIntro, we'd like to emit the
399 # partID as an anchor so linking to the volume will succeed;
400 # add it to the list of saved ids to be emitted
401 if {$parent == "PARTINTRO"} {
402 lappend savedId $partID
405 # make the HEAD for all topics (VIRPAGE) have an SSI of
406 # "CHAPTER-HEAD", use LEVEL to distinguish between them
407 set topicNames [array names virpageLevels]
408 foreach name $topicNames {
409 if {$parent == $name} {
415 Emit " SSI=\"$parent-TITLE\">"
417 # being in a HEAD is equivalent to being in a P for content model
418 # but we use "incr" instead of setting inP directly so that if we
419 # are in a P->HEAD, we won't prematurely clear inP when leaving
423 if {[info exists savedId]} {
424 foreach id $savedId {
432 # close a HEAD element for a DocBook Title - if the Title is one for
433 # a DocBook element that gets turned into an SDL VIRPAGE, set the
434 # location for the insertion of an SNB (if any) to follow the HEAD
435 proc CloseTitle {parent} {
436 global snbLocation virpageLevels inP
440 # we incremented inP on entry to the HEAD so decrement it here
443 # get a list of DocBook elements that start VIRPAGEs
444 set names [array names virpageLevels]
446 # add the start of the help volume, PART, to the list
449 # if our parent is a VIRPAGE creator or the start of the document,
450 # we must be dealing with the heading of a VIRPAGE or with the
451 # heading of the SDLDOC so move the spot where we want to include
452 # the SNB to immediately after this HEAD
453 foreach name $names {
454 if {$name == $parent} {
455 set snbLocation [tell stdout]
462 # open an SGML tag - add punctuation as guided by the class attribute
463 proc StartSgmlTag {id class} {
465 ELEMENT {set punct "&<"}
466 ATTRIBUTE {set punct ""}
467 GENENTITY {set punct "&&"}
468 PARAMENTITY {set punct "%"}
474 # close an SGML tag - add punctuation as guided by the class attribute
475 proc EndSgmlTag {class} {
477 ELEMENT {set punct ">"}
478 ATTRIBUTE {set punct ""}
479 GENENTITY {set punct ";"}
480 PARAMENTITY {set punct ";"}
486 # end a trademark, append a symbol if needed
487 proc EndTradeMark {class} {
489 SERVICE {set punct ""}
490 TRADE {set punct "<SPC NAME=\"\[trade \]\">"}
491 REGISTERED {set punct "<SPC NAME=\"\[reg \]\">"}
492 COPYRIGHT {set punct "<SPC NAME=\"\[copy \]\">"}
498 # handle the BridgeHead tag; emit a FORM to hold a HEAD and put the
499 # BridgeHead there - use the procedure Title to do all the work, the
500 # renderas attributre simply become the parent to Title
501 proc StartBridgeHead {id renderas} {
504 # default renderas to CHAPTER - arbitrarily
505 if {$renderas == "OTHER"} {
512 # end a BridgeHead; we need to close out the SDL HEAD and close the
513 # FORM - use CloseTitle to close out the HEAD but give it a null
514 # parent so it doesn't try to save the SNB now
515 proc EndBridgeHead {} {
522 proc EndParagraph {} {
529 # we set inBlock to </P></BLOCK> in StartParagraph so we need
530 # to remove the </P> here; if we're continuing a paragraph
531 # inBlock will have been set to "" when we closed the BLOCK to
532 # open the embedded FORM so we need to leave it empty to cause
533 # a new BLOCK to be opened
534 if {$inBlock != ""} {
535 set inBlock "</BLOCK>\n"
538 # and flag that we're not in a paragraph anymore
543 # continue a PARA that was interrupted by something from %object.gp;
544 # first pop the FORM that held the indent attributes for the object
545 # then start a new paragraph with an SSI that indicates we are
547 proc ContinueParagraph {} {
549 StartParagraph "" "P-CONT" ""
553 # start a new BLOCK element; close the old one, if any;
554 # return the ID in case we allocated one and someone else wants it
555 proc StartBlock {class ssi id enterInForm} {
556 global needFData inBlock formStack nextId firstPInBlock inP
558 # if we are the first BLOCK in a FORM, emit the FDATA tag
559 Emit $needFData; set needFData ""
561 # close any open block and flag that we're opening one
562 # but that we haven't seen a paragraph yet
564 set inBlock "</BLOCK>\n"
567 # if a FORM is in progress, add our ID to the row vector,
568 # FROWVEC - create an ID if one wasn't provided
569 if {$enterInForm && [llength $formStack] != 0} {
570 if {$id == ""} { set id "SDL-RESERVED[incr nextId]" }
576 if {$id != ""} { Emit " [Id $id]" }
577 if {$class != ""} { Emit " CLASS=\"$class\"" }
578 if {$ssi != ""} { Emit " SSI=\"$ssi\"" }
581 # and flag that the next paragraph is the first in a block
588 # close any open BLOCK - no-op if not in a BLOCK otherwise emit the
589 # BLOCK etag or both BLOCK and P etags if there's an open paragraph
593 if {$inBlock != ""} {
594 Emit $inBlock ;# has been prefixed with </P> if needed
601 # add another FROWVEC element to the top of the form stack
602 proc AddRowVec {ids} {
605 Push formStack "[Pop formStack]<FROWVEC CELLS=\"$ids\">\n"
609 # start a new FORM element within a THead, TBody or TFoot ("push"
610 # because they're recursive); return the ID in case we allocated one;
611 # do not enter the ID in the parent's FROWVEC, we'll do that later
612 # from the rowDope that we build to compute horizontal spans and
614 proc PushFormCell {ssi id} {
615 global needFData formStack nextId
617 Emit $needFData ;# in case we're the first in an old FORM
618 set needFData "<FDATA>\n" ;# and were now starting a new FORM
620 # close any open BLOCK
623 # make sure we have an ID
624 if {$id == ""} { set id "SDL-RESERVED[incr nextId]" }
626 # add a new (empty) string to the formStack list (i.e., push)
630 if {$id != ""} { Emit " [Id $id]" }
631 Emit " CLASS=\"CELL\""
632 if {$ssi != ""} { Emit " SSI=\"$ssi\"" }
639 # start a new FORM element ("push" because they're recursive);
640 # return the ID in case we allocated one
641 proc PushForm {class ssi id} {
642 global needFData formStack nextId
644 Emit $needFData ;# in case we're the first in an old FORM
645 set needFData "<FDATA>\n" ;# and were now starting a new FORM
647 # close any open BLOCK
650 if {[llength $formStack] != 0} {
651 # there is a <form> in progress
652 if {$id == ""} { set id "SDL-RESERVED[incr nextId]" }
656 # add a new (empty) string to the formStack list (i.e., push)
660 if {$id != ""} { Emit " [Id $id]" }
661 if {$class != ""} { Emit " CLASS=\"$class\"" }
662 if {$ssi != ""} { Emit " SSI=\"$ssi\"" }
669 # start a new FORM element to hold a labeled list item ("push"
670 # because they're recursive), adding it to an already open two
671 # column FORM, if any; we assume the first ID is the block holding
672 # the label and always defined on entry but we return the second
673 # ID in case we allocated one
674 proc PushFormItem {ssi id1 id2} {
675 global needFData formStack nextId
677 Emit $needFData ;# in case we're the first in an old FORM
678 set needFData "<FDATA>\n" ;# and were now starting a new FORM
680 # close any open BLOCK
683 if {$id2 == ""} { set id2 "SDL-RESERVED[incr nextId]" }
685 if {[llength $formStack] != 0} {
686 # there is a <form> in progress
687 if {$id2 == ""} { set id2 "SDL-RESERVED[incr nextId]" }
688 AddRowVec "$id1 $id2"
691 # add a new (empty) string to the formStack list (i.e., push)
694 Emit "<FORM [Id $id2] CLASS=\"ITEM\""
695 if {$ssi != ""} { Emit " SSI=\"$ssi\"" }
702 # close out a THead, TBody or TFoot; create the FROWVEC from the
703 # rowDope - save it if we aren't popping the FORM yet (which happens
704 # if no ColSpec elements were given at the THead or TFoot level and
705 # we're merging one, the other or both with the TBody), emit the
706 # saved ROWVEC, if any, and newly created one if we are popping the
707 # FORM in which case we also want to blow away the top of the
708 # formStack; we can also blow away the current rowDope here since
709 # we write or save the FROWVEC and we're done with the dope vector
710 proc PopTableForm {parent gi popForm} {
713 # get the proper row descriptor(s) and number of columns
714 if {$parent == "ENTRYTBL"} {
715 upvar #0 entryTableRowDope rowDope
716 upvar #0 entryTableSavedFRowVec fRowVec
717 global entryTableAttributes
718 set nCols $entryTableAttributes(cols)
720 upvar #0 tableGroupRowDope rowDope
721 upvar #0 tableGroupSavedFRowVec fRowVec
722 global tableGroupAttributes
723 set nCols $tableGroupAttributes(cols)
726 # flush the unused formStack entry if we're actually popping
731 # determine whether we are a "header", i.e., inside a TFoot or
733 if {$gi == "TBODY"} {
736 set hdr " HDR=\"YES\""
739 # if actually popping the FORM here (i.e., writing the FSTYLE),
740 # emit the FSTYLE wrapper
742 Emit "</FDATA>\n<FSTYLE"
744 Emit " NCOLS=\"$nCols\""
749 set nRows $rowDope(nRows)
750 while {$currentRow <= $nRows} {
751 append fRowVec "<FROWVEC$hdr CELLS=\""
752 append fRowVec $rowDope(row$currentRow)
753 append fRowVec "\">\n"
757 # if actually popping the FORM here (i.e., writing the FSTYLE),
758 # emit the FROWVEC elements, zero out the saved fRowVec and close
763 Emit "</FSTYLE>\n</FORM>\n"
768 # close out one FORM on the stack; if there hasn't been a block added
769 # to the FORM, create an empty one to make it legal SDL
773 if {[Peek formStack] == ""} {
774 # oops, empty FROWVEC means empty FORM so add an empty BLOCK
775 StartBlock "" "" "" 1
778 # close any open BLOCK
781 # write out the saved FROWVEC information wrapped in an FSTYLE
782 set openStyle "</FDATA>\n<FSTYLE>\n"
783 set closeStyle "</FSTYLE>\n</FORM>"
784 Emit "$openStyle[Pop formStack]$closeStyle\n"
788 # close out one N columned FORM on the stack; if there hasn't been a
789 # block added to the FORM, create an empty one to make it legal SDL
790 proc PopFormN {nCols} {
793 if {[Peek formStack] == ""} {
794 # oops, empty FROWVEC means empty FORM so add an empty BLOCK
795 # and bring this down to a single column FORM containing only
797 StartBlock "" "" "" 1
801 # close any open BLOCK
804 # write out the saved FROWVEC information wrapped in an FSTYLE
805 set openStyle "</FDATA>\n<FSTYLE NCOLS=\"$nCols\">\n"
806 set closeStyle "</FSTYLE>\n</FORM>"
807 Emit "$openStyle[Pop formStack]$closeStyle\n"
811 # check the Role attribute on lists to verify that it's either "LOOSE"
812 # or "TIGHT"; return upper cased version of verified Role
813 proc CheckSpacing {spacing} {
814 set uSpacing [string toupper $spacing]
817 TIGHT {return $uSpacing}
819 UserError "Bad value (\"$role\") for Role attribute in a list" yes
824 # start a simple list - if Type is not INLINE, we need to save the
825 # Ids of the BLOCKs we create and lay them out in a HORIZONTAL or
826 # VERTICAL grid when we have them all
827 proc StartSimpleList {id type spacing parent} {
828 global listStack firstString
830 if {$type == "INLINE"} {
831 StartParagraphMaybe $id P ""
833 # if we are inside a Para, we need to issue a FORM to hang the
834 # indent attributes on
835 if {$parent == "PARA"} {
836 PushForm "" "INSIDE-PARA" ""
839 # insure "spacing" is upper case and valid (we use it in the SSI)
840 set spacing [CheckSpacing $spacing]
842 # save the list type and spacing for use by <Member>;
843 set listDope(type) simple
844 set listDope(spacing) $spacing
845 Push listStack [array get listDope]
847 PushForm LIST SIMPLE-$spacing $id
848 set firstString "FIRST-"
853 # end a simple list - if Type was INLINE, we're done, otherwise, we
854 # need to lay out the grid based on Type and Columns
855 proc EndSimpleList {columns type parent} {
856 global listStack lastList listMembers
859 UserWarning "must have at least one column in a simple list" yes
863 if {$type != "INLINE"} {
864 # get the most recently opened list and remove it from the stack
865 array set lastList [Pop listStack]
867 # calculate the number of rows and lay out the BLOCK ids
868 # as per the type attribute
869 set length [llength $listMembers]
870 set rows [expr ($length + $columns - 1) / $columns]
874 if {$type == "HORIZ"} {
877 set ids [lrange $listMembers $c [incr c $cols]]
883 set lastRowLength [expr $cols - (($rows * $cols) - $length)]
885 while {$r <= $rows} {
890 set cols $lastRowLength
893 lappend ids [lindex $listMembers $i]
895 if {$c < $lastRowLength} {
906 # close the open FORM using the newly generated ROWVECs
909 # if we are inside a Para, we need to close the FORM we issued for
910 # hanging the indent attributes
911 if {$parent == "PARA"} {
918 # collect another Member of a SimpleList; if we're a Vert(ical) or
919 # Horiz(ontal) list, don't put the BLOCK's id on the list's FORM
920 # yet - we need to collect them all and lay them out afterward in
921 # EndSimpleList; if we're an Inline list, don't create a BLOCK, we'll
922 # add punctuation to separate them in EndMember
923 proc StartMember {id type} {
924 global nextId listStack firstString listMembers
926 if {$type == "INLINE"} {
929 # put it in a BLOCK, make sure we have an id and add it to
930 # the list of members
932 set id SDL-RESERVED[incr nextId]
934 lappend listMembers $id
936 # get the current list info
937 array set listTop [Peek listStack]
938 set spacing $listTop(spacing)
940 # use an SSI of, e.g., FIRST-LOOSE-SIMPLE
941 StartBlock ITEM $firstString$spacing-SIMPLE $id 0
942 StartParagraph "" P ""
948 # end a SimpleList Member; if it's an Inline list, emit the
949 # punctuation ("", ", " or "and") based on the position of the
950 # Member in the list - otherwise, do nothing and the StartBlock from
951 # the next Member or the PopFormN in EndSimpleList will close the
953 proc EndMember {type punct} {
954 if {$type == "INLINE"} {
960 # check the value of a ITEMIZEDLIST MARK - issue warning and default
961 # it to BULLET if it's unrecognized
962 proc ValidMark {mark} {
963 global validMarkArray
965 if {[string toupper $mark] == "PLAIN"} { return PLAIN }
967 # if an SDATA entity was used, it'll have spurious "\|" at the
968 # beginning and the end added by [n]sgmls
969 if {[string match {\\|????????\\|} $mark]} {
970 set mark [string range $mark 2 9]
973 if {![string match {\[??????\]} $mark]} {
974 UserError "Unknown list mark \"$mark\" specified, using PLAIN" yes
977 foreach m [array names validMarkArray] {
978 if {$validMarkArray($m) == $mark} {return $m}
980 return [AddToMarkArray $mark]
985 # start an itemized list
986 proc ItemizedList {id mark spacing parent} {
987 global listStack firstString
989 # if we are inside a Para, we need to issue a FORM to hang the
990 # indent attributes on
991 if {$parent == "PARA"} {
992 PushForm "" "INSIDE-PARA" ""
995 # make sure we recognize the mark
996 set mark [ValidMark $mark]
998 # insure "spacing" is upper case and valid (we use it in the SSI)
999 set spacing [CheckSpacing $spacing]
1001 # save the list type, mark and spacing for use by <ListItem>
1002 set listDope(type) itemized
1003 set listDope(spacing) $spacing
1004 set listDope(mark) $mark
1005 Push listStack [array get listDope]
1007 # create a FORM to hold the list items
1008 if {$mark == "PLAIN"} {
1009 PushForm LIST "PLAIN-$spacing" $id
1011 PushForm LIST "MARKED-$spacing" $id
1014 set firstString "FIRST-"
1018 # turn absolute item count into proper list number e.g., 2, B, or II
1019 proc MakeOrder {numeration count} {
1020 global ROMAN0 ROMAN10 ROMAN100
1021 global roman0 roman10 roman100
1022 global ALPHABET alphabet
1023 global NZDIGITS DIGITS
1025 if {$count == ""} { return "" }
1027 if {$count > 999} { set count 999 } ;# list too big - cap it
1029 # initialize the 3 digits of the result value
1034 # first get the 3 digits in the proper base (26 or 10)
1035 switch -exact $numeration {
1038 set c3 [expr "$count % 26"]
1039 if {$c3 == 0} { set c3 26 }
1040 if {[set count [expr "$count / 26"]]} {
1041 set c2 [expr "$count % 26"]
1042 if {$c2 == 0} { set c2 26 }
1043 set c1 [expr "$count / 26"]
1049 set c3 [expr "$count % 10"]
1050 if {[set count [expr "$count / 10"]]} {
1051 set c2 [expr "$count % 10"]
1052 if {[set count [expr "$count / 10"]]} {
1053 set c1 [expr "$count % 10"]
1059 # then point to proper conversion list(s)
1060 switch -exact $numeration {
1062 set c1List $ALPHABET
1063 set c2List $ALPHABET
1064 set c3List $ALPHABET
1067 set c1List $alphabet
1068 set c2List $alphabet
1069 set c3List $alphabet
1074 set c1List $ROMAN100
1079 set c1List $roman100
1086 set c1List $NZDIGITS
1088 set c2List $NZDIGITS
1094 # and do the conversion
1095 set string [lindex $c1List $c1]
1096 append string [lindex $c2List $c2]
1097 append string [lindex $c3List $c3]
1104 # start an ordered list
1105 proc OrderedList {id numeration inheritNum continue spacing parent} {
1106 global listStack lastList firstString
1108 # if we are inside a Para, we need to issue a FORM to hang the
1109 # indent attributes on
1110 if {$parent == "PARA"} {
1111 PushForm "" "INSIDE-PARA" ""
1114 # make sure the INHERIT param is compatible with enclosing list
1115 if {$inheritNum == "INHERIT"} {
1116 if {[llength $listStack] > 0} {
1117 array set outerList [Peek listStack]
1118 if {$outerList(type) != "ordered"} {
1119 UserError "Can only inherit numbering from an ordered list" yes
1120 set inheritNum IGNORE
1124 "Attempt to inherit a list number with no previous list" yes
1125 set inheritNum IGNORE
1129 # make sure the CONTINUE param is compatible with previous list;
1130 # also inherit numeration here if unset (else error if different)
1131 # and we're continuing
1132 if {$continue == "CONTINUES"} {
1133 if {![array exists lastList]} {
1134 # nothing to inherit from
1135 UserError "Attempt to continue a list with no previous list" yes
1136 set continue RESTARTS
1137 } elseif {$lastList(type) != "ordered"} {
1138 UserError "Only ordered lists can be continued" yes
1139 set continue RESTARTS
1140 } elseif {$numeration == ""} {
1141 set numeration $lastList(numeration)
1142 } elseif {$lastList(numeration) != $numeration} {
1143 UserError "Can't continue a list with different numeration" yes
1144 set continue RESTARTS
1148 # if no numeration specified, default to Arabic
1149 if {$numeration == ""} {
1150 set numeration ARABIC
1153 set count 0 ;# assume we are restarting the item count
1154 set inheritString "" ;# fill in later if set
1156 if {$continue == "CONTINUES"} {
1157 # continuing means use the old inherit string (if any) and
1158 # pick up with the old count
1159 set count $lastList(count)
1160 if {($lastList(inheritString) != "") && ($inheritNum != "INHERIT")} {
1162 "Must continue inheriting if continuing list numbering" yes
1163 set inheritNum INHERIT
1167 if {$inheritNum == "INHERIT"} {
1168 # inheriting a string to preface the current number - e.g., "A.1."
1169 set inheritString $outerList(inheritString)
1170 append inheritString \
1171 [MakeOrder $outerList(numeration) $outerList(count)]
1174 # insure "spacing" is upper case and valid (we use it in the SSI)
1175 set spacing [CheckSpacing $spacing]
1177 # save the list type and spacing for use by <ListItem>
1178 set listDope(type) ordered
1179 set listDope(spacing) $spacing
1180 set listDope(numeration) $numeration
1181 set listDope(inheritString) $inheritString
1182 set listDope(count) $count
1183 Push listStack [array get listDope]
1185 # create a FORM to hold the list items
1186 PushForm LIST "ORDER-$spacing" $id
1188 set firstString "FIRST-"
1192 # start a variable list (i.e., labeled list)
1193 proc VariableList {id role parent} {
1194 global listStack firstString
1196 # if we are inside a Para, we need to issue a FORM to hang the
1197 # indent attributes on
1198 if {$parent == "PARA"} {
1199 PushForm "" "INSIDE-PARA" ""
1202 # parse out the possible role values (loose/tight and
1204 set role [split [string toupper $role]]
1205 set role1 [lindex $role 0]
1207 set length [llength $role]
1209 set role2 [lindex $role 1]
1212 UserError "Too many values (> 2) for Role in a VARIABLELIST" yes
1218 TIGHT {set spacing $role1}
1220 NOWRAP {set wrap $role1}
1221 default {UserError "Bad value for Role ($role1) in a VARIABLELIST" yes
1227 TIGHT {if {$spacing == ""} {
1230 UserError "Only specify LOOSE/TIGHT once per Role" yes
1234 NOWRAP {if {$wrap == ""} {
1237 UserError "Only specify WRAP/NOWRAP once per Role" yes
1240 default {UserError "Bad value for Role ($role2) in a VARIABLELIST" yes
1243 if {$spacing == ""} {
1250 # insure "spacing" is upper case and valid (we use it in the SSI)
1251 set spacing [CheckSpacing $spacing]
1253 # save the list type and spacing for use by <ListItem>;
1254 # also save a spot for the current label ID
1255 set listDope(type) variable
1256 set listDope(spacing) $spacing
1257 set listDope(labelId) $id
1258 set listDope(wrap) $wrap
1259 Push listStack [array get listDope]
1261 # create a FORM to hold the list items
1262 PushForm LIST "VARIABLE-$spacing" $id
1264 set firstString "FIRST-"
1268 # open a variable list entry - create a BLOCK to hold the term(s)
1269 proc VarListEntry {id} {
1270 global firstString listStack nextId
1272 # get the list spacing, i.e., TIGHT or LOOSE
1273 array set listDope [Peek listStack]
1274 set spacing $listDope(spacing)
1276 # make sure we have an ID for the label (it goes in a FORM)
1277 # save the ID for use in PushFormItem
1279 set id SDL-RESERVED[incr nextId]
1281 array set listDope [Pop listStack]
1282 set listDope(labelId) $id
1283 Push listStack [array get listDope]
1285 StartBlock ITEM "$firstString$spacing-TERMS" $id 0
1288 # process a term in a variablelist
1289 proc StartTerm {id} {
1292 # get the current list info
1293 array set listTop [Peek listStack]
1294 set wrap $listTop(wrap)
1297 if {$wrap == "NOWRAP"} {
1301 StartParagraph $id "P" $lined
1305 # process an item in an ordered, variable or itemized list
1306 proc ListItem {id override} {
1307 global listStack firstString nextId needFData validMarkArray
1309 # get the current list info
1310 array set listTop [Peek listStack]
1311 set spacing $listTop(spacing)
1313 # if it's an itemized list, are we overriding the mark?
1314 if {$listTop(type) == "itemized"} {
1315 if {$override == "NO"} {
1316 set mark $listTop(mark)
1317 } elseif {$override == ""} {
1320 set mark [ValidMark $override]
1324 if {($listTop(type) == "itemized") && ($mark != "PLAIN")} {
1325 # marked itemized list, try to reuse an existing mark <BLOCK>
1326 if {$firstString == ""} {
1327 # not a FIRST, calculate the next id index - we flip
1328 # between 0 and 1 to avoid column span in viewer
1329 set numName $spacing${mark}num ;# get index name
1330 upvar #0 $numName idNum
1331 set idNum [expr "-$idNum + 1"] ;# flip it
1333 if {$firstString != ""} {
1334 set idName FIRST$spacing${mark}Id
1336 set idName $spacing${mark}Id$idNum
1338 upvar #0 $idName labelId
1339 if {$labelId == ""} {
1340 # need to create a <BLOCK> and save the id
1341 set labelId "SDL-RESERVED[incr nextId]"
1342 Emit $needFData; set needFData ""
1343 Emit "<BLOCK [Id $labelId] CLASS=\"ITEM\""
1344 Emit " TIMING=\"ASYNC\" "
1345 Emit "SSI=\"$firstString$spacing-MARKED\""
1346 Emit ">\n<P SSI=\"P1\"><SPC NAME=\"$validMarkArray($mark)\""
1347 Emit "></P>\n</BLOCK>\n"
1351 # emit the SSI and label for an ordered list
1352 if {$listTop(type) == "ordered"} {
1353 # start a block for the label
1354 set labelId "SDL-RESERVED[incr nextId]"
1355 Emit $needFData; set needFData ""
1356 Emit "<BLOCK [Id $labelId] CLASS=\"ITEM\" SSI=\""
1358 # create, e.g., FIRST-LOOSE-ORDERED
1359 Emit "$firstString$spacing-ORDERED\">\n"
1361 # emit the label (inherit string followed by order string)
1362 # and close the block
1363 Emit "<P SSI=\"P1\">"
1364 Emit $listTop(inheritString)
1365 Emit [MakeOrder $listTop(numeration) [incr listTop(count)]]
1366 Emit "</P>\n</BLOCK>\n"
1368 # then update the top of the list stack
1369 Poke listStack [array get listTop]
1372 # or just get the label id for a variable (labeled) list - the
1373 # label was emitted in another production
1374 if {$listTop(type) == "variable"} {
1375 set labelId $listTop(labelId)
1378 # emit a one (for PLAIN) or two column FORM to wrap this list item
1379 set ssi "$firstString$spacing"
1380 if {($listTop(type) == "itemized") && ($mark == "PLAIN")} {
1381 PushForm ITEM $ssi $id
1383 PushFormItem $ssi $labelId $id
1389 # start a segmented list, e.g.,
1395 proc SegmentedList {id spacing parent} {
1396 global listStack firstString
1398 # if we are inside a Para, we need to issue a FORM to hang the
1399 # indent attributes on
1400 if {$parent == "PARA"} {
1401 PushForm "" "INSIDE-PARA" ""
1404 # insure "spacing" is upper case and valid (we use it in the SSI)
1405 set spacing [CheckSpacing $spacing]
1407 # save the list type and spacing for use by <ListItem>;
1408 set listDope(type) segmented
1409 set listDope(spacing) $spacing
1410 Push listStack [array get listDope]
1412 # create a FORM to hold the list items
1413 PushForm LIST "SEGMENTED-$spacing" $id
1415 set firstString "FIRST-"
1418 # emit the SegTitle elements, each in its own BLOCK - we'll reuse
1419 # them on each Seg of each SegListItem
1420 proc StartSegTitle {id} {
1421 global firstString listStack segTitleList nextId
1423 # get the list spacing, i.e., TIGHT or LOOSE
1424 array set listDope [Peek listStack]
1425 set spacing $listDope(spacing)
1427 # make sure we have an ID for the label (it goes in a FORM)
1428 # save the ID for use in PushFormItem
1430 set id SDL-RESERVED[incr nextId]
1432 lappend segTitleList $id
1434 # start the block but don't put in on the FORM, we'll put this
1435 # BLOCK and the one containing the SegListItem.Seg into a two
1437 StartBlock ITEM "$firstString$spacing-SEGTITLE" $id 0
1440 StartParagraph "" SEGTITLE ""
1444 # start a SegListItem - save the id (if any) of the SegListItem to
1445 # be emitted as an anchor in the first Seg
1446 proc StartSegListItem {id} {
1447 global segListItemNumber segListItemId firstString
1449 set segListItemId $id
1450 set segListItemNumber 0
1451 set firstString "FIRST-"
1455 # process a Seg in a SegListItem - get the corresponding SegTitle ID
1456 # and create a BLOCK for the item then put the pair into the FORM that
1457 # was created back in SegmentedList
1458 proc StartSeg {id isLastSeg} {
1459 global segTitleList segListItemNumber segListItemId firstString
1460 global listStack nextId
1462 set nTitles [llength $segTitleList]
1463 if {$segListItemNumber >= $nTitles} {
1465 "More Seg than SegTitle elements in a SegmentedList" yes
1469 if {[expr "$segListItemNumber" + 1] != $nTitles} {
1471 "More SegTitle than Seg elements in a SegmentedList" yes
1475 # get the current list info
1476 array set listTop [Peek listStack]
1477 set spacing $listTop(spacing)
1479 # open a BLOCK and P to hold the Seg content; put any user
1480 # supplied Id on the BLOCK and the saved segListItem Id (if
1484 set itemId "SDL-RESERVED[incr nextId]"
1486 StartBlock ITEM $firstString$spacing $itemId 0
1488 StartParagraph $segListItemId P ""
1489 set segListItemId ""
1491 # we've already guaranteed that we don't overflow the list
1492 set titleId [lindex $segTitleList $segListItemNumber]
1493 incr segListItemNumber
1495 # add the title and item to a row vector (FROWVEC)
1496 AddRowVec "$titleId $itemId"
1501 proc EndList {parent} {
1502 global listStack lastList
1504 # get the most recently opened list and remove it from the stack
1505 array set lastList [Pop listStack]
1507 if {($lastList(type) == "itemized") && ($lastList(mark) == "PLAIN") } {
1513 # if we are inside a Para, we need to close the FORM we issued for
1514 # hanging the indent attributes
1515 if {$parent == "PARA"} {
1521 # start a super- or sub-scripted phrase; if there's an ID, emit the
1522 # anchor before the SPHRASE
1523 proc StartSPhrase {id gi} {
1526 SUPERSCRIPT {set type SUPER}
1527 SUBSCRIPT {set type SUB}
1530 Emit "<KEY CLASS=\"EMPH\" SSI=\"SUPER-SUB\"><SPHRASE CLASS=\"$type\">"
1533 # end a super- or sub-scripted phrase
1534 proc EndSPhrase {} {
1535 Emit "</SPHRASE></KEY>"
1539 # start an admonition (note/caution/warning/tip/important),
1540 # emit a FORM to hold it and the HEAD for the icon (if any);
1541 # if the admonition has no Title, emit one using the GI of the
1542 # admonition; map Tip to Note and Important to Caution
1543 proc StartAdmonition {id gi haveTitle} {
1544 PushForm "" ADMONITION $id
1549 TIP {set icon "graphics/noteicon.pm"}
1551 IMPORTANT {set icon "graphics/cauticon.pm"}
1552 WARNING {set icon "graphics/warnicon.pm"}
1554 set snbId [AddToSNB GRAPHIC $icon]
1556 # emit the icon wrapped in a head for placement
1557 Emit "<HEAD SSI=\"ADMONITION-ICON\"><SNREF>"
1558 Emit "<REFITEM RID=\"$snbId\" CLASS=\"ICON\"></REFITEM>\n"
1559 Emit "</SNREF></HEAD>"
1561 # emit a title if none provided
1563 Emit "<HEAD SSI=\"ADMONITION-TITLE\">$gi</HEAD>\n"
1568 # start a Procedure - emit a <FORM> to hold it
1569 proc StartProcedure {id} {
1570 PushForm "" PROCEDURE $id
1574 # start a Step inside a Procedure, emit another FORM to hold it
1575 proc StartStep {id} {
1576 PushForm "" STEP $id
1580 # start a SubStep inside a Stop, emit yet another FORM to hold it
1581 proc StartSubStep {id} {
1582 PushForm "" SUBSTEP $id
1586 # start a Part; make the PARTGlossArray be the current glossary array
1587 proc StartPart {id} {
1588 global partID glossStack
1592 # make sure the glossary array exists but is empty
1593 Push glossStack PARTGlossArray
1594 upvar #0 [Peek glossStack] currentGlossArray
1595 set currentGlossArray(foo) ""
1596 unset currentGlossArray(foo)
1600 # end a Part; check for definitions for all glossed terms
1604 # get a convenient handle on the glossary array
1605 upvar #0 [Peek glossStack] currentGlossArray
1607 # check that all the glossed terms have been defined
1608 foreach name [array names currentGlossArray] {
1609 if {[info exists currentGlossArray($name)]} {
1610 if {[lindex $currentGlossArray($name) 1] != "defined"} {
1611 set glossString [lindex $currentGlossArray($name) 2]
1612 UserError "No glossary definition for \"$glossString\"" no
1615 puts stderr "EndPart: currentGlossArray: index does not exist: '$name'"
1619 # delete this glossary array
1620 unset currentGlossArray
1624 # create and populate a dummy home page title - if no Title was
1625 # specified we want it to be "Home Topic"
1626 proc SynthesizeHomeTopicTitle {} {
1628 global localizedAutoGeneratedStringArray
1630 Title $partID PARTINTRO
1631 set message "Home Topic"
1632 Emit $localizedAutoGeneratedStringArray($message)
1633 CloseTitle PARTINTRO
1637 # create and populate a dummy home page because there was no
1638 # PartIntro in this document
1639 proc SynthesizeHomeTopic {} {
1641 global localizedAutoGeneratedStringArray
1644 StartNewVirpage PARTINTRO ""
1645 SynthesizeHomeTopicTitle
1646 StartParagraph $partID P ""
1647 set message "No home topic (PartIntro) was specified by the author."
1648 Emit $localizedAutoGeneratedStringArray($message)
1653 # start a virpage for, e.g., a SECTn - close the previous first;
1654 # compute the level rather than specifying it in the transpec to allow
1655 # one specification to do for all SECTn elements; if level=2 and we
1656 # haven't emitted a PartIntro (aka HomeTopic), emit one
1657 proc StartNewVirpage {ssi id} {
1658 global nextId virpageLevels inVirpage firstPInBlock
1659 global indexLocation snbLocation savedSNB currentSNB
1660 global lastList language charset docId havePartIntro partIntroId
1662 global manTitle manVolNum manDescriptor manNames manPurpose
1664 # get the LEVEL= value for this VIRPAGE (makes for a shorter
1665 # transpec to not have to specify level there)
1666 if {[info exists virpageLevels($ssi)]} {
1667 set level $virpageLevels($ssi)
1672 # if we are opening the PartIntro, use the generated ID (which
1673 # may be the assigned ID, if present) and flag that we've seen
1675 if {$ssi == "PARTINTRO"} {
1681 # if we haven't seen a PartIntro but we're trying to create a
1682 # level 2 VIRPAGE, emit a dummy PartInto
1683 if {($level == 2) && !$havePartIntro} {
1687 if {[string match {SECT[1-5]} $ssi]} {
1688 # make Chapter and all Sect? have an SSI of "CHAPTER", use LEVEL
1689 # to distinguish between them
1692 # make Reference, RefEntry and all RefSect? have an SSI of
1693 # "REFERENCE", use LEVEL to distinguish between them
1694 if {$ssi == "REFENTRY"} {
1697 if {[string match {REFSECT[1-3]} $ssi]} { set ssi REFERENCE }
1700 if {($ssi == "REFERENCE") || ($ssi == "REFENTRY")} {
1701 # assume no section, we'll get one in RefMeta.ManVolNum, if any
1704 set manDescriptor ""
1709 # close an open BLOCK, if any
1712 # close any open VIRPAGE
1713 Emit $inVirpage; set inVirpage "</VIRPAGE>\n"
1715 # if the first paragraph on the page is a compound para, we want
1716 # to emit a FORM with an SSI="P1" so set the first P flag
1719 # stash away the SNB for this VIRPAGE (or SDLDOC) - make an
1720 # associative array of the file location and the SNB data so
1721 # we can update the file location by adding the INDEX size before
1722 # writing the .snb file
1723 set names [array names currentSNB]
1724 if {[llength $names] != 0} {
1725 foreach name $names {
1726 # split the name into the GI and xid of the SNB entry
1727 set colonLoc [string first "::" $name]
1728 set type [string range $name 0 [incr colonLoc -1]]
1729 set data [string range $name [incr colonLoc 3] end]
1732 append tempSNB "<$type ID=\"$currentSNB($name)\" "
1740 TEXTFILE { set command "XID" }
1741 SYS-CMD { set command "COMMAND" }
1742 CALLBACK { set command "DATA" }
1744 append tempSNB "$command=\"$data\">\n"
1746 set savedSNB($snbLocation) $tempSNB
1750 if {[array exists lastList]} {
1751 unset lastList ;# don't allow lists to continue across virpage
1754 # delete the list of empty cells used for indefined Entries in
1755 # tables - we can only re-use them on the same virpage
1756 if {[array exists emptyCells]} {
1760 # we have to create new BLOCKs to hold the marks on the new page
1763 if {$id == ""} { set id "SDL-RESERVED[incr nextId]" }
1764 Emit "<VIRPAGE [Id $id] LEVEL=\"$level\" "
1765 Emit "LANGUAGE=\"$language\" "
1766 Emit "CHARSET=\"$charset\" "
1767 Emit "DOC-ID=\"$docId\" "
1768 Emit "SSI=\"$ssi\">\n"
1770 set snbLocation [tell stdout] ;# assume no HEAD for now
1774 # save the virpageLevels setting for this ssi (if any) and unset it
1775 # then call StartNewVirpage; on return, restore the virpagelevels
1776 # setting and continue - this will force the virpage to be a level 0
1777 # virpage and not show up in the TOC
1778 proc StartNewLevel0Virpage {ssi id} {
1779 global virpageLevels
1781 if {[info exists virpageLevels($ssi)]} {
1782 set savedLevel $virpageLevels($ssi)
1783 unset virpageLevels($ssi)
1786 StartNewVirpage $ssi $id
1788 if {[info exists savedLevel]} {
1789 set virpageLevels($ssi) $savedLevel
1794 # call StartNewVirpage, then if the user supplied ID is not same as
1795 # the default ID for that topic, emit an empty paragragh to contain
1796 # the user supplied ID; also, convert the ID of
1797 # SDL-RESERVED-LEGALNOTICE to SDL-RESERVED-COPYRIGHT for backwards
1798 # compatibility, preserve the original default ID so we're consistent
1799 # on this release too
1800 proc StartNewVirpageWithID {ssi id defaultID haveTitle} {
1803 # do we need to replace LEGALNOTICE with COPYRIGHT?
1805 if {[string toupper $defaultID] == "SDL-RESERVED-LEGALNOTICE"} {
1806 set defaultID SDL-RESERVED-COPYRIGHT
1810 StartNewVirpage $ssi $defaultID
1812 # if no user supplied ID but we changed the default, emit the
1813 # original default on the empty paragraph
1814 if {($id == "") && $legalNotice} {
1815 set id SDL-RESERVED-LEGALNOTICE
1819 # id is either user supplied or the original default (if changed);
1820 # if the VIRPAGE has a HEAD (Title), save this id (these ids) and
1821 # emit it (them) there, otherwise, emit an empty paragraph with
1824 if {[string toupper $id] != [string toupper $defaultID]} {
1828 # had both a user supplied ID and we changed the default
1829 lappend savedId SDL-RESERVED-LEGALNOTICE
1832 StartParagraph $id "" ""
1834 # had both a user supplied ID and we changed the default
1835 Anchor SDL-RESERVED-LEGALNOTICE
1844 # start a VIRPAGE for an appendix; if there's no ROLE=NOTOC, use the
1845 # virpage level from the level array, otherwise, use level 0
1846 proc StartAppendix {ssi id role} {
1847 global virpageLevels
1849 set uRole [string toupper $role]
1851 if {$uRole == "NOTOC"} {
1852 set saveAppendixLevel $virpageLevels(APPENDIX)
1853 set virpageLevels(APPENDIX) 0
1854 } elseif {$role != ""} {
1855 UserError "Bad value (\"$role\") for Role attribute in Appendix" yes
1858 StartNewVirpage $ssi $id
1860 if {$uRole == "NOTOC"} {
1861 set virpageLevels(APPENDIX) $saveAppendixLevel
1866 # start a new VIRPAGE for a topic that may contain a glossary; if
1867 # there is a glossary, start a new one and make it the current glossary,
1868 # otherwise, make the parent's glossary the current one.
1869 proc StartGlossedTopic {gi id haveGlossary} {
1872 if {$haveGlossary} {
1873 # save the glossary array name so we can get back here
1874 # when this topic is done
1875 Push glossStack ${gi}GlossArray
1877 # start a new (empty) glossary array for this glossary
1878 upvar #0 ${gi}GlossArray currentGlossArray
1879 set currentGlossArray(foo) ""
1880 unset currentGlossArray(foo)
1883 StartNewVirpage $gi $id
1887 # end a topic that may contain a glossary; if it did, check that all
1888 # glossed terms have been defined and remove the array - restore the
1889 # previous glossary array
1890 proc EndGlossedTopic {haveGlossary} {
1893 # get a convenient handle on the glossary array
1894 upvar #0 [Peek glossStack] currentGlossArray
1896 if {$haveGlossary} {
1897 # check that all the glossed terms have been defined
1898 foreach name [array names currentGlossArray] {
1899 if {[lindex $currentGlossArray($name) 1] != "defined"} {
1900 set glossString [lindex $currentGlossArray($name) 2]
1901 UserError "No glossary definition for \"$glossString\"" no
1905 # delete this glossary array and restore the previous one
1906 unset currentGlossArray
1912 # alternate OutputString routine for when in a glossed term - merely
1913 # buffer the output rather than sending to the output stream; we'll
1914 # emit the SDL when the whole term has been seen
1915 proc GlossOutputString {string} {
1918 append glossBuffer $string
1922 # prepare to link a glossed term to its definition in the glossary -
1923 # at this point, we simply divert the output into a buffer
1924 proc StartAGlossedTerm {} {
1928 rename OutputString SaveGlossOutputString
1929 rename GlossOutputString OutputString
1933 # strip any SDL markup from the string, upper case it and return
1934 # the result; takes advantage of the fact that we never split
1935 # start or end tags across lines (operates a line at a time)
1936 proc StripMarkup {markup} {
1937 set exp {(^|([^&]*))</?[A-Z]+[^>]*>}
1939 set mList [split $markup "\n"]; # split into a list of lines
1940 set listLen [llength $mList]
1941 while {[incr listLen -1] >= 0} {
1942 set mString [lindex $mList 0]; # get the first line from the
1943 set mList [lreplace $mList 0 0]; # list and delete it
1944 if {[string length $mString] == 0} {
1945 # empty line of pcdata (no markup)
1946 append stripped "\n"
1949 # force to upper case and delete all start and end tags
1950 set mString [string toupper $mString]
1951 while {[regsub -all $exp $mString {\1} mString]} {#}
1952 if {[string length $mString] == 0} {
1953 # empty line after removing markup; skip it
1956 append stripped $mString "\n"; # concat this line to result
1962 # done collecting a glossed term - if we're not NOGLOSS, emit the SDL
1963 # wrapped in a LINK; save the term, baseform (if any) and the ID
1964 # used in the link - we'll define the ID in the glossary itself
1965 proc EndAGlossedTerm {id role} {
1966 global glossBuffer nextId glossStack
1968 # get a convenient handle on the glossary array
1969 upvar #0 [Peek glossStack] currentGlossArray
1971 # get the original output routine back
1972 rename OutputString GlossOutputString
1973 rename SaveGlossOutputString OutputString
1975 set qualifier [string toupper [string range $role 0 8]]
1976 if {$qualifier == "NOGLOSS"} {
1977 Emit "<KEY CLASS=\"TERM\" SSI=\"GLOSSARY\">"
1981 if {$qualifier == "BASEFORM="} {
1982 set glossString [string range $role 9 end]
1984 set glossString $glossBuffer
1987 # trim whitespace from the front and back of the string to be
1988 # glossed, also turn line feeds into spaces and compress out
1989 # duplicate whitespace
1990 set glossString [string trim $glossString]
1991 set glossString [split $glossString '\n']
1992 set tmpGlossString $glossString
1993 set glossString [lindex $tmpGlossString 0]
1994 foreach str [lrange $tmpGlossString 1 end] {
1996 append glossString " " [string trim $str]
2000 # upper case the glossary entry and strip it of markup to
2001 # use as an index so we get a case insensitive match - we'll
2002 # save the original string too for error messages; if there's
2003 # no glossary entry yet, issue an ID - the second entry in
2004 # the list will be set to "defined" when we see the definition
2005 set glossIndex [StripMarkup $glossString]
2006 if {[info exists currentGlossArray($glossIndex)]} {
2007 set refId [lindex $currentGlossArray($glossIndex) 0]
2009 set refId SDL-RESERVED[incr nextId]
2010 set currentGlossArray($glossIndex) [list $refId "" $glossString]
2013 # now we can emit the glossed term wrapped in a popup link
2014 Emit "<LINK WINDOW=\"POPUP\" RID=\"$refId\">"
2015 Emit "<KEY CLASS=\"TERM\" SSI=\"GLOSSARY\">"
2017 Emit "</KEY></LINK>"
2022 # done collecting a term in a glossary - emit the anchor, if not
2023 # already done; if we are to be followed by alternate names (i.e.,
2024 # Abbrev and/or Acronym), emit the opening paren, otherwise, close
2026 proc EndATermInAGlossary {id} {
2027 global glossBuffer nextId nGlossAlts glossStack
2028 global strippedGlossIndex
2030 # get a convenient handle on the glossary array
2031 upvar #0 [Peek glossStack] currentGlossArray
2033 # get the original output routine back
2034 rename OutputString GlossOutputString
2035 rename SaveGlossOutputString OutputString
2037 # emit the user supplied ID
2040 # trim whitespace from the front and back of the string to be
2041 # placed in the glossary, also turn line feeds into spaces and
2042 # compress out duplicate whitespace
2043 set glossString [split $glossBuffer '\n']
2044 set tmpGlossString $glossString
2045 set glossString [lindex $tmpGlossString 0]
2046 foreach str [lrange $tmpGlossString 1 end] {
2048 append glossString " " [string trim $str]
2052 # create an upper cased version of the glossed string with markup
2053 # removed to use as a case insensitive index to the array
2054 set strippedGlossIndex [StripMarkup $glossString]
2056 # get or create the generated ID; update the glossary array to
2057 # reflect that we now have a definition
2058 if {[info exists currentGlossArray($strippedGlossIndex)]} {
2059 set id [lindex $currentGlossArray($strippedGlossIndex) 0]
2060 set defined [lindex $currentGlossArray($strippedGlossIndex) 1]
2061 if {$defined == "defined"} {
2063 "multiple definitions for glossary term \"$glossBuffer\"" yes
2064 set id SDL-RESERVED[incr nextId]
2067 set id SDL-RESERVED[incr nextId]
2069 set currentGlossArray($strippedGlossIndex) \
2070 [list $id defined $glossString "" ""]
2072 # emit the generated ID
2074 Emit "<KEY CLASS=\"TERM\" SSI=\"GLOSSARY\">"
2076 if {$nGlossAlts != 0} {
2085 proc EndAcronymInGlossary {id} {
2088 if {[incr nGlossAlts -1] != 0} {
2097 proc EndAbbrevInGlossary {id} {
2105 # start an entry in a glossary or glosslist; divert the output - we
2106 # need to sort the terms before emitting them
2107 proc StartGlossEntry {id nAlternates nDefs} {
2108 global nGlossAlts nGlossDefs currentGlossDef
2109 global glossEntryBuffer
2111 # this helps when determining if a comma is needed after an alt
2112 # (either an Abbrev or an Acronym)
2113 set nGlossAlts $nAlternates
2115 # this lets us know when to close the FORM holding the GlossDef+
2116 set nGlossDefs $nDefs
2117 set currentGlossDef 0
2119 set glossEntryBuffer ""
2120 rename OutputString SaveGlossEntryOutputString
2121 rename GlossEntryOutputString OutputString
2123 PushForm "" GLOSSENTRY $id
2124 StartParagraph "" "" ""
2128 # alternate OutputString routine for when in a GlossEntry - merely
2129 # buffer the output rather than sending to the output stream; we'll
2130 # save this text for emission when the entire GlossDiv, Glossary or
2131 # GlossList has been processed and we've sorted the entries.
2132 proc GlossEntryOutputString {string} {
2133 global glossEntryBuffer
2135 append glossEntryBuffer $string
2139 # end an entry in a glossary or glosslist; save the entry in the
2140 # glossarray so we can later sort it for output
2141 proc EndGlossEntry {sortAs} {
2142 global glossEntryBuffer strippedGlossIndex glossStack
2146 # get the original output routine back
2147 rename OutputString GlossEntryOutputString
2148 rename SaveGlossEntryOutputString OutputString
2150 # get a convenient handle on the glossary array and element
2151 upvar #0 [Peek glossStack] currentGlossArray
2152 upvar 0 currentGlossArray($strippedGlossIndex) currentEntryList
2154 # save any user supplied sort key and the content of this glossary
2155 # entry for use when all entries are defined to sort them and emit
2156 # them in the sorted order
2157 set currentEntryList \
2158 [lreplace $currentEntryList 3 4 $sortAs $glossEntryBuffer]
2163 # the current batch of glossary entries (to a Glossary, GlossList or
2164 # GlossDiv has been saved in the glossArray - we need to sort them
2165 # based on the sortAs value if given (list index 3) or the index into
2166 # the glossArray of no sortAs was provided; when sorted, we can emit
2167 # entries (list index 4) in the new order and delete the emitted text
2168 # so that we don't try to emit it again (we want to save the
2169 # glossArray until, e.g., all GlossDiv elements are processed so we
2170 # can tell if all glossed terms have been defined); do a PopForm
2171 # when we're done if requested (for, e.g., GlossList)
2172 proc SortAndEmitGlossary {popForm} {
2175 # get a convenient handle on the glossary array
2176 upvar #0 [Peek glossStack] currentGlossArray
2178 # start with an empty sortArray
2179 set sortArray(foo) ""
2180 unset sortArray(foo)
2182 set names [array names currentGlossArray]
2183 foreach name $names {
2184 # puts stderr "JET0: name: $name"
2185 upvar 0 currentGlossArray($name) glossEntryList
2187 # skip this array entry if we've already emitted it; mark as
2188 # emitted after we've extracted the content for emission
2189 if {[set content [lindex $glossEntryList 4]] == ""} {
2190 continue; # already been processed
2192 set glossEntryList [lreplace $glossEntryList 4 4 ""]
2194 # sort by the GlossTerm content or sortAs, if provided
2195 if {[set sortAs [lindex $glossEntryList 3]] == ""} {
2199 # append the content in case we have equal sort values
2200 append sortArray($sortAs) $content
2203 set idxnames [lsort -dictionary [array names sortArray]]
2205 foreach name $idxnames {
2206 # puts stderr "JET1: name: $name"
2207 if {[info exists sortArray($name)]} {
2208 Emit $sortArray($name)
2210 puts stderr "SortAndEmitGlossary: sortArray index does not exist: '$name'"
2214 if {[string toupper $popForm] == "POPFORM"} {
2220 # start a "See ..." in a glossary; if there was an otherterm, duplicate
2221 # its content and wrap it in a link to the GlossTerm holding the content
2222 proc StartGlossSee {id otherterm} {
2223 global localizedAutoGeneratedStringArray
2225 StartBlock "" GLOSSSEE $id 1
2226 StartParagraph "" "" ""
2228 Emit $localizedAutoGeneratedStringArray($message)
2230 if {$otherterm != ""} {
2231 Emit "<LINK RID=\"$otherterm\">"
2236 # check the target of an OtherTerm attribute in a GlossSee to verify
2237 # that it is indeed the ID of a GlossTerm inside a GlossEntry
2238 proc CheckOtherTerm {id gi parent} {
2241 set errorMess "Other term (\"$id\") referenced from a"
2243 if {$gi != "GLOSSTERM"} {
2244 UserError "$errorMess $glossType must be a GlossTerm" yes
2245 } elseif {$parent != "GLOSSENTRY"} {
2246 UserError "$errorMess GlossSee must be in a GlossEntry" yes
2251 # start a definition in a glossary; we wrap a FORM around the whole
2252 # group of GlossDef elements in the GlossEntry
2253 proc StartGlossDef {id} {
2254 global nGlossDefs currentGlossDef
2256 if {$currentGlossDef == 0} {
2257 PushForm "" GLOSSDEF $id
2259 StartBlock "" "" $id 1
2263 # end a definition in a glossary; if this is the last definition,
2264 # close the FORM that holds the group
2265 proc EndGlossDef {} {
2266 global nGlossDefs currentGlossDef
2268 if {[incr currentGlossDef] == $nGlossDefs} {
2270 unset nGlossDefs currentGlossDef
2275 # start a "See Also ..." in a glossary definition; if there was an
2276 # otherterm, duplicate its content and wrap it in a link to the
2277 # GlossTerm holding the content
2278 proc StartGlossSeeAlso {id otherterm} {
2279 global localizedAutoGeneratedStringArray
2281 StartBlock "" GLOSSSEE $id 1
2282 StartParagraph "" "" ""
2283 set message "See Also"
2284 Emit $localizedAutoGeneratedStringArray($message)
2286 if {$otherterm != ""} {
2287 Emit "<LINK RID=\"$otherterm\">"
2292 # end a "See ..." or a "See Also ..." in a glossary definition; if there
2293 # was an otherterm, end the link to it
2294 proc EndGlossSeeOrSeeAlso {otherterm} {
2295 if {$otherterm != ""} {
2301 # alternate OutputString routine for when in IndexTerm - merely
2302 # buffer the output rather than sending to the output stream (index
2303 # entries get emitted into the index, not where they are defined)
2304 proc IndexOutputString {string} {
2307 append indexBuffer $string
2311 # alternate Id routine for when in IndexTerm - merely
2312 # return the string rather than also setting the "most recently used"
2313 # variable. The markup inside the IndexTerm goes into the index
2314 # not the current virpage so we don't want to use the ids here
2315 proc IndexId {name} {
2316 return "ID=\"$name\""
2320 # start an index entry
2321 proc StartIndexTerm {id} {
2322 global indexBuffer inP inBlock
2327 } elseif {$inBlock != ""} {
2328 StartParagraph "" "P" ""
2335 # prepare to buffer the output while in IndexTerm
2337 rename OutputString DefaultOutputString
2338 rename IndexOutputString OutputString
2344 # add an index sub-entry
2345 proc AddIndexEntry {loc} {
2346 global indexBuffer indexVals indexArray
2348 # trim superfluous whitespace at the beginning and end of the
2350 set indexBuffer [string trim $indexBuffer]
2352 # get an array index and determine whether 1st, 2nd or 3rd level
2353 set index [join $indexVals ", "]
2354 set level [llength $indexVals]
2355 set value [lindex $indexVals [expr "$level - 1"]]
2357 # look for the string we want to put into the index; if the string
2358 # isn't there, add it - if it's there, verify that the content
2359 # being indexed is marked up the same as the last time we saw it
2360 # and that the primary/secondary/tertiary fields are split the
2361 # same way (bad check for now, we really need to save the
2362 # individual values) and add the location ID to the list of locs.
2363 set names [array names indexArray]
2365 set indexArray($index) [list $level $value $loc $indexBuffer]
2370 set thisIndex $indexArray($index)
2371 if {$indexBuffer != [lindex $thisIndex 3]} {
2372 UserError "Indexing same terms with different markup" yes
2374 if {$level != [lindex $thisIndex 0]} {
2375 UserError "Index botch: levels don't match" yes
2378 set locs [lindex $thisIndex 2]
2379 if {$locs != ""} { append locs " " }
2381 set thisIndex [lreplace $thisIndex 2 2 $locs]
2382 set indexArray($index) $thisIndex
2389 set indexArray($index) [list $level $value $loc $indexBuffer]
2396 # end an index entry
2397 proc EndIndexTerm {} {
2400 AddIndexEntry $mostRecentId
2402 # start emitting to output stream again
2403 rename OutputString IndexOutputString
2404 rename DefaultOutputString OutputString
2410 # start a primary index term
2411 proc StartPrimaryIndexEntry {id cdata} {
2414 set indexVals [list [string trim $cdata]]
2418 # end a primary index term
2419 proc EndPrimaryIndexEntry {} {
2423 # start a secondary index term
2424 proc StartSecondaryIndexEntry {id cdata} {
2427 AddIndexEntry "" ;# make sure our primary is defined
2428 lappend indexVals [string trim $cdata]
2432 # end a secondary index term
2433 proc EndSecondaryIndexEntry {} {
2437 # start a tertiary index term
2438 proc StartTertiaryIndexEntry {id cdata} {
2441 AddIndexEntry "" ;# make sure our secondary is defined
2442 lappend indexVals [string trim $cdata]
2446 # end a tertiary index term
2447 proc EndTertiaryIndexEntry {} {
2451 # compute the proper string for LOCS= in an index entry - primarily,
2452 # we want to avoid emitting the LOCS= if there are no locations
2453 # defined for this entry
2455 set locs [lindex $entry 2]
2457 return " LOCS=\"$locs\""
2463 # open a .idx file and write the index into it
2464 proc WriteIndex {} {
2465 global baseName indexArray
2467 set file [open "${baseName}.idx" w]
2471 set idxnames [lsort -dictionary [array names indexArray]]
2473 if {[set length [llength $idxnames]]} {
2475 puts $file "<INDEX COUNT=\"$length\">"
2476 foreach name $idxnames {
2477 if {[info exists indexArray($name)]} {
2478 set thisEntry $indexArray($name)
2479 switch [lindex $thisEntry 0] {
2480 1 { switch $oldLevel {
2481 1 { puts $file "</ENTRY>" }
2482 2 { puts $file "</ENTRY>\n</ENTRY>" }
2483 3 { puts $file "</ENTRY>\n</ENTRY>\n</ENTRY>" }
2486 2 { switch $oldLevel {
2487 2 { puts $file "</ENTRY>" }
2488 3 { puts $file "</ENTRY>\n</ENTRY>" }
2491 3 { if {$oldLevel == 3} { puts $file "</ENTRY>" } }
2493 puts -nonewline $file "<ENTRY[Locs $thisEntry]>"
2494 puts -nonewline $file [lindex $thisEntry 3]
2495 set oldLevel [lindex $thisEntry 0]
2497 puts stderr "WriteIndex: index does not exist: '$name'"
2502 1 { puts $file "</ENTRY>" }
2503 2 { puts $file "</ENTRY>\n</ENTRY>" }
2504 3 { puts $file "</ENTRY>\n</ENTRY>\n</ENTRY>" }
2506 puts $file "</INDEX>"
2513 # called at the beginning of CHAPTER on each FOOTNOTE element - save
2514 # their numbering for use by FOOTNOTEREF and emit a VIRPAGE for each
2516 proc GatherFootnote {id} {
2517 global footnoteArray footnoteCounter nextId
2519 incr footnoteCounter
2521 set footnoteArray($id) $footnoteCounter
2523 set id SDL-RESERVED[incr nextId]
2526 StartNewVirpage FOOTNOTE $id
2530 # emit the footnote number of the id surrounded by a <LINK> so we can
2531 # get to it; skip out if there's no id to reference
2532 proc FootnoteRef {idref} {
2533 global footnoteArray
2536 if {[info exists footnoteArray($idref)]} {
2537 Emit "<LINK RID=\"$idref\" WINDOW=\"popup\">"
2538 Emit "<KEY CLASS=\"EMPH\" SSI=\"FOOTNOTE\">"
2539 Emit "$footnoteArray($idref)</KEY></LINK>"
2545 # add an element to the current SNB - try to reuse an entry if
2547 proc AddToSNB {stype data} {
2548 global currentSNB nextId
2550 set index "${stype}::${data}"
2552 if {[info exists currentSNB($index)]} {
2553 set snbId $currentSNB($index)
2555 set snbId "SDL-RESERVED[incr nextId]"
2556 set currentSNB($index) $snbId
2562 # emit a DocBook Graphic element - create an SNB entry and point to
2564 proc Graphic {id entityref fileref gi} {
2567 if {$gi == "GRAPHIC"} {
2573 # if "entityref" is present, it overrides "fileref"
2574 if {$entityref != ""} {
2575 # need to remove "<OSFILE ASIS>" (or equivalent for different
2576 # system identifiers) from the beginning of the entity name
2577 # if nsgmls was used for the original parse; the regular
2578 # expression below should work by simply ignoring any leading
2579 # angle bracket delimited string
2580 regsub {^(<.*>)(.*)$} $entityref {\2} entityref
2587 UserError "No file name or entity specified for $gi" yes
2590 # if not in a paragraph, start one
2591 if {($gi == "GRAPHIC") && (!$inP)} { StartParagraph "" "P" "" }
2593 set snbId [AddToSNB GRAPHIC $file]
2596 Emit "<REFITEM RID=\"$snbId\" CLASS=\"$class\"></REFITEM>\n"
2601 # emit a deferred link; we deferred it when we saw that it was first
2602 # in a Para and that it contained only an InlineGraphic - we had
2603 # to wait for the InlineGraphic to come along to see if it not only
2604 # met the contextual constraints but also had a Remap=Graphic
2606 proc EmitDeferredLink {} {
2609 if {![array exists deferredLink]} return
2611 switch $deferredLink(gi) {
2612 LINK {StartLink "" $deferredLink(linkend) $deferredLink(type)}
2613 OLINK {StartOLink "" $deferredLink(localinfo) $deferredLink(type)}
2620 # emit an InlineGraphic that might be remapped to a Graphic (via
2621 # Remap=) and might have text wrapped around it (if it's first in
2622 # a Para or first in a [OU]Link that is itself first in a Para)
2623 proc InFlowGraphic {id entityref fileref parent remap role} {
2626 # we only map InlineGraphic to Graphic if we're either the first
2627 # thing in a Para or the only thing in a link which is itself
2628 # the first thing in a Para
2630 set haveDeferredLink [array exists deferredLink]
2635 ULINK {set ok $haveDeferredLink}
2638 Graphic $id $entityref $fileref INLINEGRAPHIC
2642 set uRemap [string toupper $remap]
2643 if {$uRemap == "GRAPHIC"} {
2644 set uRole [string toupper $role]
2647 "" {set role "LEFT"}
2648 RIGHT {set role "RIGHT"}
2650 set badValMess "Bad value (\"$role\") for Role attribute"
2651 UserError "$badValMess in InlineGraphic" yes
2655 if {$haveDeferredLink} {
2656 set linkID " ID=\"$deferredLink(id)\""
2657 if {$deferredLink(gi) == "ULINK"} {
2659 set haveDeferredLink 0
2664 Emit "<HEAD$linkID SSI=\"GRAPHIC-$role\">"
2665 if {$haveDeferredLink} {
2668 Graphic $id $entityref $fileref GRAPHIC
2669 if {$haveDeferredLink} {
2674 } elseif {$remap != ""} {
2675 set badValMess "Bad value (\"$remap\") for Remap attribute"
2676 UserError "$badValMess in InlineGraphic" yes
2679 Graphic $id $entityref $fileref INLINEGRAPHIC
2683 # start a figure; for now, ignore Role (as it was ignored in HelpTag)
2684 # but make sure Role contains only legal values
2685 proc StartFigure {id role} {
2687 set uRole [string toupper $role]
2693 set badValMess "Bad value for Role (\"$role\") attribute"
2694 UserError "$badValMess in Figure" yes
2699 PushForm "" "FIGURE" $id
2703 # emit a CiteTitle in a KEY with the SSI set to the PubWork attr.
2704 proc CiteTitle {id type} {
2705 Emit "<KEY CLASS=\"PUB-LIT\""
2709 Emit " SSI=\"$type\">"
2713 # start a KEY element - each parameter is optional (i.e, may be "")
2714 proc StartKey {id class ssi} {
2720 Emit " CLASS=\"$class\""
2723 Emit " SSI=\"$ssi\""
2728 # start an emphasis with role=heading; want want a different ssi
2729 # so we can make it bold rather than italic for use as a list
2731 proc StartHeading {id role} {
2732 set role [string toupper $role]
2733 if {$role != "HEADING"} {
2735 UserWarning "Bad value for Role (!= \"Heading\") in EMPHASIS" yes
2739 set ssi LIST-HEADING
2741 StartKey $id EMPH $ssi
2745 # start an Example or InformalExample - we need to put ourselves
2746 # in a mode where lines and spacing are significant
2748 global defaultParaType
2750 set defaultParaType " TYPE=\"LITERAL\""
2751 PushForm "" "EXAMPLE" $id
2755 # close an Example or InformalExample - put ourselves back in
2756 # the normal (non-literal) mode
2757 proc CloseExample {} {
2758 global defaultParaType
2760 set defaultParaType ""
2765 # start a Table or InformalTable - save the global attributes and
2766 # open a FORM to hold the table
2767 proc StartTable {id colSep frame label rowSep} {
2768 global tableAttributes
2770 set tableAttributes(colSep) $colSep
2771 set tableAttributes(label) $label
2772 set tableAttributes(rowSep) $rowSep
2774 PushForm TABLE "TABLE-$frame" $id
2776 # create a list of ids of empty blocks to be used to fill in
2777 # undefined table cells
2781 # check the "char" attribute - we only support "." at this time;
2782 # return "." if char="." and "" otherwise; issue warning if char
2783 # is some character other than "."
2784 proc CheckChar {char} {
2785 if {($char != "") && ($char != ".")} {
2786 UserError "Only \".\" supported for character alignment" yes
2793 # start a TGROUP - prepare to build a list of column specifications
2794 # and an array of span specifications to be accessed by name; a column
2795 # specification may be numbered, in which case default (all #IMPLIED)
2796 # column specifications will be inserted to come up to the specified
2797 # number - if there are already more column specifications than the
2798 # given number, it's an error; open a FORM to hold the TGroup
2799 proc StartTGroup {id align char cols colSep rowSep nColSpecs} {
2800 global tableGroupAttributes tableAttributes
2801 global tableGroupColSpecs tableGroupSpanSpecs
2802 global numberOfColSpecs colNames haveTFoot
2803 global needTGroupTHeadForm needTFootForm
2804 global tableGroupSavedFRowVec
2806 set numberOfColSpecs $nColSpecs
2808 # do a sanity check on the number of columns, there must be
2811 UserError "Unreasonable number of columns ($cols) in TGroup" yes
2815 # check for more COLSPECs than COLS - error if so
2816 if {$nColSpecs > $cols} {
2817 UserError "More ColSpecs defined than columns in the TGroup" yes
2820 set tableGroupAttributes(align) $align
2821 set tableGroupAttributes(char) [CheckChar $char]
2822 set tableGroupAttributes(cols) $cols
2823 if {$colSep == ""} {
2824 set tableGroupAttributes(colSep) $tableAttributes(colSep)
2826 set tableGroupAttributes(colSep) $colSep
2828 if {$rowSep == ""} {
2829 set tableGroupAttributes(rowSep) $tableAttributes(rowSep)
2831 set tableGroupAttributes(rowSep) $rowSep
2834 # make sure we have a blank colName array so we don't get errors
2835 # if we try to read or delete it when there have been no named
2836 # ColSpecs in this tableGroup - use a numeric key since that is
2837 # not a NMTOKEN and so can never be a colName - note that all
2838 # colNames share a common name space within each tGroup.
2841 # create an empty column specification list for this TGroup;
2842 # if no ColSpec definitions at this level, set them all to the
2843 # defaults - take advantage of the fact that the function ColSpec
2844 # will create default column specifications to fill out up to an
2845 # explicitly set ColNum
2846 set tableGroupColSpecs ""
2847 if {$nColSpecs == 0} {
2848 ColSpec "" TGROUP "" "" "" $cols "" "" ""
2851 PushForm TABLE TGROUP $id
2853 # set a flag to indicate that we haven't seen a TFoot yet; this
2854 # flag is used in EndRow and StartCell to determine if a Row is
2855 # the last row in this TGroup (the last row will be in the TFoot,
2856 # if present, otherwise it will be in the TBody)
2859 # initialize variables used to determine if we need separate FORM
2860 # elements for THead or TFoot - if ColSpec elements are not given
2861 # at those levels, they can go in the same FORM as the TBody and
2862 # we can guarantee that the columns will line up
2863 set needTGroupTHeadForm 0
2866 # and initialize a variable to hold saved FROWVEC elements across
2867 # THead, TBody and TFoot in case we are merging them into one or
2868 # two FORM elements rather than putting each in its own
2869 set tableGroupSavedFRowVec ""
2873 # close a table group; delete the info arrays and lists and close the
2876 global tableGroupAttributes tableGroupColSpecs tableGroupSpanSpecs
2879 unset tableGroupAttributes
2880 unset tableGroupColSpecs
2881 if {[info exists tableGroupSpanSpecs]} {
2882 unset tableGroupSpanSpecs
2886 # see the explanation for this variable under StartTGroup
2891 # process one of a series of column specifications - use the parent GI
2892 # to determine which column specifications we're dealing with; fill up
2893 # to the specified column number with default COLSPECs, using the
2894 # TGROUP, THEAD or TFOOT values as defaults; any COLSPEC values not
2895 # specified in the parameter list should also be defaulted
2896 proc ColSpec {grandparent parent align char colName colNum
2897 colSep colWidth rowSep} {
2898 # the number of currently defined colSpecs in this context
2899 global numberOfColSpecs
2902 # get the proper list of ColSpecs for the current context
2903 if {$grandparent == "ENTRYTBL"} {
2904 set gpName entryTable
2906 set gpName tableGroup
2909 THEAD { upvar #0 ${gpName}HeadColSpecs colSpecs }
2910 TGROUP { upvar #0 tableGroupColSpecs colSpecs }
2911 TFOOT { upvar #0 tableFootColSpecs colSpecs }
2912 ENTRYTBL { upvar #0 entryTableColSpecs colSpecs }
2915 # get the proper number of columns (either from TGroup or EntryTbl);
2916 # a THead could be in either a TGroup or EntryTbl so we need
2917 # to check the grandparent if we aren't at the top level
2918 if {$parent == "TGROUP"} {
2919 upvar #0 tableGroupAttributes attributes
2920 } elseif {$parent == "ENTRYTBL"} {
2921 upvar #0 entryTableAttributes attributes
2922 } elseif {$grandparent == "ENTRYTBL"} {
2923 upvar #0 entryTableAttributes attributes
2925 upvar #0 tableGroupAttributes attributes
2927 set nCols $attributes(cols)
2929 # check for more COLSPECs than COLS - we've already issued an error if so
2931 set currentLength [llength $colSpecs]
2932 if {$currentLength >= $nCols} {
2936 # create a default ColSpec
2937 set thisColSpec(align) $attributes(align)
2938 set thisColSpec(char) $attributes(char)
2939 set thisColSpec(colName) ""
2940 set thisColSpec(colSep) $attributes(colSep)
2941 set thisColSpec(colWidth) "1*"
2942 set thisColSpec(rowSep) $attributes(rowSep)
2944 # back fill with default COLSPECs if given an explicit COLNUM and
2945 # it's greater than our current position
2947 if {($colNum != "")} {
2948 if {($colNum < $currentLength)} {
2949 set badValMess1 "Explicit colNum ($colNum) less than current"
2950 set badValMess2 "number of ColSpecs ($currentLength)"
2951 UserError "$badValMess1 $badValMess2" yes
2954 while {$currentLength < $colNum} {
2955 set thisColSpec(colNum) $currentLength
2956 lappend colSpecs [array get thisColSpec]
2961 set colNum $currentLength
2963 # set this COLSPEC, we've already set the defaults
2965 set thisColSpec(align) $align
2968 set thisColSpec(char) [CheckChar $char]
2970 set thisColSpec(colName) $colName
2971 if {$colName != ""} {
2972 # save name to num mapping for later lookup by Entry
2973 set colNames($colName) $colNum
2975 set thisColSpec(colNum) $colNum
2976 if {$colSep != ""} {
2977 set thisColSpec(colSep) $colSep
2979 if {$colWidth != ""} {
2980 set thisColSpec(colWidth) $colWidth
2982 if {$rowSep != ""} {
2983 set thisColSpec(rowSep) $rowSep
2985 if {$colNum == $nCols} {
2986 set thisColSpec(colSep) 0; # ignore COLSEP on last column
2988 lappend colSpecs [array get thisColSpec]
2990 # fill out to the number of columns if we've run out of COLSPECs
2991 if {[incr numberOfColSpecs -1] <= 0} {
2992 # restore the default COLSPEC
2993 set thisColSpec(align) $attributes(align)
2994 set thisColSpec(char) $attributes(char)
2995 set thisColSpec(colName) ""
2996 set thisColSpec(colSep) $attributes(colSep)
2997 set thisColSpec(colWidth) "1*"
2998 set thisColSpec(rowSep) $attributes(rowSep)
3000 while {$colNum < $nCols} {
3002 set thisColSpec(colNum) $colNum
3003 if {$colNum == $nCols} {
3004 set thisColSpec(colSep) 0; # ignore on last column
3006 lappend colSpecs [array get thisColSpec]
3012 # process a SpanSpec - we can't take defaults yet because the Namest
3013 # and Nameend attributes may refer to ColSpecs that don't get defined
3014 # until a TFoot or THead
3015 proc SpanSpec {parent align char colSep nameEnd nameSt rowSep spanName} {
3016 if {$parent == "TGROUP"} {
3017 upvar #0 tableGroupSpanSpecs spanSpecs
3019 upvar #0 entryTableSpanSpecs spanSpecs
3022 set thisSpanSpec(align) $align
3023 set thisSpanSpec(char) [CheckChar $char]
3024 set thisSpanSpec(colSep) $colSep
3025 set thisSpanSpec(nameEnd) $nameEnd
3026 set thisSpanSpec(nameSt) $nameSt
3027 set thisSpanSpec(rowSep) $rowSep
3029 if {[info exists spanSpecs($spanName)]} {
3030 UserError "duplicate span name \"$spanName\"" yes
3034 set spanSpecs($spanName) [array get thisSpanSpec]
3038 # make a list of empty strings for use as an empty Row
3039 proc MakeEmptyRow {nCols} {
3041 while {$nCols > 0} {
3049 # given a ColSpec list, compute a COLW= vector for SDL;
3050 # the idea is to assume the page is 9360 units wide - that's
3051 # 6.5 inches in points at approximately 1/72 in. per point,
3052 # subtract all the absolute widths and divide the remnant by
3053 # the number of proportional width values then re-add the absolute
3054 # widths back in to the proper columns; this technique should
3055 # make pages that are exactly 6.5 in. in printing surface look just
3056 # right and then go proportional from there
3057 proc ComputeCOLW {colSpecList} {
3059 set nCols [llength $colSpecList]
3061 # build lists of just the ColWidth specs - one for the proporional
3062 # values and one for the absolutes
3066 while {$index < $nCols} {
3067 array set thisColSpec [lindex $colSpecList $index]
3068 set colWidth $thisColSpec(colWidth)
3069 set colWidth [string trimleft $colWidth]
3070 set colWidth [string trimright $colWidth]
3071 set colWidth [string tolower $colWidth]
3072 set widths [split $colWidth '+']
3073 set nWidths [llength $widths]
3077 while {$wIndex < $nWidths} {
3078 set thisWidth [lindex $widths $wIndex]
3079 if {[scan $thisWidth "%f%s" val qual] != 2} {
3080 UserError "Malformed ColWidth \"$thisWidth\"" yes
3086 switch -exact $qual {
3087 * {set thisProp $val}
3088 pt {set thisAbs [expr "$val * 1 * 20"]}
3089 pi {set thisAbs [expr "$val * 12 * 20"]}
3090 cm {set thisAbs [expr "$val * 28 * 20"]}
3091 mm {set thisAbs [expr "$val * 3 * 20"]}
3092 in {set thisAbs [expr "$val * 72 * 20"]}
3094 set propWidth [expr "$propWidth + $thisProp"]
3095 set absWidth [expr "$absWidth + $thisAbs"]
3098 lappend propWidths $propWidth
3099 lappend absWidths $absWidth
3100 set totalProps [expr "$totalProps + $propWidth"]
3101 set totalAbs [expr "$totalAbs + $absWidth"]
3104 if {$totalProps == 0} {
3105 # we need at least some proportionality; assume each cell
3106 # had been set to 1* to distribute evenly
3107 set totalProps $nCols
3109 if {[info exists propWidths]} {
3112 while {$index < $nCols} {
3113 lappend propWidths 1
3118 if {$totalAbs > $tableWidth} {
3119 set tableWidth $totalAbs
3121 set propAvail [expr "$tableWidth - $totalAbs"]
3122 set oneProp [expr "$propAvail / $totalProps"]
3124 # now we know what a 1* is worth and we know the absolute size
3125 # requests, create a ColWidth by adding the product of the
3126 # proportional times a 1* plus any absolute request; we'll allow
3127 # 20% growth and shrinkage
3130 while {$index < $nCols} {
3131 set thisAbs [lindex $absWidths $index]
3132 set thisProp [lindex $propWidths $index]
3133 set thisWidth [expr "$thisAbs + ($thisProp * $oneProp)"]
3134 set thisSlop [expr "$thisWidth * 0.2"]
3135 # make thisWidth an integer
3136 set dotIndex [string last "." $thisWidth]
3137 if {$dotIndex == 0} {
3139 } elseif {$dotIndex > 0} {
3141 set thisWidth [string range $thisWidth 0 $dotIndex]
3143 # make thisSlop an integer
3144 set dotIndex [string last "." $thisSlop]
3145 if {$dotIndex == 0} {
3147 } elseif {$dotIndex > 0} {
3149 set thisSlop [string range $thisSlop 0 $dotIndex]
3151 append returnValue "$space$thisWidth,$thisSlop"
3161 # given a ColSpec list, compute a COLJ= vector for SDL;
3162 proc ComputeCOLJ {colSpecList} {
3164 set nCols [llength $colSpecList]
3168 while {$index < $nCols} {
3169 array set thisColSpec [lindex $colSpecList $index]
3170 switch -exact $thisColSpec(align) {
3173 "" { set thisColJ l}
3174 CENTER { set thisColJ c}
3175 RIGHT { set thisColJ r}
3176 CHAR { set thisColJ d}
3178 append returnValue "$space$thisColJ"
3188 # given a ColSpec, create the COLW= and COLJ= attributes; check the
3189 # list of current TOSS entries to see if one matches - if so, return
3190 # its SSI= else add it and create an SSI= to return
3191 proc CreateOneTOSS {ssi vAlign colSpec} {
3192 global newTOSS nextId
3194 set colW [ComputeCOLW $colSpec]
3195 set colJ [ComputeCOLJ $colSpec]
3196 set names [array names newTOSS]
3197 foreach name $names {
3198 array set thisTOSS $newTOSS($name)
3199 if {[string compare $colW $thisTOSS(colW)]} {
3200 if {[string compare $colJ $thisTOSS(colJ)]} {
3201 if {[string compare $vAlign $thisTOSS(vAlign)]} {
3208 # no matching colW,colJ, add an entry
3210 set ssi HBF-SDL-RESERVED[incr nextId]
3212 set thisTOSS(colW) $colW
3213 set thisTOSS(colJ) $colJ
3214 set thisTOSS(vAlign) $vAlign
3215 set newTOSS($ssi) [array get thisTOSS]
3220 # save values from TFoot, we'll actually process TFoot after TBody
3221 # but we need to know whether we have a TFoot and whether that TFoot
3222 # has ColSpec elements in order to push/pop a FORM for the TBody if
3224 proc PrepForTFoot {nColSpecs} {
3225 global haveTFoot needTFootForm
3228 set needTFootForm [expr "$nColSpecs > 0"]
3232 # start a table header, footer or body - create a FORM to hold the rows;
3233 # create an empty row to be filled in by the Entry elements - set the
3234 # current row and number of rows to 1
3235 proc StartTHeadTFootTBody {parent gi haveTHead id vAlign nRows nColSpecs} {
3236 global numberOfColSpecs haveTFoot
3237 global needTFootForm
3239 if {$parent == "ENTRYTBL"} {
3240 upvar #0 entryTableRowDope rowDope
3241 upvar #0 needEntryTblTHeadForm needTHeadForm
3242 global entryTableAttributes
3243 set nCols $entryTableAttributes(cols)
3244 set entryTableAttributes(vAlign) $vAlign
3245 set entryTableAttributes(rows) $nRows
3247 upvar #0 tableGroupRowDope rowDope
3248 upvar #0 needTGroupTHeadForm needTHeadForm
3249 global tableGroupAttributes
3250 set nCols $tableGroupAttributes(cols)
3251 set tableGroupAttributes(vAlign) $vAlign
3252 set tableGroupAttributes(rows) $nRows
3255 set numberOfColSpecs $nColSpecs
3257 # get the proper list of ColSpecs for the current context
3258 if {$parent == "ENTRYTBL"} {
3259 set parentName entryTable
3261 set parentName tableGroup
3264 THEAD {upvar #0 ${parentName}HeadColSpecs colSpecs}
3265 TBODY {upvar #0 ${parentName}ColSpecs colSpecs}
3266 TFOOT {upvar #0 tableFootColSpecs colSpecs }
3269 # if no ColSpec definitions at this level, copy the parent's
3270 # ColSpec definition to here
3271 if {$nColSpecs == 0} {
3273 THEAD {upvar #0 ${parentName}ColSpecs parentColSpecs}
3274 TFOOT {upvar #0 tableGroupColSpecs parentColSpecs}
3276 if {$gi != "TBODY"} {
3277 set colSpecs $parentColSpecs
3281 # if we have ColSpec elements on a THead, we'll need to put it
3282 # in its own FORM; we saved this value for TFoot earlier
3283 # because TFoot precedes TBody in the content model but doesn't
3284 # get processed until after TBody (as EndText: to TGroup)
3285 if {$gi == "THEAD"} {
3286 set needTHeadForm [expr "$nColSpecs > 0"]
3289 # determine whether we need to push a new FORM here - we always
3290 # have to push a FORM for a THead, we only push one for TBody
3291 # if THead needed its own or there was no THead and we only push
3292 # one for TFoot if it needs its own
3296 set needTBodyForm $needTHeadForm
3301 TBODY {set doit $needTBodyForm}
3302 TFOOT {set doit $needTFootForm}
3305 # and push it, if so
3307 set ssi [CreateOneTOSS $id "" $colSpecs]
3308 PushForm TABLE "$ssi" $id
3311 set rowDope(nRows) 0
3312 set rowDope(currentRow) 0
3316 # end a table header footer or body - delete the global row
3317 # information and close the FORM; also delete the ColSpec info for
3318 # this THead or TFoot (TBody always uses the parent's)
3319 proc EndTHeadTFootTBody {parent gi} {
3320 global numberOfColSpecs needTFootForm haveTFoot
3322 if {$parent == "ENTRYTBL"} {
3323 upvar #0 needEntryTblTHeadForm needTHeadForm
3325 upvar #0 needTGroupTHeadForm needTHeadForm
3328 # determine whether we want to terminate this FORM here - we
3329 # only terminate the THead FORM if it needed its own, we only
3330 # terminate the TBody FORM if the TFoot needs its own or there
3331 # is no TFoot and we always terminate the FORM for TFoot
3332 if {($parent == "ENTRYTBL") || !$haveTFoot} {
3335 set needTBodyForm $needTFootForm
3339 THEAD {set doit $needTHeadForm}
3340 TBODY {set doit $needTBodyForm}
3343 PopTableForm $parent $gi $doit
3345 # blow away the list of ColSpecs for the current context
3347 THEAD { if {$parent == "ENTRYTBL"} {
3348 global entryTableHeadColSpecs
3349 unset entryTableHeadColSpecs
3351 global tableGroupHeadColSpecs
3352 unset tableGroupHeadColSpecs
3355 TFOOT { global tableFootColSpecs
3356 unset tableFootColSpecs
3362 # start a table row - save the attribute values for when we
3363 # actually emit the entries of this row; when we emit the first
3364 # entry we'll emit the ID on the rowSep FORM that we create for each
3365 # Entry and set the ID field to "" so we only emit the ID once
3366 proc StartRow {grandparent parent id rowSep vAlign} {
3367 if {$grandparent == "ENTRYTBL"} {
3368 upvar #0 entryTableRowDope rowDope
3369 global entryTableAttributes
3370 set nCols $entryTableAttributes(cols)
3371 if {$vAlign == ""} {
3372 set vAlign $entryTableAttributes(vAlign)
3375 upvar #0 tableGroupRowDope rowDope
3376 global tableGroupAttributes
3377 set nCols $tableGroupAttributes(cols)
3378 if {$vAlign == ""} {
3379 set vAlign $tableGroupAttributes(vAlign)
3382 upvar 0 rowDope(currentRow) currentRow
3383 upvar 0 rowDope(nRows) nRows
3386 set rowDope(rowSep) $rowSep
3387 set rowDope(vAlign) $vAlign
3390 if {![info exists rowDope(row$currentRow)]} {
3391 set rowDope(row$currentRow) [MakeEmptyRow $nCols]
3396 # a debugging procedure
3397 proc DumpRowDope {rowDopeName} {
3398 upvar 1 $rowDopeName rowDope
3400 puts stderr "rowDope:"
3402 while {[incr index] <= $rowDope(nRows)} {
3404 " $index: ([llength $rowDope(row$index)]) $rowDope(row$index)"
3410 proc EndRow {grandparent parent} {
3411 global emptyCells nextId haveTFoot
3413 # this row could be in a TGroup or an EntryTbl
3414 if {$grandparent == "ENTRYTBL"} {
3415 upvar #0 entryTableRowDope rowDope
3416 global entryTableAttributes
3417 set nCols $entryTableAttributes(cols)
3418 set nRowDefs $entryTableAttributes(rows)
3420 upvar #0 tableGroupRowDope rowDope
3421 global tableGroupAttributes
3422 set nCols $tableGroupAttributes(cols)
3423 set nRowDefs $tableGroupAttributes(rows)
3426 # get the proper list of ColSpecs for the current context
3428 THEAD { if {$grandparent == "ENTRYTBL"} {
3429 upvar #0 entryTableHeadColSpecs colSpecs
3431 upvar #0 tableGroupHeadColSpecs colSpecs
3434 TBODY { if {$grandparent == "ENTRYTBL"} {
3435 upvar #0 entryTableColSpecs colSpecs
3437 upvar #0 tableGroupColSpecs colSpecs
3440 TFOOT { upvar #0 tableFootColSpecs colSpecs }
3443 # go over the row filing empty cells with an empty FORM containing
3444 # an empty BLOCK. The FORM SSI= is chosen to give a RowSep based
3445 # upon the current ColSpec and rowDope, if we are on the last row
3446 # we want to set the RowSep to 0 unless there were more rows
3447 # created via the MoreRows attribute of Entry or EntryTbl forcing
3448 # the table to be longer than the number of Rows specified in which
3449 # case we want to fill in all those rows too and only force RowSep
3450 # to 0 on the last one; the inner BLOCK SSI= is chosen to give a
3451 # ColSep based upon the current ColSpec and Row definition - if
3452 # the column is the last one in the row, the ColSep is set to 0
3453 set currentRow $rowDope(currentRow)
3454 if {$currentRow == $nRowDefs} {
3455 set moreRows [expr "$rowDope(nRows) - $nRowDefs"]
3459 upvar 0 rowDope(row$currentRow) thisRow
3460 upvar 0 rowDope(row[expr "$currentRow - 1"]) prevRow
3461 while {$moreRows >= 0} {
3463 while {$colIndex < $nCols} {
3464 set thisCellId [lindex $thisRow $colIndex]
3465 if {$thisCellId == ""} {
3466 array set thisColSpec [lindex $colSpecs $colIndex]
3467 set desiredCell(colSep) $thisColSpec(colSep)
3468 set desiredCell(rowSep) $thisColSpec(rowSep)
3469 if {$rowDope(rowSep) != ""} {
3470 set desiredCell(rowSep) $rowDope(rowSep)
3472 if {$colIndex == $nCols} {
3473 set desiredCell(colSep) 0
3475 if {($moreRows == 0) && ($currentRow == $nRowDefs)} {
3476 if {($parent == "TFOOT") ||
3477 (($parent == "TBODY") && (!$haveTFoot))} {
3478 set desiredCell(rowSep) 0
3481 if {$desiredCell(colSep) == ""} {
3482 set desiredCell(colSep) 1
3484 if {$desiredCell(rowSep) == ""} {
3485 set desiredCell(rowSep) 1
3488 foreach id [array names emptyCells] {
3489 array set thisCell $emptyCells($id)
3490 if {$thisCell(colSep) != $desiredCell(colSep)} {
3493 if {$thisCell(rowSep) != $desiredCell(rowSep)} {
3496 if {$currentRow > 1} {
3497 if {[lindex $prevRow $colIndex] == $id} {
3501 if {$colIndex > 0} {
3502 if {$lastCellId == $id} {
3511 if {$desiredCell(rowSep)} {
3512 set ssi BORDER-BOTTOM
3516 set id [PushFormCell $ssi ""]
3517 if {$desiredCell(colSep)} {
3518 set ssi ENTRY-NONE-YES-NONE
3520 set ssi ENTRY-NONE-NO-NONE
3522 StartBlock CELL $ssi "" 1
3524 set emptyCells($id) [array get desiredCell]
3527 Replace thisRow $colIndex 1 $thisCellId
3529 set lastCellId $thisCellId
3534 upvar 0 thisRow prevRow
3535 upvar 0 rowDope(row$currentRow) thisRow
3538 # blow away the variables that get reset on each row
3540 unset rowDope(rowSep)
3541 unset rowDope(vAlign)
3545 # given a row list, an id and start and stop columns, replace the
3546 # entries in the list from start to stop with id - use "upvar" on
3547 # the row list so we actually update the caller's row
3548 proc Replace {callersRow start length id} {
3549 upvar $callersRow row
3551 # length will be 0 if there was an error on the row
3556 # make a list of ids long enough to fill the gap
3558 set ids $id; # we pad all the others with a starting space
3559 while {$i < $length} {
3564 # do the list replacement - need to "eval" because we want the
3565 # ids to be seen a individual args, not a list so we need to
3566 # evaluate the command twice
3567 set stop [expr "$start + $length - 1"]
3568 set command "set row \[lreplace \$row $start $stop $ids\]"
3573 # process a table cell (Entry or EntryTbl); attributes are inherited
3574 # in the following fashion:
3581 # with later values (going down the list) overriding earlier ones;
3582 # Table, TGroup, etc., values have already been propagated to the
3584 proc StartCell {ancestor grandparent gi id align char colName cols
3585 colSep moreRows nameEnd nameSt rowSep spanName
3586 vAlign nColSpecs nTBodies} {
3587 global colNames tableGroupAttributes entryTableAttributes
3588 global numberOfColSpecs entryTableColSpecs nextId haveTFoot
3589 global needEntryTblTHeadForm entryTableSavedFRowVec
3591 # get the appropriate SpanSpec list, if any; also get the row
3592 # row dope vector which also contains the current row number
3593 # and number of rows currently allocated (we might get ahead
3594 # of ourselves due to a vertical span via MOREROWS=)
3595 if {$ancestor == "TGROUP"} {
3596 upvar #0 tableGroupSpanSpecs spanSpecs
3597 upvar #0 tableGroupRowDope rowDope
3598 set nCols $tableGroupAttributes(cols)
3599 set nRowDefs $tableGroupAttributes(rows)
3601 upvar #0 entryTableSpanSpecs spanSpecs
3602 upvar #0 entryTableRowDope rowDope
3603 set nCols $entryTableAttributes(cols)
3604 set nRowDefs $entryTableAttributes(rows)
3607 # get the proper list of ColSpecs for the current context
3608 switch $grandparent {
3609 THEAD { if {$ancestor == "ENTRYTBL"} {
3610 upvar #0 entryTableHeadColSpecs colSpecs
3612 upvar #0 tableGroupHeadColSpecs colSpecs
3615 TBODY { if {$ancestor == "ENTRYTBL"} {
3616 upvar #0 entryTableColSpecs colSpecs
3618 upvar #0 tableGroupColSpecs colSpecs
3621 TFOOT { upvar #0 tableFootColSpecs colSpecs }
3625 if {$spanName != ""} {
3626 if {[info exists spanSpecs($spanName)]} {
3627 array set thisSpan $spanSpecs($spanName)
3628 # SpanSpec column names win over explicit ones
3629 set nameSt $thisSpan(nameSt)
3630 set nameEnd $thisSpan(nameEnd)
3632 UserError "Attempt to use undefined SpanSpec \"$spanName\"" yes
3636 # nameSt, whether explicit or from a span, wins over colName
3637 if {$nameSt != ""} {
3641 # get the row information - use upvar so we can update rowDope
3642 upvar 0 rowDope(currentRow) currentRow
3643 upvar 0 rowDope(row$currentRow) thisRow
3644 upvar 0 rowDope(nRows) nRows
3646 # by now, if no colName we must have neither colName, nameSt nor
3647 # a horizontal span - find the next open spot in this row
3648 if {$colName != ""} {
3649 if {[info exists colNames($colName)]} {
3650 set startColNum $colNames($colName)
3651 if {$startColNum > $nCols} {
3652 UserError "Attempt to address column outside of table" yes
3655 incr startColNum -1 ;# make the column number 0 based
3658 UserError "Attempt to use undefined column name \"$colName\"" yes
3662 if {$colName == ""} {
3664 while {[lindex $thisRow $index] != ""} {
3667 if {$index == $nCols} {
3668 UserError "More entries defined than columns in this row" yes
3671 set startColNum $index
3674 # if we have a nameEnd, it was either explicit or via a span -
3675 # get the stop column number; else set the stop column to the
3676 # start column, i.e., a span of 1
3677 if {$nameEnd == ""} {
3678 set stopColNum $startColNum
3680 if {[info exists colNames($nameEnd)]} {
3681 set stopColNum $colNames($nameEnd)
3682 if {$stopColNum > $nCols} {
3683 UserError "Attempt to address column outside of table" yes
3684 set stopColNum $nCols
3686 incr stopColNum -1 ;# make the column number 0 based
3687 if {$startColNum > $stopColNum} {
3688 UserError "End of column span is before the start" yes
3689 set stopColNum $startColNum
3692 UserError "Attempt to use undefined column name \"$nameEnd\"" yes
3693 set stopColNum $startColNum
3697 # create an empty set of attributes for the cell - we'll fill
3698 # them in from the ColSpec, SpanSpec, Row and Entry or EntryTbl
3699 # defined values, if any, in that order
3705 # initialize the cell description with the ColSpec data
3706 # Table, TGroup and EntryTable attributes have already
3707 # percolated to the ColSpec
3708 if {$startColNum >= 0} {
3709 array set thisColSpec [lindex $colSpecs $startColNum]
3710 if {$thisColSpec(colSep) != ""} {
3711 set cellColSep $thisColSpec(colSep)
3713 if {$thisColSpec(rowSep) != ""} {
3714 set cellRowSep $thisColSpec(rowSep)
3718 # overlay any attributes defined on the span, that is, SpanSpec
3719 # attributes win over ColSpec ones
3720 if {[info exists thisSpan]} {
3721 if {$thisSpan(align) != ""} {
3722 set cellAlign $thisSpan(align)
3724 if {$thisSpan(colSep) != ""} {
3725 set cellColSep $thisSpan(colSep)
3727 if {$thisSpan(rowSep) != ""} {
3728 set cellRowSep $thisSpan(rowSep)
3732 # overlay any attributes defined on the Row
3733 if {$rowDope(rowSep) != ""} {
3734 set cellRowSep $rowDope(rowSep)
3736 if {$rowDope(vAlign) != ""} {
3737 set cellVAlign $rowDope(vAlign)
3740 # check for a char other than "" or "."; just a check, we don't
3741 # do anything with char
3742 set char [CheckChar $char]
3744 # overlay any attributes defined on the Entry or EntryTbl - these
3747 set cellAlign $align
3749 if {$colSep != ""} {
3750 set cellColSep $colSep
3752 if {$rowSep != ""} {
3753 set cellRowSep $rowSep
3755 if {$vAlign != ""} {
3756 set cellVAlign $vAlign
3759 # if this cell is the first on the row, feed it the (possible)
3760 # Row ID and set the Row ID to ""
3761 if {[set cellId $rowDope(id)] == ""} {
3762 set cellId SDL-RESERVED[incr nextId]
3767 # now put the cell into the rowDope vector - if there's a
3768 # span, we'll put the cell in several slots; if there's a
3769 # vertical straddle, we may need to add more rows to rowDope
3770 if {$startColNum >= 0} {
3771 set stopRowNum [expr "$currentRow + $moreRows"]
3772 set spanLength [expr "($stopColNum - $startColNum) + 1"]
3773 set rowIndex $currentRow
3774 while {$rowIndex <= $stopRowNum} {
3775 if {![info exists rowDope(row$rowIndex)]} {
3776 set rowDope(row$rowIndex) [MakeEmptyRow $nCols]
3779 upvar 0 rowDope(row$rowIndex) thisRow
3780 set colIndex $startColNum
3781 while {$colIndex <= $stopColNum} {
3782 if {[lindex $thisRow $colIndex] != ""} {
3783 set badValMess1 "Multiple definitions for column"
3784 set badValMess2 "of row $rowIndex"
3786 "$badValMess1 [expr $colIndex + 1] $badValMess2" yes
3793 Replace thisRow $startColNum $spanLength $cellId
3798 # on the last column, the column separator should be 0; on the
3799 # last row, the row separator should be 0 - the table frame will
3800 # set the border on the right and bottom sides
3801 if {$stopColNum == $nCols} {
3804 if {$currentRow == $nRowDefs} {
3805 if {($grandparent == "TFOOT") ||
3806 (($grandparent == "TBODY") && (!$haveTFoot))} {
3811 # push a form to hold the RowSep
3812 if {$cellRowSep == 1} {
3813 set ssi "BORDER-BOTTOM"
3815 set ssi "BORDER-NONE"
3817 PushFormCell $ssi $cellId
3819 # build the SSI= for the cell and push a form to hold it
3820 if {$gi == "ENTRY"} {
3826 "" { append ssi "NONE-" }
3827 LEFT { append ssi "LEFT-" }
3828 RIGHT { append ssi "RIGHT-" }
3829 CENTER { append ssi "CENTER-" }
3830 JUSTIFY { append ssi "LEFT-" }
3831 CHAR { append ssi "CHAR-" }
3833 switch $cellColSep {
3834 0 { append ssi "NO-" }
3835 1 { append ssi "YES-" }
3837 switch $cellVAlign {
3839 NONE { append ssi "NONE" }
3840 TOP { append ssi "TOP" }
3841 MIDDLE { append ssi "MIDDLE" }
3842 BOTTOM { append ssi "BOTTOM" }
3844 PushForm CELL $ssi $id
3846 # if we are in an Entry, open a paragraph in case all that's in
3847 # the Entry are inline objects - this may end up in an empty P
3848 # if the Entry contains paragraph level things, e.g., admonitions,
3849 # lists or paragraphs; if we are an EntryTbl, set up the defaults
3850 # for the recursive calls to, e.g., THead or TBody
3851 if {$gi == "ENTRY"} {
3852 StartParagraph "" "" ""
3854 # the syntax would allow multiple TBODY in an ENTRYTBL but
3855 # we (and the rest of the SGML community, e.g., SGML/Open)
3856 # don't allow more than one - the transpec will keep us from
3857 # seeing the extras but we need to flag the error to the user
3858 if {$nTBodies != 1} {
3859 UserError "More than one TBODY in an ENTRYTBL" yes
3862 set entryTableAttributes(align) $align
3863 set entryTableAttributes(char) [CheckChar $char]
3865 # do a sanity check on the number of columns, there must be
3868 UserError "Unreasonable number of columns ($cols) in EntryTbl" yes
3871 set entryTableAttributes(cols) $cols
3873 if {$colSep == ""} {
3874 set entryTableAttributes(colSep) 1
3876 set entryTableAttributes(colSep) $colSep
3878 if {$rowSep == ""} {
3879 set entryTableAttributes(rowSep) 1
3881 set entryTableAttributes(rowSep) $rowSep
3884 # check for more COLSPECs than COLS - error if so
3885 if {$nColSpecs > $cols} {
3887 "More ColSpecs defined than columns in an EntryTbl" yes
3890 set numberOfColSpecs $nColSpecs
3892 set entryTableColSpecs ""
3894 # if no ColSpec definitions at this level, set them all to the
3895 # defaults - take advantage of the fact that the function ColSpec
3896 # will create default column specifications to fill out up to an
3897 # explicitly set ColNum
3898 if {$nColSpecs == 0} {
3899 ColSpec "" ENTRYTBL "" "" "" $cols "" "" ""
3902 # initialize a variable used to determine if we need a separate
3903 # FORM element for THead - if ColSpec elements are not given
3904 # at that level, it can go in the same FORM as the TBody and
3905 # we can guarantee that the columns will line up
3906 set needEntryTblTHeadForm 0
3908 # and initialize a variable to hold saved FROWVEC elements
3909 # across THead into TBody in case we are merging them into
3910 # one FORM element rather than putting each in its own
3911 set entryTableSavedFRowVec ""
3916 # end a table Entry - pop the form holding the cell
3917 # attributes and the form holding the RowSep
3924 # end a table EntryTbl - pop the form holding the cell
3925 # attributes and the form holding the RowSep and clean up the
3927 proc EndEntryTbl {} {
3928 global entryTableSpanSpecs numberOfColSpecs entryTableColSpecs
3933 if {[info exists entryTableSpanSpecs]} {
3934 unset entryTableSpanSpecs
3937 unset entryTableColSpecs
3940 ######################################################################
3941 ######################################################################
3945 ######################################################################
3946 ######################################################################
3948 # change the OutputString routine into one that will save the content
3949 # of this element for use as the man-page title, e.g., the "cat"
3950 # in "cat(1)"; this name may be overridden by RefDescriptor in
3951 # RefNameDiv if the sort name is different (e.g., "memory" for
3953 proc DivertOutputToManTitle {} {
3954 rename OutputString SaveManTitleOutputString
3955 rename ManTitleOutputString OutputString
3959 # change the output stream back to the OutputString in effect at the
3960 # time of the call to DivertOutputToManTitle
3961 proc RestoreOutputStreamFromManTitle {} {
3962 rename OutputString ManTitleOutputString
3963 rename SaveManTitleOutputString OutputString
3967 # a routine to buffer the output into the string "manTitle" for later
3968 # use in the top corners of man-pages
3969 proc ManTitleOutputString {string} {
3972 append manTitle $string
3976 # change the OutputString routine into one that will save the content
3977 # of this element for use as the man-page volume number, e.g., the "1"
3979 proc DivertOutputToManVolNum {} {
3980 rename OutputString SaveManVolNumOutputString
3981 rename ManVolNumOutputString OutputString
3985 # change the output stream back to the OutputString in effect at the
3986 # time of the call to DivertOutputToManVolNum
3987 proc RestoreOutputStreamFromManVolNum {} {
3988 rename OutputString ManVolNumOutputString
3989 rename SaveManVolNumOutputString OutputString
3993 # a routine to buffer the output into the string "manVolNum" for later
3994 # use in the top corners of man-pages
3995 proc ManVolNumOutputString {string} {
3998 append manVolNum $string
4002 # start a reference name division; nothing to emit now, just save
4003 # the number of names defined in this division and initialize the
4004 # current name count to 1
4005 proc StartRefNameDiv {nNames} {
4006 global numManNames currentManName
4008 set numManNames $nNames
4009 set currentManName 1
4013 # end a reference name division; we can now emit the HEAD elements to
4014 # create the titles in the upper corners and the "NAME" section of the
4016 proc EndRefNameDiv {id} {
4017 global manTitle manVolNum manDescriptor manNames manPurpose
4018 global localizedAutoGeneratedStringArray
4020 set manPageName $manTitle
4021 if {$manDescriptor != ""} {
4022 set manPageName $manDescriptor
4025 # emit the titles in the upper left and right corners
4026 Emit "<HEAD TYPE=\"LITERAL\" SSI=\"MAN-PAGE-TITLE-LEFT\">"
4027 Emit "${manPageName}($manVolNum)"
4029 Emit "<HEAD TYPE=\"LITERAL\" SSI=\"MAN-PAGE-TITLE-RIGHT\">"
4030 Emit "${manPageName}($manVolNum)"
4033 # and the NAME section
4035 Emit "<HEAD TYPE=\"LITERAL\" SSI=\"MAN-PAGE-DIVISION-NAME\">"
4037 Emit $localizedAutoGeneratedStringArray($message)
4039 StartBlock "" "MAN-PAGE-DIVISION" "" 1
4040 StartParagraph "" "" ""
4041 Emit "$manNames - $manPurpose"
4046 # change the OutputString routine into one that will save the content
4047 # of this element for use as the man-page descriptor, e.g., the
4048 # "string" in "string(3C)"
4049 proc DivertOutputToManDescriptor {} {
4050 rename OutputString SaveManDescriptorOutputString
4051 rename ManDescriptorOutputString OutputString
4055 # change the output stream back to the OutputString in effect at the
4056 # time of the call to DivertOutputToManDescriptor
4057 proc RestoreOutputStreamFromManDescriptor {} {
4058 rename OutputString ManDescriptorOutputString
4059 rename SaveManDescriptorOutputString OutputString
4063 # a routine to buffer the output into the string "manDescriptor" for
4064 # later use in the top corners of man-pages
4065 proc ManDescriptorOutputString {string} {
4066 global manDescriptor
4068 append manDescriptor $string
4072 # change the OutputString routine into one that will save the content
4073 # of this element for use as the man-page command or function name,
4074 # e.g., the "cat" in "cat(1)"
4075 proc DivertOutputToManNames {} {
4076 rename OutputString SaveManNamesOutputString
4077 rename ManNamesOutputString OutputString
4081 # change the output stream back to the OutputString in effect at the
4082 # time of the call to DivertOutputToManNames
4083 proc RestoreOutputStreamFromManNames {} {
4084 rename OutputString ManNamesOutputString
4085 rename SaveManNamesOutputString OutputString
4089 # a routine to buffer the output into the string "manNames" for
4090 # later use in the top corners of man-pages
4091 proc ManNamesOutputString {string} {
4094 append manNames $string
4098 # collect RefName elements into a single string; start diversion to
4099 # the string on the first man name
4100 proc StartAManName {} {
4101 global numManNames currentManName
4103 if {$currentManName == 1} {
4104 DivertOutputToManNames
4109 # end diversion on the last man name; append "(), " to each name but
4110 # the last to which we only append "()"
4111 proc EndAManName {} {
4112 global numManNames currentManName manDescriptor manNames
4114 if {($currentManName == 1) && ($manDescriptor == "")} {
4115 set manDescriptor $manNames
4118 if {$currentManName < $numManNames} {
4120 } elseif {$currentManName == $numManNames} {
4121 RestoreOutputStreamFromManNames
4128 # change the OutputString routine into one that will save the content
4129 # of this element for use as the man-page purpose; this string will
4130 # follow the function or command name(s) separated by a "-"
4131 proc DivertOutputToManPurpose {} {
4132 rename OutputString SaveManPurposeOutputString
4133 rename ManPurposeOutputString OutputString
4137 # change the output stream back to the OutputString in effect at the
4138 # time of the call to DivertOutputToManPurpose
4139 proc RestoreOutputStreamFromManPurpose {} {
4140 rename OutputString ManPurposeOutputString
4141 rename SaveManPurposeOutputString OutputString
4145 # a routine to buffer the output into the string "manPurpose" for
4146 # later use in the NAME section of man-pages
4147 proc ManPurposeOutputString {string} {
4150 append manPurpose $string
4154 # start a reference synopsis division - create a FORM to hold the
4155 # division and, potentially, any RefSect2-3; if there is a Title on
4156 # RefSynopsisDiv, use it, else default to "SYNOPSIS"
4157 proc StartRefSynopsisDiv {id haveTitle nSynopses} {
4158 global remainingSynopses
4159 global localizedAutoGeneratedStringArray
4161 set remainingSynopses $nSynopses
4164 StartManPageDivisionTitle ""
4165 set message "SYNOPSIS"
4166 Emit $localizedAutoGeneratedStringArray($message)
4167 EndManPageDivisionTitle
4172 # the user provided a title for this section, use it
4173 proc StartManPageDivisionTitle {id} {
4175 set id " ID=\"$id\""
4177 Emit "<HEAD$id TYPE=\"LITERAL\" SSI=\"MAN-PAGE-DIVISION-NAME\">"
4181 # the user provided a title for this section, we need to open a form
4182 # to hold the section now
4183 proc EndManPageDivisionTitle {} {
4185 PushForm "" "MAN-PAGE-DIVISION" ""
4188 # begin a Synopsis - if this is the first of any of the synopses, emit
4189 # a FORM to hold them all
4190 proc StartSynopsis {id linespecific} {
4191 if {$linespecific == ""} {
4196 StartParagraph id "" $type
4200 # end any of Synopsis, CmdSynopsis or FuncSynopsis - close out the
4201 # form if it's the last one
4202 proc EndSynopses {parent} {
4203 global remainingSynopses
4207 if {($parent == "REFSYNOPSISDIV") && ([incr remainingSynopses -1] == 0)} {
4213 # begin a CmdSynopsis
4214 proc StartCmdSynopsis {id} {
4215 StartParagraph id "" ""
4219 # start a man-page argument - surround the arg in a KEY element
4220 proc StartArg {id choice separator} {
4221 # mark this spot if there's a user supplied ID
4224 # emit nothing at start of list, v-bar inside of Group else space
4227 Emit "<KEY CLASS=\"NAME\" SSI=\"MAN-PAGE-ARG\">"
4228 if {$choice == "OPT"} {
4230 } elseif {$choice == "REQ"} {
4236 # end a man-page argument - if choice is not "plain", emit the proper
4237 # close character for the choice; if repeat is "repeat", emit an
4238 # ellipsis after the arg
4239 proc EndArg {choice repeat} {
4240 if {$choice == "OPT"} {
4242 } elseif {$choice == "REQ"} {
4245 if {$repeat == "REPEAT"} {
4246 Emit "<SPC NAME=\"\[hellip\]\">"
4252 # start an argument, filename, etc., group in a man-page command
4254 proc StartGroup {id choice separator} {
4255 # mark this spot if there's a user supplied ID
4258 # emit nothing at start of list, v-bar inside of Group else space
4261 # clean up optmult/reqmult since, for example, req+repeat == reqmult,
4262 # optmult and reqmult are redundant
4263 if {$choice == "OPTMULT"} {
4265 } elseif {$choice == "REQMULT"} {
4269 if {$choice == "OPT"} {
4271 } elseif {$choice == "REQ"} {
4277 # end an argument, filename, etc., group in a man-page command
4279 proc EndGroup {choice repeat} {
4280 # clean up optmult/reqmult since, for example, req+repeat == reqmult,
4281 # optmult and reqmult are redundant
4282 if {$choice == "OPTMULT"} {
4285 } elseif {$choice == "REQMULT"} {
4289 if {$choice == "OPT"} {
4291 } elseif {$choice == "REQ"} {
4294 if {$repeat == "REPEAT"} {
4295 Emit "<SPC NAME=\"\[hellip\]\">"
4300 # start a command name in a man-page command synopsis
4301 proc StartCommand {id separator} {
4302 # mark this spot if there's a user supplied ID
4305 # emit nothing at start of synopsis else space
4308 Emit "<KEY CLASS=\"NAME\" SSI=\"MAN-PAGE-COMMAND\">"
4312 # begin a FuncSynopsis
4313 proc StartFuncSynopsis {id} {
4317 # check that the GI of the element pointed to by a SynopFragmentRef
4318 # is really a SynopFragment
4319 proc CheckSynopFragmentRef {gi id} {
4320 if {$gi != "SYNOPFRAGMENT"} {
4321 set badValMess1 "SynopFragmentRef LinkEnd=$id"
4322 set badValMess2 "must refer to a SynopFragment"
4323 UserError "$badValMess1 $badValMess2" yes
4328 # begin a FuncSynopsisInfo - emit a P to hold it
4329 proc StartFuncSynopsisInfo {id linespecific} {
4330 if {$linespecific == "LINESPECIFIC"} {
4331 set type " TYPE=\"LINED\""
4336 StartParagraph $id "FUNCSYNOPSISINFO" $type
4340 # begin a FuncDef - emit a P to hold it
4341 proc StartFuncDef {id} {
4342 StartParagraph $id "FUNCDEF" ""
4346 # end a FuncDef, emit the open paren in preparation for the args
4347 proc EndFuncDef {} {
4352 # handle Void or Varargs in a FuncSynopsis - wrap it in a KEY and
4353 # emit the string "VOID" or "VARARGS"
4354 proc DoVoidOrVarargs {gi id} {
4355 # mark this spot if there's a user supplied ID
4358 Emit "<KEY CLASS=\"NAME\" SSI=\"FUNCDEF-ARGS\">"
4365 # start a ParamDef - just emit an anchor, if needed, for now
4366 proc StartParamDef {id} {
4367 # mark this spot if there's a user supplied ID
4372 # end of a ParamDef - emit either the ", " for the next one or, if the
4373 # last, emit the closing ")"
4374 proc EndParamDef {separator} {
4379 # start a FuncParams - just emit an anchor, if needed, for now
4380 proc StartFuncParams {id} {
4381 # mark this spot if there's a user supplied ID
4386 # end of a FuncParams - emit either the ", " for the next one or, if the
4387 # last, emit the closing ")"
4388 proc EndFuncParams {separator} {
4393 ######################################################################
4394 ######################################################################
4398 ######################################################################
4399 ######################################################################
4400 # open an intradocument link
4401 proc StartLink {id linkend type} {
4402 StartParagraphMaybe "" "P" $id
4404 Emit "<LINK RID=\"$linkend\""
4406 set type [string toupper $type]
4408 JUMPNEWVIEW {Emit " WINDOW=\"NEW\""}
4409 DEFINITION {Emit " WINDOW=\"POPUP\""}
4418 # defer a Link at the start of a Para until we see if the following
4419 # InlineGraphic has Role=graphic and we want it in a HEAD
4420 proc DeferLink {id linkend type} {
4423 set deferredLink(gi) LINK
4424 set deferredLink(id) $id
4425 set deferredLink(linkend) $linkend
4426 set deferredLink(type) $type
4430 # open an interdocument link; this link will require an SNB entry
4431 proc StartOLink {id localInfo type} {
4432 StartParagraphMaybe "" "P" $id
4434 set type [string toupper $type]
4436 set linkType CURRENT
4438 JUMP {set linkType CURRENT}
4439 JUMPNEWVIEW {set linkType NEW}
4441 DEFINITION {set linkType POPUP}
4444 set snbType CROSSDOC
4446 EXECUTE {set snbType SYS-CMD}
4447 APP-DEFINED {set snbType CALLBACK}
4448 MAN {set snbType MAN-PAGE}
4451 set snbId [AddToSNB $snbType $localInfo]
4453 Emit "<LINK RID=\"$snbId\""
4454 if {$linkType != "CURRENT"} {
4455 Emit " WINDOW=\"$linkType\""
4461 # defer an OLink at the start of a Para until we see if the following
4462 # InlineGraphic has Role=graphic and we want it in a HEAD
4463 proc DeferOLink {id localInfo type} {
4466 set deferredLink(gi) OLINK
4467 set deferredLink(id) $id
4468 set deferredLink(localinfo) $localinfo
4469 set deferredLink(type) $type
4473 # defer a ULink at the start of a Para until we see if the following
4474 # InlineGraphic has Role=graphic and we want it in a HEAD
4475 proc DeferULink {id} {
4478 set deferredLink(gi) ULINK
4479 set deferredLink(id) $id
4489 ######################################################################
4490 ######################################################################
4492 # character formatting
4494 ######################################################################
4495 ######################################################################
4496 # open a Quote; we'll emit two open single quotes wrapped in a
4497 # key with a style that will put them in a proportional font so they
4498 # fit together and look like an open double quote
4499 proc StartQuote {id} {
4500 Emit "<KEY CLASS=\"QUOTE\" SSI=\"PROPORTIONAL\">"
4505 # close a Quote; we'll emit two close single quotes wrapped in a
4506 # key with a style that will put them in a proportional font so they
4507 # fit together and look like a close double quote
4509 Emit "<KEY CLASS=\"QUOTE\" SSI=\"PROPORTIONAL\">''</KEY>"
4512 ######################################################################
4513 ######################################################################
4515 # end of document stuff
4517 ######################################################################
4518 ######################################################################
4520 # write out the .snb file - first update the file location for
4521 # insertion of the SNB by the second pass to reflect the addition
4522 # of the INDEX; also incorporate the INDEX and update the TOSS to
4523 # reflect any additions necessary to support tables
4525 global savedSNB indexLocation tossLocation baseName
4527 # get a handle for the index file and the existing .sdl file;
4528 # prepare to write the updated .sdl file and the .snb file by
4529 # blowing away the current names so the second open of the .sdl
4530 # file is creating a new file and we don't have leftover .snb
4531 # or .idx files laying around
4533 set sdlInFile [open "${baseName}.sdl" r]
4534 set sdlSize [file size "${baseName}.sdl"]
4536 set idxFile [open "${baseName}.idx" r]
4537 set idxSize [file size "${baseName}.idx"]
4539 exec rm -f ${baseName}.sdl ${baseName}.idx ${baseName}.snb
4540 set sdlOutFile [open "${baseName}.sdl" w]
4542 # create any additional TOSS entries made necessary by COLW and
4543 # COLJ settings for TGroup or EntryTbl elements.
4544 set toss [CreateTableTOSS]
4545 set tossSize [string length $toss]
4547 # get a list of the byte offsets into the .sdl file for the
4549 set snbLocations [lsort -integer [array names savedSNB]]
4551 # and write out the .snb file updating the locations as we go
4552 if {[llength $snbLocations] > 0} {
4553 set snbFile [open "${baseName}.snb" w]
4554 foreach location $snbLocations {
4555 puts $snbFile [expr "$location + $idxSize + $tossSize"]
4556 puts -nonewline $snbFile $savedSNB($location)
4561 # now update the toss and include the index file into the sdl file
4562 # by copying the old .sdl file to the new up to the location of
4563 # the first FORMSTYLE in the TOSS and emitting the new TOSS
4564 # entries then continue copying the old .sdl file up to the index
4565 # location and copying the .idx file to the new .sdl file followed
4566 # by the rest of the old .sdl file (the old .sdl and .idx files
4567 # have already been deleted from the directory), finally, close
4570 # 1: copy the sdl file up to the first FORMSTYLE element or, if
4571 # none, to just after the open tag for the TOSS
4572 set location $tossLocation
4574 while {$location > 0} {
4575 if {$location < $readSize} { set readSize $location }
4576 puts -nonewline $sdlOutFile [read $sdlInFile $readSize]
4577 incr location -$readSize
4579 # 2: emit the TOSS updates, if any
4580 puts -nonewline $sdlOutFile $toss
4581 # 3: copy the sdl file up to the index location
4582 set location [expr "$indexLocation - $tossLocation"]
4584 while {$location > 0} {
4585 if {$location < $readSize} { set readSize $location }
4586 puts -nonewline $sdlOutFile [read $sdlInFile $readSize]
4587 incr location -$readSize
4589 # 4: copy over the index file
4590 set location $idxSize
4592 while {$location > 0} {
4593 if {$location < $readSize} { set readSize $location }
4594 puts -nonewline $sdlOutFile [read $idxFile $readSize]
4595 incr location -$readSize
4597 # 5: and copy over the rest of the sdl file
4598 set location [expr "$sdlSize - $indexLocation"]
4600 while {$location > 0} {
4601 if {$location < $readSize} { set readSize $location }
4602 puts -nonewline $sdlOutFile [read $sdlInFile $readSize]
4603 incr location -$readSize
4605 # 6: close the output
4610 # read the global variable newTOSS and use the information to create
4611 # TOSS entries for THead, TBody and TFoot; these entries will contain
4612 # the justification and width information for the table sub-components;
4613 # return the new TOSS elements
4614 proc CreateTableTOSS {} {
4618 foreach ssi [array names newTOSS] {
4619 array set thisTOSSdata $newTOSS($ssi)
4620 set vAlign $thisTOSSdata(vAlign)
4624 TOP { set vJust "TOP" }
4625 MIDDLE { set vJust "CENTER" }
4626 BOTTOM { set vJust "BOTTOM" }
4629 append returnValue "<FORMSTYLE\n"
4630 append returnValue " CLASS=\"TABLE\"\n"
4631 append returnValue " SSI=\"$ssi\"\n"
4632 append returnValue \
4633 " PHRASE=\"TGroup, THead or TBody specification\"\n"
4634 append returnValue " COLW=\"$thisTOSSdata(colW)\"\n"
4635 append returnValue " COLJ=\"$thisTOSSdata(colJ)\"\n"
4637 append returnValue " VJUST=\"${vJust}-VJUST\"\n"
4639 append returnValue ">\n"
4646 # try to open a file named docbook.tss either in our current
4647 # directory or on TOSS_PATH - if it exists, copy it to
4648 # the output file as the TOSS - when the first line containing
4649 # "<FORMSTYLE" is seen, save the location so we can include the
4650 # updates to the TOSS necessary due to needing FORMSTYLE entries for
4651 # tables with the appropriate COLJ and COLW values
4652 proc IncludeTOSS {} {
4653 global tossLocation TOSS_PATH
4658 # look for docbook.tss in the current directory first, then on the path
4659 set path ". [split $TOSS_PATH :]"
4661 set tssFileName $dir/docbook.tss
4662 if {[file exists $tssFileName]} {
4669 if {[file readable $tssFileName]} {
4670 set tssFile [open $tssFileName r]
4671 set eof [gets $tssFile line]
4672 while {$eof != -1} {
4673 if {[string match "*<FORMSTYLE*" [string toupper $line]]} {
4674 set tossLocation [tell stdout]
4677 set eof [gets $tssFile line]
4681 UserError "$tssFileName exists but is not readable" no
4684 UserWarning "Could not find docbook.tss - continuing with null TOSS" no
4687 if {$tossLocation == -1} {
4688 set tossLocation [tell stdout]
4692 proc GetLocalizedAutoGeneratedStringArray {filename} {
4693 global localizedAutoGeneratedStringArray
4695 set buffer [ReadLocaleStrings $filename]
4697 set regExp {^(".*")[ ]*(".*")$} ;# look for 2 quoted strings
4699 set stringList [split $buffer \n]
4700 set listLength [llength $stringList]
4702 while {$listLength > 0} {
4703 set line [lindex $stringList $index]
4704 set line [string trim $line]
4705 if {([string length $line] > 0) && ([string index $line 0] != "#")} {
4706 if {[regexp $regExp $line match match1 match2]} {
4707 set match1 [string trim $match1 \"]
4708 set match2 [string trim $match2 \"]
4709 set localizedAutoGeneratedStringArray($match1) $match2
4712 "Malformed line in $filename line [expr $index + 1]" no
4719 set message "Home Topic"
4720 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4721 set localizedAutoGeneratedStringArray($message) $message
4723 set message "No home topic (PartIntro) was specified by the author."
4724 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4725 set localizedAutoGeneratedStringArray($message) $message
4728 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4729 set localizedAutoGeneratedStringArray($message) $message
4731 set message "See Also"
4732 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4733 set localizedAutoGeneratedStringArray($message) $message
4736 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4737 set localizedAutoGeneratedStringArray($message) $message
4739 set message "SYNOPSIS"
4740 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4741 set localizedAutoGeneratedStringArray($message) $message
4746 # start - initialize variables and write the preamble
4747 proc OpenDocument {host base date} {
4748 global docId baseName indexLocation snbLocation
4749 global validMarkArray partIntroId nextId
4750 global NO_UNIQUE_ID LOCALE_STRING_DIR
4751 global language charset
4753 # NO_UNIQUE_ID will be set to YES for test purposes so we don't
4754 # get spurious mismatches from the timestamp of from the system on
4755 # which the document was processed.
4756 if {[string toupper $NO_UNIQUE_ID] == "YES"} {
4764 GetLocalizedAutoGeneratedStringArray ${LOCALE_STRING_DIR}/strings
4766 # split out the language and charset info from LOCALE_STRING_DIR
4767 # first, remove any directory information
4768 set languageAndCharset [lindex [split $LOCALE_STRING_DIR /] end]
4769 # then split the language and charset at the dot
4770 set languageAndCharset [split $languageAndCharset .]
4771 # and extract the values from the resulting list
4772 set language [lindex $languageAndCharset 0]
4773 set charset [lindex $languageAndCharset 1]
4777 # set up the validMarkArray values
4780 # if we have a PartIntro element, use its ID as the first-page
4781 # attribute - if no ID, assign one; if no PartIntro, assign an
4782 # ID and we'll dummy in a hometopic when we try to emit the first
4784 if {![info exists partIntroId]} {
4787 if {$partIntroId == ""} {
4788 # set partIntroId SDL-RESERVED[incr nextId]
4789 set partIntroId SDL-RESERVED-HOMETOPIC
4793 Emit "<SDLDOC PUB-ID=\"CDE 2.1\""
4794 Emit " DOC-ID=\"$docId\""
4795 Emit " LANGUAGE=\"$language\""
4796 Emit " CHARSET=\"$charset\""
4797 Emit " FIRST-PAGE=\"$partIntroId\""
4798 Emit " TIMESTMP=\"$timeStamp\""
4799 Emit " SDLDTD=\"1.1.1\">\n"
4801 # and create the VSTRUCT - the INDEX goes in it, the SNB goes after
4802 # it; if there's a Title later, it'll reset the SNB location;
4803 # we also need to read in docbook.tss (if any) and to create an
4804 # empty TOSS to cause the second pass to replace docbook.tss with
4805 # <src file name>.tss (if any) in the new .sdl file
4806 Emit "<VSTRUCT DOC-ID=\"$docId\">\n"
4807 Emit "<LOIDS>\n</LOIDS>\n<TOSS>\n"
4810 set indexLocation [tell stdout]
4812 set snbLocation [tell stdout]
4816 # done - write the index and close the document
4817 proc CloseDocument {} {
4818 global inVirpage errorCount warningCount
4819 global snbLocation savedSNB currentSNB
4821 # close any open block and the current VIRPAGE
4823 Emit $inVirpage; set inVirpage ""
4825 # if the last VIRPAGE in the document had any system notation
4826 # block references, we need to add them to the saved snb array
4827 # before writing it out
4828 set names [array names currentSNB]
4829 if {[llength $names] != 0} {
4830 foreach name $names {
4831 # split the name into the GI and xid of the SNB entry
4832 set colonLoc [string first "::" $name]
4833 set type [string range $name 0 [incr colonLoc -1]]
4834 set data [string range $name [incr colonLoc 3] end]
4837 append tempSNB "<$type ID=\"$currentSNB($name)\" "
4845 TEXTFILE { set command "XID" }
4846 SYS-CMD { set command "COMMAND" }
4847 CALLBACK { set command "DATA" }
4849 append tempSNB "$command=\"$data\">\n"
4851 set savedSNB($snbLocation) $tempSNB
4855 # close the document and write out the stored index and system
4861 if {$errorCount || $warningCount} {
4862 puts stderr "DtDocBook total user errors: $errorCount"
4863 puts stderr "DtDocBook total user warnings: $warningCount"
4866 if {$errorCount > 0} {
4870 if {$warningCount > 0} {