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 # set up a default string compare routine so everything works even
127 # if run outside of instant(1); it won't really be i18n safe, but
128 # it'll give us a dictionary sort
129 if {[info commands CompareI18NStrings] == ""} {
130 proc CompareI18NStrings {string1 string2} {
131 set string1 [string toupper $string1]
132 set string2 [string toupper $string2]
133 if {$string1 > $string2} {
135 } else if {$string1 < $string2} {
144 # emit a string to the output stream
150 # push an item onto a stack (a list); return item pushed
151 proc Push {stack item} {
158 # pop an item from a stack (i.e., a list); return the popped item
163 InternalError "Stack underflow in Pop"
166 set item [lindex $s $top]
168 set s [lrange $s 0 $top]
173 # return the top of a stack (the stack is a list)
178 set item [lindex $s $top]
182 # replace the top of the stack with the new item; return the item
183 proc Poke {stack item} {
187 set s [lreplace $s $top $top $item]
192 # emit an ID and save it for reference as the most recently emitted ID;
193 # the saved value will be used to mark locations for index entries
197 set mostRecentId $name
198 return "ID=\"$name\""
202 # emit an ANCHOR into the SDL stream; if the passed id is empty, don't
206 Emit "<ANCHOR [Id $id]>"
211 # emit an ANCHOR into the SDL stream; if the passed id is empty, don't
212 # emit the anchor; if we're not in an SDL P yet, start one and use
213 # the id there rather than emitting an SDL ANCHOR
214 proc AnchorInP {id} {
219 StartParagraph $id "P" ""
221 Emit "<ANCHOR [Id $id]>"
227 # set up containers for the IDs of the blocks holding marks - clear
228 # on entry to each <virpage> but re-use within the <virpage> as much as
229 # possible; we need two each of the regular and loose versions because
230 # we need to alternate to avoid the <form> runtime code thinking we're
231 # trying to span columns
233 # specify a routine to (re-)initialize all the variables for use
235 proc ReInitPerMarkInfo {} {
236 global validMarkArray
238 foreach mark [array names validMarkArray] {
239 global FIRSTTIGHT${mark}Id
240 set FIRSTTIGHT${mark}Id ""
242 global FIRSTLOOSE${mark}Id
243 set FIRSTLOOSE${mark}Id ""
245 global TIGHT${mark}Id0
246 set TIGHT${mark}Id0 ""
248 global TIGHT${mark}Id1
249 set TIGHT${mark}Id1 ""
251 global LOOSE${mark}Id0
252 set LOOSE${mark}Id0 ""
254 global LOOSE${mark}Id1
255 set LOOSE${mark}Id1 ""
257 global TIGHT${mark}num
258 set TIGHT${mark}num 1
260 global LOOSE${mark}num
261 set LOOSE${mark}num 1
266 # add a new mark to the mark array and initialize all the variables
267 # that depend on the mark; the index for the mark is just the mark
268 # itself with the square brackets removed and whitespace deleted;
269 # we've already guaranteed that the mark will be of the form
270 # "[??????]" (open-square, 6 characters, close-square) and that this
271 # mark isn't in the array already
272 proc AddToMarkArray {mark} {
273 global validMarkArray
275 set m [string range $mark 1 6]
276 set m [string trim $m]
278 set validMarkArray($m) $mark
280 global FIRSTTIGHT${m}Id
281 set FIRSTTIGHT${m}Id ""
283 global FIRSTLOOSE${m}Id
284 set FIRSTLOOSE${m}Id ""
308 # start a new paragraph; start a block if necessary
309 proc StartParagraph {id ssi type} {
310 global inBlock firstPInBlock inP defaultParaType
312 # close any open paragraph
313 if {$inP} { Emit "</P>\n" }
315 # if not in a BLOCK, open one
316 if {$inBlock == ""} { StartBlock "" "" "" 1 }
319 if {$id != ""} { Emit " [Id $id]" }
321 # don't worry about whether we're the first para if there's no SSI
324 if {$firstPInBlock} {
330 Emit " SSI=\"$ssi$firstString\""
334 Emit $defaultParaType
336 Emit " TYPE=\"$type\""
342 set inBlock "</P>\n</BLOCK>\n"
346 # conditionally start a paragraph - that is, only start a new
347 # paragraph if we aren't in one already
348 proc StartParagraphMaybe {id ssi type} {
354 StartParagraph $id $ssi $type
359 # start a compound paragraph - a compound paragraph is when a Para
360 # contains some other element that requires starting its own SDL
361 # BLOCK or FORM, e.g., VariableList; we need to create a FORM to hold
362 # the Para and its parts - put the id and ssi on the FORM rather than
364 proc StartCompoundParagraph {id ssi type} {
368 if {$firstPInBlock} {
373 PushForm "" $ssi$firstString $id
378 StartParagraph "" "" ""
382 # given the path of parentage of an element, return its n'th ancestor
383 # (parent == 1), removing the child number (if any); e.g., convert
384 # "PART CHAPTER(0) TITLE" into "CHAPTER" if level is 2
385 proc Ancestor {path level} {
386 if {$level < 0} { return "_UNDERFLOW_" }
388 set last [llength $path]
391 if {$level > $last} { return "_OVERFLOW_" }
393 # invert "level" about "last" so we count from the end
394 set level [expr "$last - $level"]
396 set parent [lindex $path $level]
397 set parent [lindex [split $parent "("] 0] ;# remove child #
401 # start a HEAD element for the DocBook Title - use the parent's
402 # GI in the SSI= of the HEAD except that all titles to things in
403 # their own topic (VIRPAGE) will use an SSI of CHAPTER-TITLE;
404 # if we are in a topic with a generated id (e.g., _glossary or
405 # _title), we might have saved an id or two in savedId to be
406 # emitted in the HEAD
407 proc Title {id parent} {
408 global virpageLevels partID inP savedId
416 # if we are the Title of a PartIntro, we'd like to emit the
417 # partID as an anchor so linking to the volume will succeed;
418 # add it to the list of saved ids to be emitted
419 if {$parent == "PARTINTRO"} {
420 lappend savedId $partID
423 # make the HEAD for all topics (VIRPAGE) have an SSI of
424 # "CHAPTER-HEAD", use LEVEL to distinguish between them
425 set topicNames [array names virpageLevels]
426 foreach name $topicNames {
427 if {$parent == $name} {
433 Emit " SSI=\"$parent-TITLE\">"
435 # being in a HEAD is equivalent to being in a P for content model
436 # but we use "incr" instead of setting inP directly so that if we
437 # are in a P->HEAD, we won't prematurely clear inP when leaving
441 if {[info exists savedId]} {
442 foreach id $savedId {
450 # close a HEAD element for a DocBook Title - if the Title is one for
451 # a DocBook element that gets turned into an SDL VIRPAGE, set the
452 # location for the insertion of an SNB (if any) to follow the HEAD
453 proc CloseTitle {parent} {
454 global snbLocation virpageLevels inP
458 # we incremented inP on entry to the HEAD so decrement it here
461 # get a list of DocBook elements that start VIRPAGEs
462 set names [array names virpageLevels]
464 # add the start of the help volume, PART, to the list
467 # if our parent is a VIRPAGE creator or the start of the document,
468 # we must be dealing with the heading of a VIRPAGE or with the
469 # heading of the SDLDOC so move the spot where we want to include
470 # the SNB to immediately after this HEAD
471 foreach name $names {
472 if {$name == $parent} {
473 set snbLocation [tell stdout]
480 # open an SGML tag - add punctuation as guided by the class attribute
481 proc StartSgmlTag {id class} {
483 ELEMENT {set punct "&<"}
484 ATTRIBUTE {set punct ""}
485 GENENTITY {set punct "&&"}
486 PARAMENTITY {set punct "%"}
492 # close an SGML tag - add punctuation as guided by the class attribute
493 proc EndSgmlTag {class} {
495 ELEMENT {set punct ">"}
496 ATTRIBUTE {set punct ""}
497 GENENTITY {set punct ";"}
498 PARAMENTITY {set punct ";"}
504 # end a trademark, append a symbol if needed
505 proc EndTradeMark {class} {
507 SERVICE {set punct ""}
508 TRADE {set punct "<SPC NAME=\"\[trade \]\">"}
509 REGISTERED {set punct "<SPC NAME=\"\[reg \]\">"}
510 COPYRIGHT {set punct "<SPC NAME=\"\[copy \]\">"}
516 # handle the BridgeHead tag; emit a FORM to hold a HEAD and put the
517 # BridgeHead there - use the procedure Title to do all the work, the
518 # renderas attributre simply become the parent to Title
519 proc StartBridgeHead {id renderas} {
522 # default renderas to CHAPTER - arbitrarily
523 if {$renderas == "OTHER"} {
530 # end a BridgeHead; we need to close out the SDL HEAD and close the
531 # FORM - use CloseTitle to close out the HEAD but give it a null
532 # parent so it doesn't try to save the SNB now
533 proc EndBridgeHead {} {
540 proc EndParagraph {} {
547 # we set inBlock to </P></BLOCK> in StartParagraph so we need
548 # to remove the </P> here; if we're continuing a paragraph
549 # inBlock will have been set to "" when we closed the BLOCK to
550 # open the embedded FORM so we need to leave it empty to cause
551 # a new BLOCK to be opened
552 if {$inBlock != ""} {
553 set inBlock "</BLOCK>\n"
556 # and flag that we're not in a paragraph anymore
561 # continue a PARA that was interrupted by something from %object.gp;
562 # first pop the FORM that held the indent attributes for the object
563 # then start a new paragraph with an SSI that indicates we are
565 proc ContinueParagraph {} {
567 StartParagraph "" "P-CONT" ""
571 # start a new BLOCK element; close the old one, if any;
572 # return the ID in case we allocated one and someone else wants it
573 proc StartBlock {class ssi id enterInForm} {
574 global needFData inBlock formStack nextId firstPInBlock inP
576 # if we are the first BLOCK in a FORM, emit the FDATA tag
577 Emit $needFData; set needFData ""
579 # close any open block and flag that we're opening one
580 # but that we haven't seen a paragraph yet
582 set inBlock "</BLOCK>\n"
585 # if a FORM is in progress, add our ID to the row vector,
586 # FROWVEC - create an ID if one wasn't provided
587 if {$enterInForm && [llength $formStack] != 0} {
588 if {$id == ""} { set id "SDL-RESERVED[incr nextId]" }
594 if {$id != ""} { Emit " [Id $id]" }
595 if {$class != ""} { Emit " CLASS=\"$class\"" }
596 if {$ssi != ""} { Emit " SSI=\"$ssi\"" }
599 # and flag that the next paragraph is the first in a block
606 # close any open BLOCK - no-op if not in a BLOCK otherwise emit the
607 # BLOCK etag or both BLOCK and P etags if there's an open paragraph
611 if {$inBlock != ""} {
612 Emit $inBlock ;# has been prefixed with </P> if needed
619 # add another FROWVEC element to the top of the form stack
620 proc AddRowVec {ids} {
623 Push formStack "[Pop formStack]<FROWVEC CELLS=\"$ids\">\n"
627 # start a new FORM element within a THead, TBody or TFoot ("push"
628 # because they're recursive); return the ID in case we allocated one;
629 # do not enter the ID in the parent's FROWVEC, we'll do that later
630 # from the rowDope that we build to compute horizontal spans and
632 proc PushFormCell {ssi id} {
633 global needFData formStack nextId
635 Emit $needFData ;# in case we're the first in an old FORM
636 set needFData "<FDATA>\n" ;# and were now starting a new FORM
638 # close any open BLOCK
641 # make sure we have an ID
642 if {$id == ""} { set id "SDL-RESERVED[incr nextId]" }
644 # add a new (empty) string to the formStack list (i.e., push)
648 if {$id != ""} { Emit " [Id $id]" }
649 Emit " CLASS=\"CELL\""
650 if {$ssi != ""} { Emit " SSI=\"$ssi\"" }
657 # start a new FORM element ("push" because they're recursive);
658 # return the ID in case we allocated one
659 proc PushForm {class ssi id} {
660 global needFData formStack nextId
662 Emit $needFData ;# in case we're the first in an old FORM
663 set needFData "<FDATA>\n" ;# and were now starting a new FORM
665 # close any open BLOCK
668 if {[llength $formStack] != 0} {
669 # there is a <form> in progress
670 if {$id == ""} { set id "SDL-RESERVED[incr nextId]" }
674 # add a new (empty) string to the formStack list (i.e., push)
678 if {$id != ""} { Emit " [Id $id]" }
679 if {$class != ""} { Emit " CLASS=\"$class\"" }
680 if {$ssi != ""} { Emit " SSI=\"$ssi\"" }
687 # start a new FORM element to hold a labeled list item ("push"
688 # because they're recursive), adding it to an already open two
689 # column FORM, if any; we assume the first ID is the block holding
690 # the label and always defined on entry but we return the second
691 # ID in case we allocated one
692 proc PushFormItem {ssi id1 id2} {
693 global needFData formStack nextId
695 Emit $needFData ;# in case we're the first in an old FORM
696 set needFData "<FDATA>\n" ;# and were now starting a new FORM
698 # close any open BLOCK
701 if {$id2 == ""} { set id2 "SDL-RESERVED[incr nextId]" }
703 if {[llength $formStack] != 0} {
704 # there is a <form> in progress
705 if {$id2 == ""} { set id2 "SDL-RESERVED[incr nextId]" }
706 AddRowVec "$id1 $id2"
709 # add a new (empty) string to the formStack list (i.e., push)
712 Emit "<FORM [Id $id2] CLASS=\"ITEM\""
713 if {$ssi != ""} { Emit " SSI=\"$ssi\"" }
720 # close out a THead, TBody or TFoot; create the FROWVEC from the
721 # rowDope - save it if we aren't popping the FORM yet (which happens
722 # if no ColSpec elements were given at the THead or TFoot level and
723 # we're merging one, the other or both with the TBody), emit the
724 # saved ROWVEC, if any, and newly created one if we are popping the
725 # FORM in which case we also want to blow away the top of the
726 # formStack; we can also blow away the current rowDope here since
727 # we write or save the FROWVEC and we're done with the dope vector
728 proc PopTableForm {parent gi popForm} {
731 # get the proper row descriptor(s) and number of columns
732 if {$parent == "ENTRYTBL"} {
733 upvar #0 entryTableRowDope rowDope
734 upvar #0 entryTableSavedFRowVec fRowVec
735 global entryTableAttributes
736 set nCols $entryTableAttributes(cols)
738 upvar #0 tableGroupRowDope rowDope
739 upvar #0 tableGroupSavedFRowVec fRowVec
740 global tableGroupAttributes
741 set nCols $tableGroupAttributes(cols)
744 # flush the unused formStack entry if we're actually popping
749 # determine whether we are a "header", i.e., inside a TFoot or
751 if {$gi == "TBODY"} {
754 set hdr " HDR=\"YES\""
757 # if actually popping the FORM here (i.e., writing the FSTYLE),
758 # emit the FSTYLE wrapper
760 Emit "</FDATA>\n<FSTYLE"
762 Emit " NCOLS=\"$nCols\""
767 set nRows $rowDope(nRows)
768 while {$currentRow <= $nRows} {
769 append fRowVec "<FROWVEC$hdr CELLS=\""
770 append fRowVec $rowDope(row$currentRow)
771 append fRowVec "\">\n"
775 # if actually popping the FORM here (i.e., writing the FSTYLE),
776 # emit the FROWVEC elements, zero out the saved fRowVec and close
781 Emit "</FSTYLE>\n</FORM>\n"
786 # close out one FORM on the stack; if there hasn't been a block added
787 # to the FORM, create an empty one to make it legal SDL
791 if {[Peek formStack] == ""} {
792 # oops, empty FROWVEC means empty FORM so add an empty BLOCK
793 StartBlock "" "" "" 1
796 # close any open BLOCK
799 # write out the saved FROWVEC information wrapped in an FSTYLE
800 set openStyle "</FDATA>\n<FSTYLE>\n"
801 set closeStyle "</FSTYLE>\n</FORM>"
802 Emit "$openStyle[Pop formStack]$closeStyle\n"
806 # close out one N columned FORM on the stack; if there hasn't been a
807 # block added to the FORM, create an empty one to make it legal SDL
808 proc PopFormN {nCols} {
811 if {[Peek formStack] == ""} {
812 # oops, empty FROWVEC means empty FORM so add an empty BLOCK
813 # and bring this down to a single column FORM containing only
815 StartBlock "" "" "" 1
819 # close any open BLOCK
822 # write out the saved FROWVEC information wrapped in an FSTYLE
823 set openStyle "</FDATA>\n<FSTYLE NCOLS=\"$nCols\">\n"
824 set closeStyle "</FSTYLE>\n</FORM>"
825 Emit "$openStyle[Pop formStack]$closeStyle\n"
829 # check the Role attribute on lists to verify that it's either "LOOSE"
830 # or "TIGHT"; return upper cased version of verified Role
831 proc CheckSpacing {spacing} {
832 set uSpacing [string toupper $spacing]
835 TIGHT {return $uSpacing}
837 UserError "Bad value (\"$role\") for Role attribute in a list" yes
842 # start a simple list - if Type is not INLINE, we need to save the
843 # Ids of the BLOCKs we create and lay them out in a HORIZONTAL or
844 # VERTICAL grid when we have them all
845 proc StartSimpleList {id type spacing parent} {
846 global listStack firstString
848 if {$type == "INLINE"} {
849 StartParagraphMaybe $id P ""
851 # if we are inside a Para, we need to issue a FORM to hang the
852 # indent attributes on
853 if {$parent == "PARA"} {
854 PushForm "" "INSIDE-PARA" ""
857 # insure "spacing" is upper case and valid (we use it in the SSI)
858 set spacing [CheckSpacing $spacing]
860 # save the list type and spacing for use by <Member>;
861 set listDope(type) simple
862 set listDope(spacing) $spacing
863 Push listStack [array get listDope]
865 PushForm LIST SIMPLE-$spacing $id
866 set firstString "FIRST-"
871 # end a simple list - if Type was INLINE, we're done, otherwise, we
872 # need to lay out the grid based on Type and Columns
873 proc EndSimpleList {columns type parent} {
874 global listStack lastList listMembers
877 UserWarning "must have at least one column in a simple list" yes
881 if {$type != "INLINE"} {
882 # get the most recently opened list and remove it from the stack
883 array set lastList [Pop listStack]
885 # calculate the number of rows and lay out the BLOCK ids
886 # as per the type attribute
887 set length [llength $listMembers]
888 set rows [expr ($length + $columns - 1) / $columns]
892 if {$type == "HORIZ"} {
895 set ids [lrange $listMembers $c [incr c $cols]]
901 set lastRowLength [expr $cols - (($rows * $cols) - $length)]
903 while {$r <= $rows} {
908 set cols $lastRowLength
911 lappend ids [lindex $listMembers $i]
913 if {$c < $lastRowLength} {
924 # close the open FORM using the newly generated ROWVECs
927 # if we are inside a Para, we need to close the FORM we issued for
928 # hanging the indent attributes
929 if {$parent == "PARA"} {
936 # collect another Member of a SimpleList; if we're a Vert(ical) or
937 # Horiz(ontal) list, don't put the BLOCK's id on the list's FORM
938 # yet - we need to collect them all and lay them out afterward in
939 # EndSimpleList; if we're an Inline list, don't create a BLOCK, we'll
940 # add punctuation to separate them in EndMember
941 proc StartMember {id type} {
942 global nextId listStack firstString listMembers
944 if {$type == "INLINE"} {
947 # put it in a BLOCK, make sure we have an id and add it to
948 # the list of members
950 set id SDL-RESERVED[incr nextId]
952 lappend listMembers $id
954 # get the current list info
955 array set listTop [Peek listStack]
956 set spacing $listTop(spacing)
958 # use an SSI of, e.g., FIRST-LOOSE-SIMPLE
959 StartBlock ITEM $firstString$spacing-SIMPLE $id 0
960 StartParagraph "" P ""
966 # end a SimpleList Member; if it's an Inline list, emit the
967 # punctuation ("", ", " or "and") based on the position of the
968 # Member in the list - otherwise, do nothing and the StartBlock from
969 # the next Member or the PopFormN in EndSimpleList will close the
971 proc EndMember {type punct} {
972 if {$type == "INLINE"} {
978 # check the value of a ITEMIZEDLIST MARK - issue warning and default
979 # it to BULLET if it's unrecognized
980 proc ValidMark {mark} {
981 global validMarkArray
983 if {[string toupper $mark] == "PLAIN"} { return PLAIN }
985 # if an SDATA entity was used, it'll have spurious "\|" at the
986 # beginning and the end added by [n]sgmls
987 if {[string match {\\|????????\\|} $mark]} {
988 set mark [string range $mark 2 9]
991 if {![string match {\[??????\]} $mark]} {
992 UserError "Unknown list mark \"$mark\" specified, using PLAIN" yes
995 foreach m [array names validMarkArray] {
996 if {$validMarkArray($m) == $mark} {return $m}
998 return [AddToMarkArray $mark]
1003 # start an itemized list
1004 proc ItemizedList {id mark spacing parent} {
1005 global listStack firstString
1007 # if we are inside a Para, we need to issue a FORM to hang the
1008 # indent attributes on
1009 if {$parent == "PARA"} {
1010 PushForm "" "INSIDE-PARA" ""
1013 # make sure we recognize the mark
1014 set mark [ValidMark $mark]
1016 # insure "spacing" is upper case and valid (we use it in the SSI)
1017 set spacing [CheckSpacing $spacing]
1019 # save the list type, mark and spacing for use by <ListItem>
1020 set listDope(type) itemized
1021 set listDope(spacing) $spacing
1022 set listDope(mark) $mark
1023 Push listStack [array get listDope]
1025 # create a FORM to hold the list items
1026 if {$mark == "PLAIN"} {
1027 PushForm LIST "PLAIN-$spacing" $id
1029 PushForm LIST "MARKED-$spacing" $id
1032 set firstString "FIRST-"
1036 # turn absolute item count into proper list number e.g., 2, B, or II
1037 proc MakeOrder {numeration count} {
1038 global ROMAN0 ROMAN10 ROMAN100
1039 global roman0 roman10 roman100
1040 global ALPHABET alphabet
1041 global NZDIGITS DIGITS
1043 if {$count == ""} { return "" }
1045 if {$count > 999} { set count 999 } ;# list too big - cap it
1047 # initialize the 3 digits of the result value
1052 # first get the 3 digits in the proper base (26 or 10)
1053 switch -exact $numeration {
1056 set c3 [expr "$count % 26"]
1057 if {$c3 == 0} { set c3 26 }
1058 if {[set count [expr "$count / 26"]]} {
1059 set c2 [expr "$count % 26"]
1060 if {$c2 == 0} { set c2 26 }
1061 set c1 [expr "$count / 26"]
1067 set c3 [expr "$count % 10"]
1068 if {[set count [expr "$count / 10"]]} {
1069 set c2 [expr "$count % 10"]
1070 if {[set count [expr "$count / 10"]]} {
1071 set c1 [expr "$count % 10"]
1077 # then point to proper conversion list(s)
1078 switch -exact $numeration {
1080 set c1List $ALPHABET
1081 set c2List $ALPHABET
1082 set c3List $ALPHABET
1085 set c1List $alphabet
1086 set c2List $alphabet
1087 set c3List $alphabet
1092 set c1List $ROMAN100
1097 set c1List $roman100
1104 set c1List $NZDIGITS
1106 set c2List $NZDIGITS
1112 # and do the conversion
1113 set string [lindex $c1List $c1]
1114 append string [lindex $c2List $c2]
1115 append string [lindex $c3List $c3]
1122 # start an ordered list
1123 proc OrderedList {id numeration inheritNum continue spacing parent} {
1124 global listStack lastList firstString
1126 # if we are inside a Para, we need to issue a FORM to hang the
1127 # indent attributes on
1128 if {$parent == "PARA"} {
1129 PushForm "" "INSIDE-PARA" ""
1132 # make sure the INHERIT param is compatible with enclosing list
1133 if {$inheritNum == "INHERIT"} {
1134 if {[llength $listStack] > 0} {
1135 array set outerList [Peek listStack]
1136 if {$outerList(type) != "ordered"} {
1137 UserError "Can only inherit numbering from an ordered list" yes
1138 set inheritNum IGNORE
1142 "Attempt to inherit a list number with no previous list" yes
1143 set inheritNum IGNORE
1147 # make sure the CONTINUE param is compatible with previous list;
1148 # also inherit numeration here if unset (else error if different)
1149 # and we're continuing
1150 if {$continue == "CONTINUES"} {
1151 if {![array exists lastList]} {
1152 # nothing to inherit from
1153 UserError "Attempt to continue a list with no previous list" yes
1154 set continue RESTARTS
1155 } elseif {$lastList(type) != "ordered"} {
1156 UserError "Only ordered lists can be continued" yes
1157 set continue RESTARTS
1158 } elseif {$numeration == ""} {
1159 set numeration $lastList(numeration)
1160 } elseif {$lastList(numeration) != $numeration} {
1161 UserError "Can't continue a list with different numeration" yes
1162 set continue RESTARTS
1166 # if no numeration specified, default to Arabic
1167 if {$numeration == ""} {
1168 set numeration ARABIC
1171 set count 0 ;# assume we are restarting the item count
1172 set inheritString "" ;# fill in later if set
1174 if {$continue == "CONTINUES"} {
1175 # continuing means use the old inherit string (if any) and
1176 # pick up with the old count
1177 set count $lastList(count)
1178 if {($lastList(inheritString) != "") && ($inheritNum != "INHERIT")} {
1180 "Must continue inheriting if continuing list numbering" yes
1181 set inheritNum INHERIT
1185 if {$inheritNum == "INHERIT"} {
1186 # inheriting a string to preface the current number - e.g., "A.1."
1187 set inheritString $outerList(inheritString)
1188 append inheritString \
1189 [MakeOrder $outerList(numeration) $outerList(count)]
1192 # insure "spacing" is upper case and valid (we use it in the SSI)
1193 set spacing [CheckSpacing $spacing]
1195 # save the list type and spacing for use by <ListItem>
1196 set listDope(type) ordered
1197 set listDope(spacing) $spacing
1198 set listDope(numeration) $numeration
1199 set listDope(inheritString) $inheritString
1200 set listDope(count) $count
1201 Push listStack [array get listDope]
1203 # create a FORM to hold the list items
1204 PushForm LIST "ORDER-$spacing" $id
1206 set firstString "FIRST-"
1210 # start a variable list (i.e., labeled list)
1211 proc VariableList {id role parent} {
1212 global listStack firstString
1214 # if we are inside a Para, we need to issue a FORM to hang the
1215 # indent attributes on
1216 if {$parent == "PARA"} {
1217 PushForm "" "INSIDE-PARA" ""
1220 # parse out the possible role values (loose/tight and
1222 set role [split [string toupper $role]]
1223 set role1 [lindex $role 0]
1225 set length [llength $role]
1227 set role2 [lindex $role 1]
1230 UserError "Too many values (> 2) for Role in a VARIABLELIST" yes
1236 TIGHT {set spacing $role1}
1238 NOWRAP {set wrap $role1}
1239 default {UserError "Bad value for Role ($role1) in a VARIABLELIST" yes
1245 TIGHT {if {$spacing == ""} {
1248 UserError "Only specify LOOSE/TIGHT once per Role" yes
1252 NOWRAP {if {$wrap == ""} {
1255 UserError "Only specify WRAP/NOWRAP once per Role" yes
1258 default {UserError "Bad value for Role ($role2) in a VARIABLELIST" yes
1261 if {$spacing == ""} {
1268 # insure "spacing" is upper case and valid (we use it in the SSI)
1269 set spacing [CheckSpacing $spacing]
1271 # save the list type and spacing for use by <ListItem>;
1272 # also save a spot for the current label ID
1273 set listDope(type) variable
1274 set listDope(spacing) $spacing
1275 set listDope(labelId) $id
1276 set listDope(wrap) $wrap
1277 Push listStack [array get listDope]
1279 # create a FORM to hold the list items
1280 PushForm LIST "VARIABLE-$spacing" $id
1282 set firstString "FIRST-"
1286 # open a variable list entry - create a BLOCK to hold the term(s)
1287 proc VarListEntry {id} {
1288 global firstString listStack nextId
1290 # get the list spacing, i.e., TIGHT or LOOSE
1291 array set listDope [Peek listStack]
1292 set spacing $listDope(spacing)
1294 # make sure we have an ID for the label (it goes in a FORM)
1295 # save the ID for use in PushFormItem
1297 set id SDL-RESERVED[incr nextId]
1299 array set listDope [Pop listStack]
1300 set listDope(labelId) $id
1301 Push listStack [array get listDope]
1303 StartBlock ITEM "$firstString$spacing-TERMS" $id 0
1306 # process a term in a variablelist
1307 proc StartTerm {id} {
1310 # get the current list info
1311 array set listTop [Peek listStack]
1312 set wrap $listTop(wrap)
1315 if {$wrap == "NOWRAP"} {
1319 StartParagraph $id "P" $lined
1323 # process an item in an ordered, variable or itemized list
1324 proc ListItem {id override} {
1325 global listStack firstString nextId needFData validMarkArray
1327 # get the current list info
1328 array set listTop [Peek listStack]
1329 set spacing $listTop(spacing)
1331 # if it's an itemized list, are we overriding the mark?
1332 if {$listTop(type) == "itemized"} {
1333 if {$override == "NO"} {
1334 set mark $listTop(mark)
1335 } elseif {$override == ""} {
1338 set mark [ValidMark $override]
1342 if {($listTop(type) == "itemized") && ($mark != "PLAIN")} {
1343 # marked itemized list, try to reuse an existing mark <BLOCK>
1344 if {$firstString == ""} {
1345 # not a FIRST, calculate the next id index - we flip
1346 # between 0 and 1 to avoid column span in viewer
1347 set numName $spacing${mark}num ;# get index name
1348 upvar #0 $numName idNum
1349 set idNum [expr "-$idNum + 1"] ;# flip it
1351 if {$firstString != ""} {
1352 set idName FIRST$spacing${mark}Id
1354 set idName $spacing${mark}Id$idNum
1356 upvar #0 $idName labelId
1357 if {$labelId == ""} {
1358 # need to create a <BLOCK> and save the id
1359 set labelId "SDL-RESERVED[incr nextId]"
1360 Emit $needFData; set needFData ""
1361 Emit "<BLOCK [Id $labelId] CLASS=\"ITEM\""
1362 Emit " TIMING=\"ASYNC\" "
1363 Emit "SSI=\"$firstString$spacing-MARKED\""
1364 Emit ">\n<P SSI=\"P1\"><SPC NAME=\"$validMarkArray($mark)\""
1365 Emit "></P>\n</BLOCK>\n"
1369 # emit the SSI and label for an ordered list
1370 if {$listTop(type) == "ordered"} {
1371 # start a block for the label
1372 set labelId "SDL-RESERVED[incr nextId]"
1373 Emit $needFData; set needFData ""
1374 Emit "<BLOCK [Id $labelId] CLASS=\"ITEM\" SSI=\""
1376 # create, e.g., FIRST-LOOSE-ORDERED
1377 Emit "$firstString$spacing-ORDERED\">\n"
1379 # emit the label (inherit string followed by order string)
1380 # and close the block
1381 Emit "<P SSI=\"P1\">"
1382 Emit $listTop(inheritString)
1383 Emit [MakeOrder $listTop(numeration) [incr listTop(count)]]
1384 Emit "</P>\n</BLOCK>\n"
1386 # then update the top of the list stack
1387 Poke listStack [array get listTop]
1390 # or just get the label id for a variable (labeled) list - the
1391 # label was emitted in another production
1392 if {$listTop(type) == "variable"} {
1393 set labelId $listTop(labelId)
1396 # emit a one (for PLAIN) or two column FORM to wrap this list item
1397 set ssi "$firstString$spacing"
1398 if {($listTop(type) == "itemized") && ($mark == "PLAIN")} {
1399 PushForm ITEM $ssi $id
1401 PushFormItem $ssi $labelId $id
1407 # start a segmented list, e.g.,
1413 proc SegmentedList {id spacing parent} {
1414 global listStack firstString
1416 # if we are inside a Para, we need to issue a FORM to hang the
1417 # indent attributes on
1418 if {$parent == "PARA"} {
1419 PushForm "" "INSIDE-PARA" ""
1422 # insure "spacing" is upper case and valid (we use it in the SSI)
1423 set spacing [CheckSpacing $spacing]
1425 # save the list type and spacing for use by <ListItem>;
1426 set listDope(type) segmented
1427 set listDope(spacing) $spacing
1428 Push listStack [array get listDope]
1430 # create a FORM to hold the list items
1431 PushForm LIST "SEGMENTED-$spacing" $id
1433 set firstString "FIRST-"
1436 # emit the SegTitle elements, each in its own BLOCK - we'll reuse
1437 # them on each Seg of each SegListItem
1438 proc StartSegTitle {id} {
1439 global firstString listStack segTitleList nextId
1441 # get the list spacing, i.e., TIGHT or LOOSE
1442 array set listDope [Peek listStack]
1443 set spacing $listDope(spacing)
1445 # make sure we have an ID for the label (it goes in a FORM)
1446 # save the ID for use in PushFormItem
1448 set id SDL-RESERVED[incr nextId]
1450 lappend segTitleList $id
1452 # start the block but don't put in on the FORM, we'll put this
1453 # BLOCK and the one containing the SegListItem.Seg into a two
1455 StartBlock ITEM "$firstString$spacing-SEGTITLE" $id 0
1458 StartParagraph "" SEGTITLE ""
1462 # start a SegListItem - save the id (if any) of the SegListItem to
1463 # be emitted as an anchor in the first Seg
1464 proc StartSegListItem {id} {
1465 global segListItemNumber segListItemId firstString
1467 set segListItemId $id
1468 set segListItemNumber 0
1469 set firstString "FIRST-"
1473 # process a Seg in a SegListItem - get the corresponding SegTitle ID
1474 # and create a BLOCK for the item then put the pair into the FORM that
1475 # was created back in SegmentedList
1476 proc StartSeg {id isLastSeg} {
1477 global segTitleList segListItemNumber segListItemId firstString
1478 global listStack nextId
1480 set nTitles [llength $segTitleList]
1481 if {$segListItemNumber >= $nTitles} {
1483 "More Seg than SegTitle elements in a SegmentedList" yes
1487 if {[expr "$segListItemNumber" + 1] != $nTitles} {
1489 "More SegTitle than Seg elements in a SegmentedList" yes
1493 # get the current list info
1494 array set listTop [Peek listStack]
1495 set spacing $listTop(spacing)
1497 # open a BLOCK and P to hold the Seg content; put any user
1498 # supplied Id on the BLOCK and the saved segListItem Id (if
1502 set itemId "SDL-RESERVED[incr nextId]"
1504 StartBlock ITEM $firstString$spacing $itemId 0
1506 StartParagraph $segListItemId P ""
1507 set segListItemId ""
1509 # we've already guaranteed that we don't overflow the list
1510 set titleId [lindex $segTitleList $segListItemNumber]
1511 incr segListItemNumber
1513 # add the title and item to a row vector (FROWVEC)
1514 AddRowVec "$titleId $itemId"
1519 proc EndList {parent} {
1520 global listStack lastList
1522 # get the most recently opened list and remove it from the stack
1523 array set lastList [Pop listStack]
1525 if {($lastList(type) == "itemized") && ($lastList(mark) == "PLAIN") } {
1531 # if we are inside a Para, we need to close the FORM we issued for
1532 # hanging the indent attributes
1533 if {$parent == "PARA"} {
1539 # start a super- or sub-scripted phrase; if there's an ID, emit the
1540 # anchor before the SPHRASE
1541 proc StartSPhrase {id gi} {
1544 SUPERSCRIPT {set type SUPER}
1545 SUBSCRIPT {set type SUB}
1548 Emit "<KEY CLASS=\"EMPH\" SSI=\"SUPER-SUB\"><SPHRASE CLASS=\"$type\">"
1551 # end a super- or sub-scripted phrase
1552 proc EndSPhrase {} {
1553 Emit "</SPHRASE></KEY>"
1557 # start an admonition (note/caution/warning/tip/important),
1558 # emit a FORM to hold it and the HEAD for the icon (if any);
1559 # if the admonition has no Title, emit one using the GI of the
1560 # admonition; map Tip to Note and Important to Caution
1561 proc StartAdmonition {id gi haveTitle} {
1562 PushForm "" ADMONITION $id
1567 TIP {set icon "graphics/noteicon.pm"}
1569 IMPORTANT {set icon "graphics/cauticon.pm"}
1570 WARNING {set icon "graphics/warnicon.pm"}
1572 set snbId [AddToSNB GRAPHIC $icon]
1574 # emit the icon wrapped in a head for placement
1575 Emit "<HEAD SSI=\"ADMONITION-ICON\"><SNREF>"
1576 Emit "<REFITEM RID=\"$snbId\" CLASS=\"ICON\"></REFITEM>\n"
1577 Emit "</SNREF></HEAD>"
1579 # emit a title if none provided
1581 Emit "<HEAD SSI=\"ADMONITION-TITLE\">$gi</HEAD>\n"
1586 # start a Procedure - emit a <FORM> to hold it
1587 proc StartProcedure {id} {
1588 PushForm "" PROCEDURE $id
1592 # start a Step inside a Procedure, emit another FORM to hold it
1593 proc StartStep {id} {
1594 PushForm "" STEP $id
1598 # start a SubStep inside a Stop, emit yet another FORM to hold it
1599 proc StartSubStep {id} {
1600 PushForm "" SUBSTEP $id
1604 # start a Part; make the PARTGlossArray be the current glossary array
1605 proc StartPart {id} {
1606 global partID glossStack
1610 # make sure the glossary array exists but is empty
1611 Push glossStack PARTGlossArray
1612 upvar #0 [Peek glossStack] currentGlossArray
1613 set currentGlossArray(foo) ""
1614 unset currentGlossArray(foo)
1618 # end a Part; check for definitions for all glossed terms
1622 # get a convenient handle on the glossary array
1623 upvar #0 [Peek glossStack] currentGlossArray
1625 # check that all the glossed terms have been defined
1626 foreach name [array names currentGlossArray] {
1627 if {[lindex $currentGlossArray($name) 1] != "defined"} {
1628 set glossString [lindex $currentGlossArray($name) 2]
1629 UserError "No glossary definition for \"$glossString\"" no
1633 # delete this glossary array
1634 unset currentGlossArray
1638 # create and populate a dummy home page title - if no Title was
1639 # specified we want it to be "Home Topic"
1640 proc SynthesizeHomeTopicTitle {} {
1642 global localizedAutoGeneratedStringArray
1644 Title $partID PARTINTRO
1645 set message "Home Topic"
1646 Emit $localizedAutoGeneratedStringArray($message)
1647 CloseTitle PARTINTRO
1651 # create and populate a dummy home page because there was no
1652 # PartIntro in this document
1653 proc SynthesizeHomeTopic {} {
1655 global localizedAutoGeneratedStringArray
1658 StartNewVirpage PARTINTRO ""
1659 SynthesizeHomeTopicTitle
1660 StartParagraph $partID P ""
1661 set message "No home topic (PartIntro) was specified by the author."
1662 Emit $localizedAutoGeneratedStringArray($message)
1667 # start a virpage for, e.g., a SECTn - close the previous first;
1668 # compute the level rather than specifying it in the transpec to allow
1669 # one specification to do for all SECTn elements; if level=2 and we
1670 # haven't emitted a PartIntro (aka HomeTopic), emit one
1671 proc StartNewVirpage {ssi id} {
1672 global nextId virpageLevels inVirpage firstPInBlock
1673 global indexLocation snbLocation savedSNB currentSNB
1674 global lastList language charset docId havePartIntro partIntroId
1676 global manTitle manVolNum manDescriptor manNames manPurpose
1678 # get the LEVEL= value for this VIRPAGE (makes for a shorter
1679 # transpec to not have to specify level there)
1680 if {[info exists virpageLevels($ssi)]} {
1681 set level $virpageLevels($ssi)
1686 # if we are opening the PartIntro, use the generated ID (which
1687 # may be the assigned ID, if present) and flag that we've seen
1689 if {$ssi == "PARTINTRO"} {
1695 # if we haven't seen a PartIntro but we're trying to create a
1696 # level 2 VIRPAGE, emit a dummy PartInto
1697 if {($level == 2) && !$havePartIntro} {
1701 if {[string match {SECT[1-5]} $ssi]} {
1702 # make Chapter and all Sect? have an SSI of "CHAPTER", use LEVEL
1703 # to distinguish between them
1706 # make Reference, RefEntry and all RefSect? have an SSI of
1707 # "REFERENCE", use LEVEL to distinguish between them
1708 if {$ssi == "REFENTRY"} {
1711 if {[string match {REFSECT[1-3]} $ssi]} { set ssi REFERENCE }
1714 if {($ssi == "REFERENCE") || ($ssi == "REFENTRY")} {
1715 # assume no section, we'll get one in RefMeta.ManVolNum, if any
1718 set manDescriptor ""
1723 # close an open BLOCK, if any
1726 # close any open VIRPAGE
1727 Emit $inVirpage; set inVirpage "</VIRPAGE>\n"
1729 # if the first paragraph on the page is a compound para, we want
1730 # to emit a FORM with an SSI="P1" so set the first P flag
1733 # stash away the SNB for this VIRPAGE (or SDLDOC) - make an
1734 # associative array of the file location and the SNB data so
1735 # we can update the file location by adding the INDEX size before
1736 # writing the .snb file
1737 set names [array names currentSNB]
1738 if {[llength $names] != 0} {
1739 foreach name $names {
1740 # split the name into the GI and xid of the SNB entry
1741 set colonLoc [string first "::" $name]
1742 set type [string range $name 0 [incr colonLoc -1]]
1743 set data [string range $name [incr colonLoc 3] end]
1746 append tempSNB "<$type ID=\"$currentSNB($name)\" "
1754 TEXTFILE { set command "XID" }
1755 SYS-CMD { set command "COMMAND" }
1756 CALLBACK { set command "DATA" }
1758 append tempSNB "$command=\"$data\">\n"
1760 set savedSNB($snbLocation) $tempSNB
1764 if {[array exists lastList]} {
1765 unset lastList ;# don't allow lists to continue across virpage
1768 # delete the list of empty cells used for indefined Entries in
1769 # tables - we can only re-use them on the same virpage
1770 if {[array exists emptyCells]} {
1774 # we have to create new BLOCKs to hold the marks on the new page
1777 if {$id == ""} { set id "SDL-RESERVED[incr nextId]" }
1778 Emit "<VIRPAGE [Id $id] LEVEL=\"$level\" "
1779 Emit "LANGUAGE=\"$language\" "
1780 Emit "CHARSET=\"$charset\" "
1781 Emit "DOC-ID=\"$docId\" "
1782 Emit "SSI=\"$ssi\">\n"
1784 set snbLocation [tell stdout] ;# assume no HEAD for now
1788 # save the virpageLevels setting for this ssi (if any) and unset it
1789 # then call StartNewVirpage; on return, restore the virpagelevels
1790 # setting and continue - this will force the virpage to be a level 0
1791 # virpage and not show up in the TOC
1792 proc StartNewLevel0Virpage {ssi id} {
1793 global virpageLevels
1795 if {[info exists virpageLevels($ssi)]} {
1796 set savedLevel $virpageLevels($ssi)
1797 unset virpageLevels($ssi)
1800 StartNewVirpage $ssi $id
1802 if {[info exists savedLevel]} {
1803 set virpageLevels($ssi) $savedLevel
1808 # call StartNewVirpage, then if the user supplied ID is not same as
1809 # the default ID for that topic, emit an empty paragragh to contain
1810 # the user supplied ID; also, convert the ID of
1811 # SDL-RESERVED-LEGALNOTICE to SDL-RESERVED-COPYRIGHT for backwards
1812 # compatibility, preserve the original default ID so we're consistent
1813 # on this release too
1814 proc StartNewVirpageWithID {ssi id defaultID haveTitle} {
1817 # do we need to replace LEGALNOTICE with COPYRIGHT?
1819 if {[string toupper $defaultID] == "SDL-RESERVED-LEGALNOTICE"} {
1820 set defaultID SDL-RESERVED-COPYRIGHT
1824 StartNewVirpage $ssi $defaultID
1826 # if no user supplied ID but we changed the default, emit the
1827 # original default on the empty paragraph
1828 if {($id == "") && $legalNotice} {
1829 set id SDL-RESERVED-LEGALNOTICE
1833 # id is either user supplied or the original default (if changed);
1834 # if the VIRPAGE has a HEAD (Title), save this id (these ids) and
1835 # emit it (them) there, otherwise, emit an empty paragraph with
1838 if {[string toupper $id] != [string toupper $defaultID]} {
1842 # had both a user supplied ID and we changed the default
1843 lappend savedId SDL-RESERVED-LEGALNOTICE
1846 StartParagraph $id "" ""
1848 # had both a user supplied ID and we changed the default
1849 Anchor SDL-RESERVED-LEGALNOTICE
1858 # start a VIRPAGE for an appendix; if there's no ROLE=NOTOC, use the
1859 # virpage level from the level array, otherwise, use level 0
1860 proc StartAppendix {ssi id role} {
1861 global virpageLevels
1863 set uRole [string toupper $role]
1865 if {$uRole == "NOTOC"} {
1866 set saveAppendixLevel $virpageLevels(APPENDIX)
1867 set virpageLevels(APPENDIX) 0
1868 } elseif {$role != ""} {
1869 UserError "Bad value (\"$role\") for Role attribute in Appendix" yes
1872 StartNewVirpage $ssi $id
1874 if {$uRole == "NOTOC"} {
1875 set virpageLevels(APPENDIX) $saveAppendixLevel
1880 # start a new VIRPAGE for a topic that may contain a glossary; if
1881 # there is a glossary, start a new one and make it the current glossary,
1882 # otherwise, make the parent's glossary the current one.
1883 proc StartGlossedTopic {gi id haveGlossary} {
1886 if {$haveGlossary} {
1887 # save the glossary array name so we can get back here
1888 # when this topic is done
1889 Push glossStack ${gi}GlossArray
1891 # start a new (empty) glossary array for this glossary
1892 upvar #0 ${gi}GlossArray currentGlossArray
1893 set currentGlossArray(foo) ""
1894 unset currentGlossArray(foo)
1897 StartNewVirpage $gi $id
1901 # end a topic that may contain a glossary; if it did, check that all
1902 # glossed terms have been defined and remove the array - restore the
1903 # previous glossary array
1904 proc EndGlossedTopic {haveGlossary} {
1907 # get a convenient handle on the glossary array
1908 upvar #0 [Peek glossStack] currentGlossArray
1910 if {$haveGlossary} {
1911 # check that all the glossed terms have been defined
1912 foreach name [array names currentGlossArray] {
1913 if {[lindex $currentGlossArray($name) 1] != "defined"} {
1914 set glossString [lindex $currentGlossArray($name) 2]
1915 UserError "No glossary definition for \"$glossString\"" no
1919 # delete this glossary array and restore the previous one
1920 unset currentGlossArray
1926 # alternate OutputString routine for when in a glossed term - merely
1927 # buffer the output rather than sending to the output stream; we'll
1928 # emit the SDL when the whole term has been seen
1929 proc GlossOutputString {string} {
1932 append glossBuffer $string
1936 # prepare to link a glossed term to its definition in the glossary -
1937 # at this point, we simply divert the output into a buffer
1938 proc StartAGlossedTerm {} {
1942 rename OutputString SaveGlossOutputString
1943 rename GlossOutputString OutputString
1947 # strip any SDL markup from the string, upper case it and return
1948 # the result; takes advantage of the fact that we never split
1949 # start or end tags across lines (operates a line at a time)
1950 proc StripMarkup {markup} {
1951 set exp {(^|([^&]*))</?[A-Z]+[^>]*>}
1953 set mList [split $markup "\n"]; # split into a list of lines
1954 set listLen [llength $mList]
1955 while {[incr listLen -1] >= 0} {
1956 set mString [lindex $mList 0]; # get the first line from the
1957 set mList [lreplace $mList 0 0]; # list and delete it
1958 if {[string length $mString] == 0} {
1959 # empty line of pcdata (no markup)
1960 append stripped "\n"
1963 # force to upper case and delete all start and end tags
1964 set mString [string toupper $mString]
1965 while {[regsub -all $exp $mString {\1} mString]} {#}
1966 if {[string length $mString] == 0} {
1967 # empty line after removing markup; skip it
1970 append stripped $mString "\n"; # concat this line to result
1976 # done collecting a glossed term - if we're not NOGLOSS, emit the SDL
1977 # wrapped in a LINK; save the term, baseform (if any) and the ID
1978 # used in the link - we'll define the ID in the glossary itself
1979 proc EndAGlossedTerm {id role} {
1980 global glossBuffer nextId glossStack
1982 # get a convenient handle on the glossary array
1983 upvar #0 [Peek glossStack] currentGlossArray
1985 # get the original output routine back
1986 rename OutputString GlossOutputString
1987 rename SaveGlossOutputString OutputString
1989 set qualifier [string toupper [string range $role 0 8]]
1990 if {$qualifier == "NOGLOSS"} {
1991 Emit "<KEY CLASS=\"TERM\" SSI=\"GLOSSARY\">"
1995 if {$qualifier == "BASEFORM="} {
1996 set glossString [string range $role 9 end]
1998 set glossString $glossBuffer
2001 # trim whitespace from the front and back of the string to be
2002 # glossed, also turn line feeds into spaces and compress out
2003 # duplicate whitespace
2004 set glossString [string trim $glossString]
2005 set glossString [split $glossString '\n']
2006 set tmpGlossString $glossString
2007 set glossString [lindex $tmpGlossString 0]
2008 foreach str [lrange $tmpGlossString 1 end] {
2010 append glossString " " [string trim $str]
2014 # upper case the glossary entry and strip it of markup to
2015 # use as an index so we get a case insensitive match - we'll
2016 # save the original string too for error messages; if there's
2017 # no glossary entry yet, issue an ID - the second entry in
2018 # the list will be set to "defined" when we see the definition
2019 set glossIndex [StripMarkup $glossString]
2020 if {[info exists currentGlossArray($glossIndex)]} {
2021 set refId [lindex $currentGlossArray($glossIndex) 0]
2023 set refId SDL-RESERVED[incr nextId]
2024 set currentGlossArray($glossIndex) [list $refId "" $glossString]
2027 # now we can emit the glossed term wrapped in a popup link
2028 Emit "<LINK WINDOW=\"POPUP\" RID=\"$refId\">"
2029 Emit "<KEY CLASS=\"TERM\" SSI=\"GLOSSARY\">"
2031 Emit "</KEY></LINK>"
2036 # done collecting a term in a glossary - emit the anchor, if not
2037 # already done; if we are to be followed by alternate names (i.e.,
2038 # Abbrev and/or Acronym), emit the opening paren, otherwise, close
2040 proc EndATermInAGlossary {id} {
2041 global glossBuffer nextId nGlossAlts glossStack
2042 global strippedGlossIndex
2044 # get a convenient handle on the glossary array
2045 upvar #0 [Peek glossStack] currentGlossArray
2047 # get the original output routine back
2048 rename OutputString GlossOutputString
2049 rename SaveGlossOutputString OutputString
2051 # emit the user supplied ID
2054 # trim whitespace from the front and back of the string to be
2055 # placed in the glossary, also turn line feeds into spaces and
2056 # compress out duplicate whitespace
2057 set glossString [split $glossBuffer '\n']
2058 set tmpGlossString $glossString
2059 set glossString [lindex $tmpGlossString 0]
2060 foreach str [lrange $tmpGlossString 1 end] {
2062 append glossString " " [string trim $str]
2066 # create an upper cased version of the glossed string with markup
2067 # removed to use as a case insensitive index to the array
2068 set strippedGlossIndex [StripMarkup $glossString]
2070 # get or create the generated ID; update the glossary array to
2071 # reflect that we now have a definition
2072 if {[info exists currentGlossArray($strippedGlossIndex)]} {
2073 set id [lindex $currentGlossArray($strippedGlossIndex) 0]
2074 set defined [lindex $currentGlossArray($strippedGlossIndex) 1]
2075 if {$defined == "defined"} {
2077 "multiple definitions for glossary term \"$glossBuffer\"" yes
2078 set id SDL-RESERVED[incr nextId]
2081 set id SDL-RESERVED[incr nextId]
2083 set currentGlossArray($strippedGlossIndex) \
2084 [list $id defined $glossString "" ""]
2086 # emit the generated ID
2088 Emit "<KEY CLASS=\"TERM\" SSI=\"GLOSSARY\">"
2090 if {$nGlossAlts != 0} {
2099 proc EndAcronymInGlossary {id} {
2102 if {[incr nGlossAlts -1] != 0} {
2111 proc EndAbbrevInGlossary {id} {
2119 # start an entry in a glossary or glosslist; divert the output - we
2120 # need to sort the terms before emitting them
2121 proc StartGlossEntry {id nAlternates nDefs} {
2122 global nGlossAlts nGlossDefs currentGlossDef
2123 global glossEntryBuffer
2125 # this helps when determining if a comma is needed after an alt
2126 # (either an Abbrev or an Acronym)
2127 set nGlossAlts $nAlternates
2129 # this lets us know when to close the FORM holding the GlossDef+
2130 set nGlossDefs $nDefs
2131 set currentGlossDef 0
2133 set glossEntryBuffer ""
2134 rename OutputString SaveGlossEntryOutputString
2135 rename GlossEntryOutputString OutputString
2137 PushForm "" GLOSSENTRY $id
2138 StartParagraph "" "" ""
2142 # alternate OutputString routine for when in a GlossEntry - merely
2143 # buffer the output rather than sending to the output stream; we'll
2144 # save this text for emission when the entire GlossDiv, Glossary or
2145 # GlossList has been processed and we've sorted the entries.
2146 proc GlossEntryOutputString {string} {
2147 global glossEntryBuffer
2149 append glossEntryBuffer $string
2153 # end an entry in a glossary or glosslist; save the entry in the
2154 # glossarray so we can later sort it for output
2155 proc EndGlossEntry {sortAs} {
2156 global glossEntryBuffer strippedGlossIndex glossStack
2160 # get the original output routine back
2161 rename OutputString GlossEntryOutputString
2162 rename SaveGlossEntryOutputString OutputString
2164 # get a convenient handle on the glossary array and element
2165 upvar #0 [Peek glossStack] currentGlossArray
2166 upvar 0 currentGlossArray($strippedGlossIndex) currentEntryList
2168 # save any user supplied sort key and the content of this glossary
2169 # entry for use when all entries are defined to sort them and emit
2170 # them in the sorted order
2171 set currentEntryList \
2172 [lreplace $currentEntryList 3 4 $sortAs $glossEntryBuffer]
2177 # the current batch of glossary entries (to a Glossary, GlossList or
2178 # GlossDiv has been saved in the glossArray - we need to sort them
2179 # based on the sortAs value if given (list index 3) or the index into
2180 # the glossArray of no sortAs was provided; when sorted, we can emit
2181 # entries (list index 4) in the new order and delete the emitted text
2182 # so that we don't try to emit it again (we want to save the
2183 # glossArray until, e.g., all GlossDiv elements are processed so we
2184 # can tell if all glossed terms have been defined); do a PopForm
2185 # when we're done if requested (for, e.g., GlossList)
2186 proc SortAndEmitGlossary {popForm} {
2189 # get a convenient handle on the glossary array
2190 upvar #0 [Peek glossStack] currentGlossArray
2192 # start with an empty sortArray
2193 set sortArray(foo) ""
2194 unset sortArray(foo)
2196 set names [array names currentGlossArray]
2197 foreach name $names {
2198 upvar 0 currentGlossArray($name) glossEntryList
2200 # skip this array entry if we've already emitted it; mark as
2201 # emitted after we've extracted the content for emission
2202 if {[set content [lindex $glossEntryList 4]] == ""} {
2203 continue; # already been processed
2205 set glossEntryList [lreplace $glossEntryList 4 4 ""]
2207 # sort by the GlossTerm content or sortAs, if provided
2208 if {[set sortAs [lindex $glossEntryList 3]] == ""} {
2212 # append the content in case we have equal sort values
2213 append sortArray($sortAs) $content
2216 set names [lsort -command CompareI18NStrings [array names sortArray]]
2217 foreach name $names {
2218 Emit $sortArray($name)
2221 if {[string toupper $popForm] == "POPFORM"} {
2227 # start a "See ..." in a glossary; if there was an otherterm, duplicate
2228 # its content and wrap it in a link to the GlossTerm holding the content
2229 proc StartGlossSee {id otherterm} {
2230 global localizedAutoGeneratedStringArray
2232 StartBlock "" GLOSSSEE $id 1
2233 StartParagraph "" "" ""
2235 Emit $localizedAutoGeneratedStringArray($message)
2237 if {$otherterm != ""} {
2238 Emit "<LINK RID=\"$otherterm\">"
2243 # check the target of an OtherTerm attribute in a GlossSee to verify
2244 # that it is indeed the ID of a GlossTerm inside a GlossEntry
2245 proc CheckOtherTerm {id gi parent} {
2248 set errorMess "Other term (\"$id\") referenced from a"
2250 if {$gi != "GLOSSTERM"} {
2251 UserError "$errorMess $glossType must be a GlossTerm" yes
2252 } elseif {$parent != "GLOSSENTRY"} {
2253 UserError "$errorMess GlossSee must be in a GlossEntry" yes
2258 # start a definition in a glossary; we wrap a FORM around the whole
2259 # group of GlossDef elements in the GlossEntry
2260 proc StartGlossDef {id} {
2261 global nGlossDefs currentGlossDef
2263 if {$currentGlossDef == 0} {
2264 PushForm "" GLOSSDEF $id
2266 StartBlock "" "" $id 1
2270 # end a definition in a glossary; if this is the last definition,
2271 # close the FORM that holds the group
2272 proc EndGlossDef {} {
2273 global nGlossDefs currentGlossDef
2275 if {[incr currentGlossDef] == $nGlossDefs} {
2277 unset nGlossDefs currentGlossDef
2282 # start a "See Also ..." in a glossary definition; if there was an
2283 # otherterm, duplicate its content and wrap it in a link to the
2284 # GlossTerm holding the content
2285 proc StartGlossSeeAlso {id otherterm} {
2286 global localizedAutoGeneratedStringArray
2288 StartBlock "" GLOSSSEE $id 1
2289 StartParagraph "" "" ""
2290 set message "See Also"
2291 Emit $localizedAutoGeneratedStringArray($message)
2293 if {$otherterm != ""} {
2294 Emit "<LINK RID=\"$otherterm\">"
2299 # end a "See ..." or a "See Also ..." in a glossary definition; if there
2300 # was an otherterm, end the link to it
2301 proc EndGlossSeeOrSeeAlso {otherterm} {
2302 if {$otherterm != ""} {
2308 # alternate OutputString routine for when in IndexTerm - merely
2309 # buffer the output rather than sending to the output stream (index
2310 # entries get emitted into the index, not where they are defined)
2311 proc IndexOutputString {string} {
2314 append indexBuffer $string
2318 # alternate Id routine for when in IndexTerm - merely
2319 # return the string rather than also setting the "most recently used"
2320 # variable. The markup inside the IndexTerm goes into the index
2321 # not the current virpage so we don't want to use the ids here
2322 proc IndexId {name} {
2323 return "ID=\"$name\""
2327 # start an index entry
2328 proc StartIndexTerm {id} {
2329 global indexBuffer inP inBlock
2334 } elseif {$inBlock != ""} {
2335 StartParagraph "" "P" ""
2342 # prepare to buffer the output while in IndexTerm
2344 rename OutputString DefaultOutputString
2345 rename IndexOutputString OutputString
2351 # add an index sub-entry
2352 proc AddIndexEntry {loc} {
2353 global indexBuffer indexVals indexArray
2355 # trim superfluous whitespace at the beginning and end of the
2357 set indexBuffer [string trim $indexBuffer]
2359 # get an array index and determine whether 1st, 2nd or 3rd level
2360 set index [join $indexVals ", "]
2361 set level [llength $indexVals]
2362 set value [lindex $indexVals [expr "$level - 1"]]
2364 # look for the string we want to put into the index; if the string
2365 # isn't there, add it - if it's there, verify that the content
2366 # being indexed is marked up the same as the last time we saw it
2367 # and that the primary/secondary/tertiary fields are split the
2368 # same way (bad check for now, we really need to save the
2369 # individual values) and add the location ID to the list of locs.
2370 set names [array names indexArray]
2372 set indexArray($index) [list $level $value $loc $indexBuffer]
2377 set thisIndex $indexArray($index)
2378 if {$indexBuffer != [lindex $thisIndex 3]} {
2379 UserError "Indexing same terms with different markup" yes
2381 if {$level != [lindex $thisIndex 0]} {
2382 UserError "Index botch: levels don't match" yes
2385 set locs [lindex $thisIndex 2]
2386 if {$locs != ""} { append locs " " }
2388 set thisIndex [lreplace $thisIndex 2 2 $locs]
2389 set indexArray($index) $thisIndex
2396 set indexArray($index) [list $level $value $loc $indexBuffer]
2403 # end an index entry
2404 proc EndIndexTerm {} {
2407 AddIndexEntry $mostRecentId
2409 # start emitting to output stream again
2410 rename OutputString IndexOutputString
2411 rename DefaultOutputString OutputString
2417 # start a primary index term
2418 proc StartPrimaryIndexEntry {id cdata} {
2421 set indexVals [list [string trim $cdata]]
2425 # end a primary index term
2426 proc EndPrimaryIndexEntry {} {
2430 # start a secondary index term
2431 proc StartSecondaryIndexEntry {id cdata} {
2434 AddIndexEntry "" ;# make sure our primary is defined
2435 lappend indexVals [string trim $cdata]
2439 # end a secondary index term
2440 proc EndSecondaryIndexEntry {} {
2444 # start a tertiary index term
2445 proc StartTertiaryIndexEntry {id cdata} {
2448 AddIndexEntry "" ;# make sure our secondary is defined
2449 lappend indexVals [string trim $cdata]
2453 # end a tertiary index term
2454 proc EndTertiaryIndexEntry {} {
2458 # compute the proper string for LOCS= in an index entry - primarily,
2459 # we want to avoid emitting the LOCS= if there are no locations
2460 # defined for this entry
2462 set locs [lindex $entry 2]
2464 return " LOCS=\"$locs\""
2470 # open a .idx file and write the index into it
2471 proc WriteIndex {} {
2472 global baseName indexArray
2474 set file [open "${baseName}.idx" w]
2476 # sort the index using our special I18N safe sort function that
2477 # gives us a dictionary (case insensitive) sort
2478 set names [lsort -command CompareI18NStrings [array names indexArray]]
2480 if {[set length [llength $names]]} {
2482 puts $file "<INDEX COUNT=\"$length\">"
2483 foreach name $names {
2484 set thisEntry $indexArray($name)
2485 switch [lindex $thisEntry 0] {
2486 1 { switch $oldLevel {
2487 1 { puts $file "</ENTRY>" }
2488 2 { puts $file "</ENTRY>\n</ENTRY>" }
2489 3 { puts $file "</ENTRY>\n</ENTRY>\n</ENTRY>" }
2492 2 { switch $oldLevel {
2493 2 { puts $file "</ENTRY>" }
2494 3 { puts $file "</ENTRY>\n</ENTRY>" }
2497 3 { if {$oldLevel == 3} { puts $file "</ENTRY>" } }
2499 puts -nonewline $file "<ENTRY[Locs $thisEntry]>"
2500 puts -nonewline $file [lindex $thisEntry 3]
2501 set oldLevel [lindex $thisEntry 0]
2505 1 { puts $file "</ENTRY>" }
2506 2 { puts $file "</ENTRY>\n</ENTRY>" }
2507 3 { puts $file "</ENTRY>\n</ENTRY>\n</ENTRY>" }
2509 puts $file "</INDEX>"
2516 # called at the beginning of CHAPTER on each FOOTNOTE element - save
2517 # their numbering for use by FOOTNOTEREF and emit a VIRPAGE for each
2519 proc GatherFootnote {id} {
2520 global footnoteArray footnoteCounter nextId
2522 incr footnoteCounter
2524 set footnoteArray($id) $footnoteCounter
2526 set id SDL-RESERVED[incr nextId]
2529 StartNewVirpage FOOTNOTE $id
2533 # emit the footnote number of the id surrounded by a <LINK> so we can
2534 # get to it; skip out if there's no id to reference
2535 proc FootnoteRef {idref} {
2536 global footnoteArray
2539 if {[info exists footnoteArray($idref)]} {
2540 Emit "<LINK RID=\"$idref\" WINDOW=\"popup\">"
2541 Emit "<KEY CLASS=\"EMPH\" SSI=\"FOOTNOTE\">"
2542 Emit "$footnoteArray($idref)</KEY></LINK>"
2548 # add an element to the current SNB - try to reuse an entry if
2550 proc AddToSNB {type data} {
2551 global currentSNB nextId
2553 set index "$type::$data"
2555 if {[info exists currentSNB($index)]} {
2556 set snbId $currentSNB($index)
2558 set snbId "SDL-RESERVED[incr nextId]"
2559 set currentSNB($index) $snbId
2565 # emit a DocBook Graphic element - create an SNB entry and point to
2567 proc Graphic {id entityref fileref gi} {
2570 if {$gi == "GRAPHIC"} {
2576 # if "entityref" is present, it overrides "fileref"
2577 if {$entityref != ""} {
2578 # need to remove "<OSFILE ASIS>" (or equivalent for different
2579 # system identifiers) from the beginning of the entity name
2580 # if nsgmls was used for the original parse; the regular
2581 # expression below should work by simply ignoring any leading
2582 # angle bracket delimited string
2583 regsub {^(<.*>)(.*)$} $entityref {\2} entityref
2590 UserError "No file name or entity specified for $gi" yes
2593 # if not in a paragraph, start one
2594 if {($gi == "GRAPHIC") && (!$inP)} { StartParagraph "" "P" "" }
2596 set snbId [AddToSNB GRAPHIC $file]
2599 Emit "<REFITEM RID=\"$snbId\" CLASS=\"$class\"></REFITEM>\n"
2604 # emit a deferred link; we deferred it when we saw that it was first
2605 # in a Para and that it contained only an InlineGraphic - we had
2606 # to wait for the InlineGraphic to come along to see if it not only
2607 # met the contextual constraints but also had a Remap=Graphic
2609 proc EmitDeferredLink {} {
2612 if {![array exists deferredLink]} return
2614 switch $deferredLink(gi) {
2615 LINK {StartLink "" $deferredLink(linkend) $deferredLink(type)}
2616 OLINK {StartOLink "" $deferredLink(localinfo) $deferredLink(type)}
2623 # emit an InlineGraphic that might be remapped to a Graphic (via
2624 # Remap=) and might have text wrapped around it (if it's first in
2625 # a Para or first in a [OU]Link that is itself first in a Para)
2626 proc InFlowGraphic {id entityref fileref parent remap role} {
2629 # we only map InlineGraphic to Graphic if we're either the first
2630 # thing in a Para or the only thing in a link which is itself
2631 # the first thing in a Para
2633 set haveDeferredLink [array exists deferredLink]
2638 ULINK {set ok $haveDeferredLink}
2641 Graphic $id $entityref $fileref INLINEGRAPHIC
2645 set uRemap [string toupper $remap]
2646 if {$uRemap == "GRAPHIC"} {
2647 set uRole [string toupper $role]
2650 "" {set role "LEFT"}
2651 RIGHT {set role "RIGHT"}
2653 set badValMess "Bad value (\"$role\") for Role attribute"
2654 UserError "$badValMess in InlineGraphic" yes
2658 if {$haveDeferredLink} {
2659 set linkID " ID=\"$deferredLink(id)\""
2660 if {$deferredLink(gi) == "ULINK"} {
2662 set haveDeferredLink 0
2667 Emit "<HEAD$linkID SSI=\"GRAPHIC-$role\">"
2668 if {$haveDeferredLink} {
2671 Graphic $id $entityref $fileref GRAPHIC
2672 if {$haveDeferredLink} {
2677 } elseif {$remap != ""} {
2678 set badValMess "Bad value (\"$remap\") for Remap attribute"
2679 UserError "$badValMess in InlineGraphic" yes
2682 Graphic $id $entityref $fileref INLINEGRAPHIC
2686 # start a figure; for now, ignore Role (as it was ignored in HelpTag)
2687 # but make sure Role contains only legal values
2688 proc StartFigure {id role} {
2690 set uRole [string toupper $role]
2696 set badValMess "Bad value for Role (\"$role\") attribute"
2697 UserError "$badValMess in Figure" yes
2702 PushForm "" "FIGURE" $id
2706 # emit a CiteTitle in a KEY with the SSI set to the PubWork attr.
2707 proc CiteTitle {id type} {
2708 Emit "<KEY CLASS=\"PUB-LIT\""
2712 Emit " SSI=\"$type\">"
2716 # start a KEY element - each parameter is optional (i.e, may be "")
2717 proc StartKey {id class ssi} {
2723 Emit " CLASS=\"$class\""
2726 Emit " SSI=\"$ssi\""
2731 # start an emphasis with role=heading; want want a different ssi
2732 # so we can make it bold rather than italic for use as a list
2734 proc StartHeading {id role} {
2735 set role [string toupper $role]
2736 if {$role != "HEADING"} {
2738 UserWarning "Bad value for Role (!= \"Heading\") in EMPHASIS" yes
2742 set ssi LIST-HEADING
2744 StartKey $id EMPH $ssi
2748 # start an Example or InformalExample - we need to put ourselves
2749 # in a mode where lines and spacing are significant
2751 global defaultParaType
2753 set defaultParaType " TYPE=\"LITERAL\""
2754 PushForm "" "EXAMPLE" $id
2758 # close an Example or InformalExample - put ourselves back in
2759 # the normal (non-literal) mode
2760 proc CloseExample {} {
2761 global defaultParaType
2763 set defaultParaType ""
2768 # start a Table or InformalTable - save the global attributes and
2769 # open a FORM to hold the table
2770 proc StartTable {id colSep frame label rowSep} {
2771 global tableAttributes
2773 set tableAttributes(colSep) $colSep
2774 set tableAttributes(label) $label
2775 set tableAttributes(rowSep) $rowSep
2777 PushForm TABLE "TABLE-$frame" $id
2779 # create a list of ids of empty blocks to be used to fill in
2780 # undefined table cells
2784 # check the "char" attribute - we only support "." at this time;
2785 # return "." if char="." and "" otherwise; issue warning if char
2786 # is some character other than "."
2787 proc CheckChar {char} {
2788 if {($char != "") && ($char != ".")} {
2789 UserError "Only \".\" supported for character alignment" yes
2796 # start a TGROUP - prepare to build a list of column specifications
2797 # and an array of span specifications to be accessed by name; a column
2798 # specification may be numbered, in which case default (all #IMPLIED)
2799 # column specifications will be inserted to come up to the specified
2800 # number - if there are already more column specifications than the
2801 # given number, it's an error; open a FORM to hold the TGroup
2802 proc StartTGroup {id align char cols colSep rowSep nColSpecs} {
2803 global tableGroupAttributes tableAttributes
2804 global tableGroupColSpecs tableGroupSpanSpecs
2805 global numberOfColSpecs colNames haveTFoot
2806 global needTGroupTHeadForm needTFootForm
2807 global tableGroupSavedFRowVec
2809 set numberOfColSpecs $nColSpecs
2811 # do a sanity check on the number of columns, there must be
2814 UserError "Unreasonable number of columns ($cols) in TGroup" yes
2818 # check for more COLSPECs than COLS - error if so
2819 if {$nColSpecs > $cols} {
2820 UserError "More ColSpecs defined than columns in the TGroup" yes
2823 set tableGroupAttributes(align) $align
2824 set tableGroupAttributes(char) [CheckChar $char]
2825 set tableGroupAttributes(cols) $cols
2826 if {$colSep == ""} {
2827 set tableGroupAttributes(colSep) $tableAttributes(colSep)
2829 set tableGroupAttributes(colSep) $colSep
2831 if {$rowSep == ""} {
2832 set tableGroupAttributes(rowSep) $tableAttributes(rowSep)
2834 set tableGroupAttributes(rowSep) $rowSep
2837 # make sure we have a blank colName array so we don't get errors
2838 # if we try to read or delete it when there have been no named
2839 # ColSpecs in this tableGroup - use a numeric key since that is
2840 # not a NMTOKEN and so can never be a colName - note that all
2841 # colNames share a common name space within each tGroup.
2844 # create an empty column specification list for this TGroup;
2845 # if no ColSpec definitions at this level, set them all to the
2846 # defaults - take advantage of the fact that the function ColSpec
2847 # will create default column specifications to fill out up to an
2848 # explicitly set ColNum
2849 set tableGroupColSpecs ""
2850 if {$nColSpecs == 0} {
2851 ColSpec "" TGROUP "" "" "" $cols "" "" ""
2854 PushForm TABLE TGROUP $id
2856 # set a flag to indicate that we haven't seen a TFoot yet; this
2857 # flag is used in EndRow and StartCell to determine if a Row is
2858 # the last row in this TGroup (the last row will be in the TFoot,
2859 # if present, otherwise it will be in the TBody)
2862 # initialize variables used to determine if we need separate FORM
2863 # elements for THead or TFoot - if ColSpec elements are not given
2864 # at those levels, they can go in the same FORM as the TBody and
2865 # we can guarantee that the columns will line up
2866 set needTGroupTHeadForm 0
2869 # and initialize a variable to hold saved FROWVEC elements across
2870 # THead, TBody and TFoot in case we are merging them into one or
2871 # two FORM elements rather than putting each in its own
2872 set tableGroupSavedFRowVec ""
2876 # close a table group; delete the info arrays and lists and close the
2879 global tableGroupAttributes tableGroupColSpecs tableGroupSpanSpecs
2882 unset tableGroupAttributes
2883 unset tableGroupColSpecs
2884 if {[info exists tableGroupSpanSpecs]} {
2885 unset tableGroupSpanSpecs
2889 # see the explanation for this variable under StartTGroup
2894 # process one of a series of column specifications - use the parent GI
2895 # to determine which column specifications we're dealing with; fill up
2896 # to the specified column number with default COLSPECs, using the
2897 # TGROUP, THEAD or TFOOT values as defaults; any COLSPEC values not
2898 # specified in the parameter list should also be defaulted
2899 proc ColSpec {grandparent parent align char colName colNum
2900 colSep colWidth rowSep} {
2901 # the number of currently defined colSpecs in this context
2902 global numberOfColSpecs
2905 # get the proper list of ColSpecs for the current context
2906 if {$grandparent == "ENTRYTBL"} {
2907 set gpName entryTable
2909 set gpName tableGroup
2912 THEAD { upvar #0 ${gpName}HeadColSpecs colSpecs }
2913 TGROUP { upvar #0 tableGroupColSpecs colSpecs }
2914 TFOOT { upvar #0 tableFootColSpecs colSpecs }
2915 ENTRYTBL { upvar #0 entryTableColSpecs colSpecs }
2918 # get the proper number of columns (either from TGroup or EntryTbl);
2919 # a THead could be in either a TGroup or EntryTbl so we need
2920 # to check the grandparent if we aren't at the top level
2921 if {$parent == "TGROUP"} {
2922 upvar #0 tableGroupAttributes attributes
2923 } elseif {$parent == "ENTRYTBL"} {
2924 upvar #0 entryTableAttributes attributes
2925 } elseif {$grandparent == "ENTRYTBL"} {
2926 upvar #0 entryTableAttributes attributes
2928 upvar #0 tableGroupAttributes attributes
2930 set nCols $attributes(cols)
2932 # check for more COLSPECs than COLS - we've already issued an error if so
2934 set currentLength [llength $colSpecs]
2935 if {$currentLength >= $nCols} {
2939 # create a default ColSpec
2940 set thisColSpec(align) $attributes(align)
2941 set thisColSpec(char) $attributes(char)
2942 set thisColSpec(colName) ""
2943 set thisColSpec(colSep) $attributes(colSep)
2944 set thisColSpec(colWidth) "1*"
2945 set thisColSpec(rowSep) $attributes(rowSep)
2947 # back fill with default COLSPECs if given an explicit COLNUM and
2948 # it's greater than our current position
2950 if {($colNum != "")} {
2951 if {($colNum < $currentLength)} {
2952 set badValMess1 "Explicit colNum ($colNum) less than current"
2953 set badValMess2 "number of ColSpecs ($currentLength)"
2954 UserError "$badValMess1 $badValMess2" yes
2957 while {$currentLength < $colNum} {
2958 set thisColSpec(colNum) $currentLength
2959 lappend colSpecs [array get thisColSpec]
2964 set colNum $currentLength
2966 # set this COLSPEC, we've already set the defaults
2968 set thisColSpec(align) $align
2971 set thisColSpec(char) [CheckChar $char]
2973 set thisColSpec(colName) $colName
2974 if {$colName != ""} {
2975 # save name to num mapping for later lookup by Entry
2976 set colNames($colName) $colNum
2978 set thisColSpec(colNum) $colNum
2979 if {$colSep != ""} {
2980 set thisColSpec(colSep) $colSep
2982 if {$colWidth != ""} {
2983 set thisColSpec(colWidth) $colWidth
2985 if {$rowSep != ""} {
2986 set thisColSpec(rowSep) $rowSep
2988 if {$colNum == $nCols} {
2989 set thisColSpec(colSep) 0; # ignore COLSEP on last column
2991 lappend colSpecs [array get thisColSpec]
2993 # fill out to the number of columns if we've run out of COLSPECs
2994 if {[incr numberOfColSpecs -1] <= 0} {
2995 # restore the default COLSPEC
2996 set thisColSpec(align) $attributes(align)
2997 set thisColSpec(char) $attributes(char)
2998 set thisColSpec(colName) ""
2999 set thisColSpec(colSep) $attributes(colSep)
3000 set thisColSpec(colWidth) "1*"
3001 set thisColSpec(rowSep) $attributes(rowSep)
3003 while {$colNum < $nCols} {
3005 set thisColSpec(colNum) $colNum
3006 if {$colNum == $nCols} {
3007 set thisColSpec(colSep) 0; # ignore on last column
3009 lappend colSpecs [array get thisColSpec]
3015 # process a SpanSpec - we can't take defaults yet because the Namest
3016 # and Nameend attributes may refer to ColSpecs that don't get defined
3017 # until a TFoot or THead
3018 proc SpanSpec {parent align char colSep nameEnd nameSt rowSep spanName} {
3019 if {$parent == "TGROUP"} {
3020 upvar #0 tableGroupSpanSpecs spanSpecs
3022 upvar #0 entryTableSpanSpecs spanSpecs
3025 set thisSpanSpec(align) $align
3026 set thisSpanSpec(char) [CheckChar $char]
3027 set thisSpanSpec(colSep) $colSep
3028 set thisSpanSpec(nameEnd) $nameEnd
3029 set thisSpanSpec(nameSt) $nameSt
3030 set thisSpanSpec(rowSep) $rowSep
3032 if {[info exists spanSpecs($spanName)]} {
3033 UserError "duplicate span name \"$spanName\"" yes
3037 set spanSpecs($spanName) [array get thisSpanSpec]
3041 # make a list of empty strings for use as an empty Row
3042 proc MakeEmptyRow {nCols} {
3044 while {$nCols > 0} {
3052 # given a ColSpec list, compute a COLW= vector for SDL;
3053 # the idea is to assume the page is 9360 units wide - that's
3054 # 6.5 inches in points at approximately 1/72 in. per point,
3055 # subtract all the absolute widths and divide the remnant by
3056 # the number of proportional width values then re-add the absolute
3057 # widths back in to the proper columns; this technique should
3058 # make pages that are exactly 6.5 in. in printing surface look just
3059 # right and then go proportional from there
3060 proc ComputeCOLW {colSpecList} {
3062 set nCols [llength $colSpecList]
3064 # build lists of just the ColWidth specs - one for the proporional
3065 # values and one for the absolutes
3069 while {$index < $nCols} {
3070 array set thisColSpec [lindex $colSpecList $index]
3071 set colWidth $thisColSpec(colWidth)
3072 set colWidth [string trimleft $colWidth]
3073 set colWidth [string trimright $colWidth]
3074 set colWidth [string tolower $colWidth]
3075 set widths [split $colWidth '+']
3076 set nWidths [llength $widths]
3080 while {$wIndex < $nWidths} {
3081 set thisWidth [lindex $widths $wIndex]
3082 if {[scan $thisWidth "%f%s" val qual] != 2} {
3083 UserError "Malformed ColWidth \"$thisWidth\"" yes
3089 switch -exact $qual {
3090 * {set thisProp $val}
3091 pt {set thisAbs [expr "$val * 1 * 20"]}
3092 pi {set thisAbs [expr "$val * 12 * 20"]}
3093 cm {set thisAbs [expr "$val * 28 * 20"]}
3094 mm {set thisAbs [expr "$val * 3 * 20"]}
3095 in {set thisAbs [expr "$val * 72 * 20"]}
3097 set propWidth [expr "$propWidth + $thisProp"]
3098 set absWidth [expr "$absWidth + $thisAbs"]
3101 lappend propWidths $propWidth
3102 lappend absWidths $absWidth
3103 set totalProps [expr "$totalProps + $propWidth"]
3104 set totalAbs [expr "$totalAbs + $absWidth"]
3107 if {$totalProps == 0} {
3108 # we need at least some proportionality; assume each cell
3109 # had been set to 1* to distribute evenly
3110 set totalProps $nCols
3112 if {[info exists propWidths]} {
3115 while {$index < $nCols} {
3116 lappend propWidths 1
3121 if {$totalAbs > $tableWidth} {
3122 set tableWidth $totalAbs
3124 set propAvail [expr "$tableWidth - $totalAbs"]
3125 set oneProp [expr "$propAvail / $totalProps"]
3127 # now we know what a 1* is worth and we know the absolute size
3128 # requests, create a ColWidth by adding the product of the
3129 # proportional times a 1* plus any absolute request; we'll allow
3130 # 20% growth and shrinkage
3133 while {$index < $nCols} {
3134 set thisAbs [lindex $absWidths $index]
3135 set thisProp [lindex $propWidths $index]
3136 set thisWidth [expr "$thisAbs + ($thisProp * $oneProp)"]
3137 set thisSlop [expr "$thisWidth * 0.2"]
3138 # make thisWidth an integer
3139 set dotIndex [string last "." $thisWidth]
3140 if {$dotIndex == 0} {
3142 } elseif {$dotIndex > 0} {
3144 set thisWidth [string range $thisWidth 0 $dotIndex]
3146 # make thisSlop an integer
3147 set dotIndex [string last "." $thisSlop]
3148 if {$dotIndex == 0} {
3150 } elseif {$dotIndex > 0} {
3152 set thisSlop [string range $thisSlop 0 $dotIndex]
3154 append returnValue "$space$thisWidth,$thisSlop"
3164 # given a ColSpec list, compute a COLJ= vector for SDL;
3165 proc ComputeCOLJ {colSpecList} {
3167 set nCols [llength $colSpecList]
3171 while {$index < $nCols} {
3172 array set thisColSpec [lindex $colSpecList $index]
3173 switch -exact $thisColSpec(align) {
3176 "" { set thisColJ l}
3177 CENTER { set thisColJ c}
3178 RIGHT { set thisColJ r}
3179 CHAR { set thisColJ d}
3181 append returnValue "$space$thisColJ"
3191 # given a ColSpec, create the COLW= and COLJ= attributes; check the
3192 # list of current TOSS entries to see if one matches - if so, return
3193 # its SSI= else add it and create an SSI= to return
3194 proc CreateOneTOSS {ssi vAlign colSpec} {
3195 global newTOSS nextId
3197 set colW [ComputeCOLW $colSpec]
3198 set colJ [ComputeCOLJ $colSpec]
3199 set names [array names newTOSS]
3200 foreach name $names {
3201 array set thisTOSS $newTOSS($name)
3202 if {[string compare $colW $thisTOSS(colW)]} {
3203 if {[string compare $colJ $thisTOSS(colJ)]} {
3204 if {[string compare $vAlign $thisTOSS(vAlign)]} {
3211 # no matching colW,colJ, add an entry
3213 set ssi HBF-SDL-RESERVED[incr nextId]
3215 set thisTOSS(colW) $colW
3216 set thisTOSS(colJ) $colJ
3217 set thisTOSS(vAlign) $vAlign
3218 set newTOSS($ssi) [array get thisTOSS]
3223 # save values from TFoot, we'll actually process TFoot after TBody
3224 # but we need to know whether we have a TFoot and whether that TFoot
3225 # has ColSpec elements in order to push/pop a FORM for the TBody if
3227 proc PrepForTFoot {nColSpecs} {
3228 global haveTFoot needTFootForm
3231 set needTFootForm [expr "$nColSpecs > 0"]
3235 # start a table header, footer or body - create a FORM to hold the rows;
3236 # create an empty row to be filled in by the Entry elements - set the
3237 # current row and number of rows to 1
3238 proc StartTHeadTFootTBody {parent gi haveTHead id vAlign nRows nColSpecs} {
3239 global numberOfColSpecs haveTFoot
3240 global needTFootForm
3242 if {$parent == "ENTRYTBL"} {
3243 upvar #0 entryTableRowDope rowDope
3244 upvar #0 needEntryTblTHeadForm needTHeadForm
3245 global entryTableAttributes
3246 set nCols $entryTableAttributes(cols)
3247 set entryTableAttributes(vAlign) $vAlign
3248 set entryTableAttributes(rows) $nRows
3250 upvar #0 tableGroupRowDope rowDope
3251 upvar #0 needTGroupTHeadForm needTHeadForm
3252 global tableGroupAttributes
3253 set nCols $tableGroupAttributes(cols)
3254 set tableGroupAttributes(vAlign) $vAlign
3255 set tableGroupAttributes(rows) $nRows
3258 set numberOfColSpecs $nColSpecs
3260 # get the proper list of ColSpecs for the current context
3261 if {$parent == "ENTRYTBL"} {
3262 set parentName entryTable
3264 set parentName tableGroup
3267 THEAD {upvar #0 ${parentName}HeadColSpecs colSpecs}
3268 TBODY {upvar #0 ${parentName}ColSpecs colSpecs}
3269 TFOOT {upvar #0 tableFootColSpecs colSpecs }
3272 # if no ColSpec definitions at this level, copy the parent's
3273 # ColSpec definition to here
3274 if {$nColSpecs == 0} {
3276 THEAD {upvar #0 ${parentName}ColSpecs parentColSpecs}
3277 TFOOT {upvar #0 tableGroupColSpecs parentColSpecs}
3279 if {$gi != "TBODY"} {
3280 set colSpecs $parentColSpecs
3284 # if we have ColSpec elements on a THead, we'll need to put it
3285 # in its own FORM; we saved this value for TFoot earlier
3286 # because TFoot precedes TBody in the content model but doesn't
3287 # get processed until after TBody (as EndText: to TGroup)
3288 if {$gi == "THEAD"} {
3289 set needTHeadForm [expr "$nColSpecs > 0"]
3292 # determine whether we need to push a new FORM here - we always
3293 # have to push a FORM for a THead, we only push one for TBody
3294 # if THead needed its own or there was no THead and we only push
3295 # one for TFoot if it needs its own
3299 set needTBodyForm $needTHeadForm
3304 TBODY {set doit $needTBodyForm}
3305 TFOOT {set doit $needTFootForm}
3308 # and push it, if so
3310 set ssi [CreateOneTOSS $id "" $colSpecs]
3311 PushForm TABLE "$ssi" $id
3314 set rowDope(nRows) 0
3315 set rowDope(currentRow) 0
3319 # end a table header footer or body - delete the global row
3320 # information and close the FORM; also delete the ColSpec info for
3321 # this THead or TFoot (TBody always uses the parent's)
3322 proc EndTHeadTFootTBody {parent gi} {
3323 global numberOfColSpecs needTFootForm haveTFoot
3325 if {$parent == "ENTRYTBL"} {
3326 upvar #0 needEntryTblTHeadForm needTHeadForm
3328 upvar #0 needTGroupTHeadForm needTHeadForm
3331 # determine whether we want to terminate this FORM here - we
3332 # only terminate the THead FORM if it needed its own, we only
3333 # terminate the TBody FORM if the TFoot needs its own or there
3334 # is no TFoot and we always terminate the FORM for TFoot
3335 if {($parent == "ENTRYTBL") || !$haveTFoot} {
3338 set needTBodyForm $needTFootForm
3342 THEAD {set doit $needTHeadForm}
3343 TBODY {set doit $needTBodyForm}
3346 PopTableForm $parent $gi $doit
3348 # blow away the list of ColSpecs for the current context
3350 THEAD { if {$parent == "ENTRYTBL"} {
3351 global entryTableHeadColSpecs
3352 unset entryTableHeadColSpecs
3354 global tableGroupHeadColSpecs
3355 unset tableGroupHeadColSpecs
3358 TFOOT { global tableFootColSpecs
3359 unset tableFootColSpecs
3365 # start a table row - save the attribute values for when we
3366 # actually emit the entries of this row; when we emit the first
3367 # entry we'll emit the ID on the rowSep FORM that we create for each
3368 # Entry and set the ID field to "" so we only emit the ID once
3369 proc StartRow {grandparent parent id rowSep vAlign} {
3370 if {$grandparent == "ENTRYTBL"} {
3371 upvar #0 entryTableRowDope rowDope
3372 global entryTableAttributes
3373 set nCols $entryTableAttributes(cols)
3374 if {$vAlign == ""} {
3375 set vAlign $entryTableAttributes(vAlign)
3378 upvar #0 tableGroupRowDope rowDope
3379 global tableGroupAttributes
3380 set nCols $tableGroupAttributes(cols)
3381 if {$vAlign == ""} {
3382 set vAlign $tableGroupAttributes(vAlign)
3385 upvar 0 rowDope(currentRow) currentRow
3386 upvar 0 rowDope(nRows) nRows
3389 set rowDope(rowSep) $rowSep
3390 set rowDope(vAlign) $vAlign
3393 if {![info exists rowDope(row$currentRow)]} {
3394 set rowDope(row$currentRow) [MakeEmptyRow $nCols]
3399 # a debugging procedure
3400 proc DumpRowDope {rowDopeName} {
3401 upvar 1 $rowDopeName rowDope
3403 puts stderr "rowDope:"
3405 while {[incr index] <= $rowDope(nRows)} {
3407 " $index: ([llength $rowDope(row$index)]) $rowDope(row$index)"
3413 proc EndRow {grandparent parent} {
3414 global emptyCells nextId haveTFoot
3416 # this row could be in a TGroup or an EntryTbl
3417 if {$grandparent == "ENTRYTBL"} {
3418 upvar #0 entryTableRowDope rowDope
3419 global entryTableAttributes
3420 set nCols $entryTableAttributes(cols)
3421 set nRowDefs $entryTableAttributes(rows)
3423 upvar #0 tableGroupRowDope rowDope
3424 global tableGroupAttributes
3425 set nCols $tableGroupAttributes(cols)
3426 set nRowDefs $tableGroupAttributes(rows)
3429 # get the proper list of ColSpecs for the current context
3431 THEAD { if {$grandparent == "ENTRYTBL"} {
3432 upvar #0 entryTableHeadColSpecs colSpecs
3434 upvar #0 tableGroupHeadColSpecs colSpecs
3437 TBODY { if {$grandparent == "ENTRYTBL"} {
3438 upvar #0 entryTableColSpecs colSpecs
3440 upvar #0 tableGroupColSpecs colSpecs
3443 TFOOT { upvar #0 tableFootColSpecs colSpecs }
3446 # go over the row filing empty cells with an empty FORM containing
3447 # an empty BLOCK. The FORM SSI= is chosen to give a RowSep based
3448 # upon the current ColSpec and rowDope, if we are on the last row
3449 # we want to set the RowSep to 0 unless there were more rows
3450 # created via the MoreRows attribute of Entry or EntryTbl forcing
3451 # the table to be longer than the number of Rows specified in which
3452 # case we want to fill in all those rows too and only force RowSep
3453 # to 0 on the last one; the inner BLOCK SSI= is chosen to give a
3454 # ColSep based upon the current ColSpec and Row definition - if
3455 # the column is the last one in the row, the ColSep is set to 0
3456 set currentRow $rowDope(currentRow)
3457 if {$currentRow == $nRowDefs} {
3458 set moreRows [expr "$rowDope(nRows) - $nRowDefs"]
3462 upvar 0 rowDope(row$currentRow) thisRow
3463 upvar 0 rowDope(row[expr "$currentRow - 1"]) prevRow
3464 while {$moreRows >= 0} {
3466 while {$colIndex < $nCols} {
3467 set thisCellId [lindex $thisRow $colIndex]
3468 if {$thisCellId == ""} {
3469 array set thisColSpec [lindex $colSpecs $colIndex]
3470 set desiredCell(colSep) $thisColSpec(colSep)
3471 set desiredCell(rowSep) $thisColSpec(rowSep)
3472 if {$rowDope(rowSep) != ""} {
3473 set desiredCell(rowSep) $rowDope(rowSep)
3475 if {$colIndex == $nCols} {
3476 set desiredCell(colSep) 0
3478 if {($moreRows == 0) && ($currentRow == $nRowDefs)} {
3479 if {($parent == "TFOOT") ||
3480 (($parent == "TBODY") && (!$haveTFoot))} {
3481 set desiredCell(rowSep) 0
3484 if {$desiredCell(colSep) == ""} {
3485 set desiredCell(colSep) 1
3487 if {$desiredCell(rowSep) == ""} {
3488 set desiredCell(rowSep) 1
3491 foreach id [array names emptyCells] {
3492 array set thisCell $emptyCells($id)
3493 if {$thisCell(colSep) != $desiredCell(colSep)} {
3496 if {$thisCell(rowSep) != $desiredCell(rowSep)} {
3499 if {$currentRow > 1} {
3500 if {[lindex $prevRow $colIndex] == $id} {
3504 if {$colIndex > 0} {
3505 if {$lastCellId == $id} {
3514 if {$desiredCell(rowSep)} {
3515 set ssi BORDER-BOTTOM
3519 set id [PushFormCell $ssi ""]
3520 if {$desiredCell(colSep)} {
3521 set ssi ENTRY-NONE-YES-NONE
3523 set ssi ENTRY-NONE-NO-NONE
3525 StartBlock CELL $ssi "" 1
3527 set emptyCells($id) [array get desiredCell]
3530 Replace thisRow $colIndex 1 $thisCellId
3532 set lastCellId $thisCellId
3537 upvar 0 thisRow prevRow
3538 upvar 0 rowDope(row$currentRow) thisRow
3541 # blow away the variables that get reset on each row
3543 unset rowDope(rowSep)
3544 unset rowDope(vAlign)
3548 # given a row list, an id and start and stop columns, replace the
3549 # entries in the list from start to stop with id - use "upvar" on
3550 # the row list so we actually update the caller's row
3551 proc Replace {callersRow start length id} {
3552 upvar $callersRow row
3554 # length will be 0 if there was an error on the row
3559 # make a list of ids long enough to fill the gap
3561 set ids $id; # we pad all the others with a starting space
3562 while {$i < $length} {
3567 # do the list replacement - need to "eval" because we want the
3568 # ids to be seen a individual args, not a list so we need to
3569 # evaluate the command twice
3570 set stop [expr "$start + $length - 1"]
3571 set command "set row \[lreplace \$row $start $stop $ids\]"
3576 # process a table cell (Entry or EntryTbl); attributes are inherited
3577 # in the following fashion:
3584 # with later values (going down the list) overriding earlier ones;
3585 # Table, TGroup, etc., values have already been propagated to the
3587 proc StartCell {ancestor grandparent gi id align char colName cols
3588 colSep moreRows nameEnd nameSt rowSep spanName
3589 vAlign nColSpecs nTBodies} {
3590 global colNames tableGroupAttributes entryTableAttributes
3591 global numberOfColSpecs entryTableColSpecs nextId haveTFoot
3592 global needEntryTblTHeadForm entryTableSavedFRowVec
3594 # get the appropriate SpanSpec list, if any; also get the row
3595 # row dope vector which also contains the current row number
3596 # and number of rows currently allocated (we might get ahead
3597 # of ourselves due to a vertical span via MOREROWS=)
3598 if {$ancestor == "TGROUP"} {
3599 upvar #0 tableGroupSpanSpecs spanSpecs
3600 upvar #0 tableGroupRowDope rowDope
3601 set nCols $tableGroupAttributes(cols)
3602 set nRowDefs $tableGroupAttributes(rows)
3604 upvar #0 entryTableSpanSpecs spanSpecs
3605 upvar #0 entryTableRowDope rowDope
3606 set nCols $entryTableAttributes(cols)
3607 set nRowDefs $entryTableAttributes(rows)
3610 # get the proper list of ColSpecs for the current context
3611 switch $grandparent {
3612 THEAD { if {$ancestor == "ENTRYTBL"} {
3613 upvar #0 entryTableHeadColSpecs colSpecs
3615 upvar #0 tableGroupHeadColSpecs colSpecs
3618 TBODY { if {$ancestor == "ENTRYTBL"} {
3619 upvar #0 entryTableColSpecs colSpecs
3621 upvar #0 tableGroupColSpecs colSpecs
3624 TFOOT { upvar #0 tableFootColSpecs colSpecs }
3628 if {$spanName != ""} {
3629 if {[info exists spanSpecs($spanName)]} {
3630 array set thisSpan $spanSpecs($spanName)
3631 # SpanSpec column names win over explicit ones
3632 set nameSt $thisSpan(nameSt)
3633 set nameEnd $thisSpan(nameEnd)
3635 UserError "Attempt to use undefined SpanSpec \"$spanName\"" yes
3639 # nameSt, whether explicit or from a span, wins over colName
3640 if {$nameSt != ""} {
3644 # get the row information - use upvar so we can update rowDope
3645 upvar 0 rowDope(currentRow) currentRow
3646 upvar 0 rowDope(row$currentRow) thisRow
3647 upvar 0 rowDope(nRows) nRows
3649 # by now, if no colName we must have neither colName, nameSt nor
3650 # a horizontal span - find the next open spot in this row
3651 if {$colName != ""} {
3652 if {[info exists colNames($colName)]} {
3653 set startColNum $colNames($colName)
3654 if {$startColNum > $nCols} {
3655 UserError "Attempt to address column outside of table" yes
3658 incr startColNum -1 ;# make the column number 0 based
3661 UserError "Attempt to use undefined column name \"$colName\"" yes
3665 if {$colName == ""} {
3667 while {[lindex $thisRow $index] != ""} {
3670 if {$index == $nCols} {
3671 UserError "More entries defined than columns in this row" yes
3674 set startColNum $index
3677 # if we have a nameEnd, it was either explicit or via a span -
3678 # get the stop column number; else set the stop column to the
3679 # start column, i.e., a span of 1
3680 if {$nameEnd == ""} {
3681 set stopColNum $startColNum
3683 if {[info exists colNames($nameEnd)]} {
3684 set stopColNum $colNames($nameEnd)
3685 if {$stopColNum > $nCols} {
3686 UserError "Attempt to address column outside of table" yes
3687 set stopColNum $nCols
3689 incr stopColNum -1 ;# make the column number 0 based
3690 if {$startColNum > $stopColNum} {
3691 UserError "End of column span is before the start" yes
3692 set stopColNum $startColNum
3695 UserError "Attempt to use undefined column name \"$nameEnd\"" yes
3696 set stopColNum $startColNum
3700 # create an empty set of attributes for the cell - we'll fill
3701 # them in from the ColSpec, SpanSpec, Row and Entry or EntryTbl
3702 # defined values, if any, in that order
3708 # initialize the cell description with the ColSpec data
3709 # Table, TGroup and EntryTable attributes have already
3710 # percolated to the ColSpec
3711 if {$startColNum >= 0} {
3712 array set thisColSpec [lindex $colSpecs $startColNum]
3713 if {$thisColSpec(colSep) != ""} {
3714 set cellColSep $thisColSpec(colSep)
3716 if {$thisColSpec(rowSep) != ""} {
3717 set cellRowSep $thisColSpec(rowSep)
3721 # overlay any attributes defined on the span, that is, SpanSpec
3722 # attributes win over ColSpec ones
3723 if {[info exists thisSpan]} {
3724 if {$thisSpan(align) != ""} {
3725 set cellAlign $thisSpan(align)
3727 if {$thisSpan(colSep) != ""} {
3728 set cellColSep $thisSpan(colSep)
3730 if {$thisSpan(rowSep) != ""} {
3731 set cellRowSep $thisSpan(rowSep)
3735 # overlay any attributes defined on the Row
3736 if {$rowDope(rowSep) != ""} {
3737 set cellRowSep $rowDope(rowSep)
3739 if {$rowDope(vAlign) != ""} {
3740 set cellVAlign $rowDope(vAlign)
3743 # check for a char other than "" or "."; just a check, we don't
3744 # do anything with char
3745 set char [CheckChar $char]
3747 # overlay any attributes defined on the Entry or EntryTbl - these
3750 set cellAlign $align
3752 if {$colSep != ""} {
3753 set cellColSep $colSep
3755 if {$rowSep != ""} {
3756 set cellRowSep $rowSep
3758 if {$vAlign != ""} {
3759 set cellVAlign $vAlign
3762 # if this cell is the first on the row, feed it the (possible)
3763 # Row ID and set the Row ID to ""
3764 if {[set cellId $rowDope(id)] == ""} {
3765 set cellId SDL-RESERVED[incr nextId]
3770 # now put the cell into the rowDope vector - if there's a
3771 # span, we'll put the cell in several slots; if there's a
3772 # vertical straddle, we may need to add more rows to rowDope
3773 if {$startColNum >= 0} {
3774 set stopRowNum [expr "$currentRow + $moreRows"]
3775 set spanLength [expr "($stopColNum - $startColNum) + 1"]
3776 set rowIndex $currentRow
3777 while {$rowIndex <= $stopRowNum} {
3778 if {![info exists rowDope(row$rowIndex)]} {
3779 set rowDope(row$rowIndex) [MakeEmptyRow $nCols]
3782 upvar 0 rowDope(row$rowIndex) thisRow
3783 set colIndex $startColNum
3784 while {$colIndex <= $stopColNum} {
3785 if {[lindex $thisRow $colIndex] != ""} {
3786 set badValMess1 "Multiple definitions for column"
3787 set badValMess2 "of row $rowIndex"
3789 "$badValMess1 [expr $colIndex + 1] $badValMess2" yes
3796 Replace thisRow $startColNum $spanLength $cellId
3801 # on the last column, the column separator should be 0; on the
3802 # last row, the row separator should be 0 - the table frame will
3803 # set the border on the right and bottom sides
3804 if {$stopColNum == $nCols} {
3807 if {$currentRow == $nRowDefs} {
3808 if {($grandparent == "TFOOT") ||
3809 (($grandparent == "TBODY") && (!$haveTFoot))} {
3814 # push a form to hold the RowSep
3815 if {$cellRowSep == 1} {
3816 set ssi "BORDER-BOTTOM"
3818 set ssi "BORDER-NONE"
3820 PushFormCell $ssi $cellId
3822 # build the SSI= for the cell and push a form to hold it
3823 if {$gi == "ENTRY"} {
3829 "" { append ssi "NONE-" }
3830 LEFT { append ssi "LEFT-" }
3831 RIGHT { append ssi "RIGHT-" }
3832 CENTER { append ssi "CENTER-" }
3833 JUSTIFY { append ssi "LEFT-" }
3834 CHAR { append ssi "CHAR-" }
3836 switch $cellColSep {
3837 0 { append ssi "NO-" }
3838 1 { append ssi "YES-" }
3840 switch $cellVAlign {
3842 NONE { append ssi "NONE" }
3843 TOP { append ssi "TOP" }
3844 MIDDLE { append ssi "MIDDLE" }
3845 BOTTOM { append ssi "BOTTOM" }
3847 PushForm CELL $ssi $id
3849 # if we are in an Entry, open a paragraph in case all that's in
3850 # the Entry are inline objects - this may end up in an empty P
3851 # if the Entry contains paragraph level things, e.g., admonitions,
3852 # lists or paragraphs; if we are an EntryTbl, set up the defaults
3853 # for the recursive calls to, e.g., THead or TBody
3854 if {$gi == "ENTRY"} {
3855 StartParagraph "" "" ""
3857 # the syntax would allow multiple TBODY in an ENTRYTBL but
3858 # we (and the rest of the SGML community, e.g., SGML/Open)
3859 # don't allow more than one - the transpec will keep us from
3860 # seeing the extras but we need to flag the error to the user
3861 if {$nTBodies != 1} {
3862 UserError "More than one TBODY in an ENTRYTBL" yes
3865 set entryTableAttributes(align) $align
3866 set entryTableAttributes(char) [CheckChar $char]
3868 # do a sanity check on the number of columns, there must be
3871 UserError "Unreasonable number of columns ($cols) in EntryTbl" yes
3874 set entryTableAttributes(cols) $cols
3876 if {$colSep == ""} {
3877 set entryTableAttributes(colSep) 1
3879 set entryTableAttributes(colSep) $colSep
3881 if {$rowSep == ""} {
3882 set entryTableAttributes(rowSep) 1
3884 set entryTableAttributes(rowSep) $rowSep
3887 # check for more COLSPECs than COLS - error if so
3888 if {$nColSpecs > $cols} {
3890 "More ColSpecs defined than columns in an EntryTbl" yes
3893 set numberOfColSpecs $nColSpecs
3895 set entryTableColSpecs ""
3897 # if no ColSpec definitions at this level, set them all to the
3898 # defaults - take advantage of the fact that the function ColSpec
3899 # will create default column specifications to fill out up to an
3900 # explicitly set ColNum
3901 if {$nColSpecs == 0} {
3902 ColSpec "" ENTRYTBL "" "" "" $cols "" "" ""
3905 # initialize a variable used to determine if we need a separate
3906 # FORM element for THead - if ColSpec elements are not given
3907 # at that level, it can go in the same FORM as the TBody and
3908 # we can guarantee that the columns will line up
3909 set needEntryTblTHeadForm 0
3911 # and initialize a variable to hold saved FROWVEC elements
3912 # across THead into TBody in case we are merging them into
3913 # one FORM element rather than putting each in its own
3914 set entryTableSavedFRowVec ""
3919 # end a table Entry - pop the form holding the cell
3920 # attributes and the form holding the RowSep
3927 # end a table EntryTbl - pop the form holding the cell
3928 # attributes and the form holding the RowSep and clean up the
3930 proc EndEntryTbl {} {
3931 global entryTableSpanSpecs numberOfColSpecs entryTableColSpecs
3936 if {[info exists entryTableSpanSpecs]} {
3937 unset entryTableSpanSpecs
3940 unset entryTableColSpecs
3943 ######################################################################
3944 ######################################################################
3948 ######################################################################
3949 ######################################################################
3951 # change the OutputString routine into one that will save the content
3952 # of this element for use as the man-page title, e.g., the "cat"
3953 # in "cat(1)"; this name may be overridden by RefDescriptor in
3954 # RefNameDiv if the sort name is different (e.g., "memory" for
3956 proc DivertOutputToManTitle {} {
3957 rename OutputString SaveManTitleOutputString
3958 rename ManTitleOutputString OutputString
3962 # change the output stream back to the OutputString in effect at the
3963 # time of the call to DivertOutputToManTitle
3964 proc RestoreOutputStreamFromManTitle {} {
3965 rename OutputString ManTitleOutputString
3966 rename SaveManTitleOutputString OutputString
3970 # a routine to buffer the output into the string "manTitle" for later
3971 # use in the top corners of man-pages
3972 proc ManTitleOutputString {string} {
3975 append manTitle $string
3979 # change the OutputString routine into one that will save the content
3980 # of this element for use as the man-page volume number, e.g., the "1"
3982 proc DivertOutputToManVolNum {} {
3983 rename OutputString SaveManVolNumOutputString
3984 rename ManVolNumOutputString OutputString
3988 # change the output stream back to the OutputString in effect at the
3989 # time of the call to DivertOutputToManVolNum
3990 proc RestoreOutputStreamFromManVolNum {} {
3991 rename OutputString ManVolNumOutputString
3992 rename SaveManVolNumOutputString OutputString
3996 # a routine to buffer the output into the string "manVolNum" for later
3997 # use in the top corners of man-pages
3998 proc ManVolNumOutputString {string} {
4001 append manVolNum $string
4005 # start a reference name division; nothing to emit now, just save
4006 # the number of names defined in this division and initialize the
4007 # current name count to 1
4008 proc StartRefNameDiv {nNames} {
4009 global numManNames currentManName
4011 set numManNames $nNames
4012 set currentManName 1
4016 # end a reference name division; we can now emit the HEAD elements to
4017 # create the titles in the upper corners and the "NAME" section of the
4019 proc EndRefNameDiv {id} {
4020 global manTitle manVolNum manDescriptor manNames manPurpose
4021 global localizedAutoGeneratedStringArray
4023 set manPageName $manTitle
4024 if {$manDescriptor != ""} {
4025 set manPageName $manDescriptor
4028 # emit the titles in the upper left and right corners
4029 Emit "<HEAD TYPE=\"LITERAL\" SSI=\"MAN-PAGE-TITLE-LEFT\">"
4030 Emit "${manPageName}($manVolNum)"
4032 Emit "<HEAD TYPE=\"LITERAL\" SSI=\"MAN-PAGE-TITLE-RIGHT\">"
4033 Emit "${manPageName}($manVolNum)"
4036 # and the NAME section
4038 Emit "<HEAD TYPE=\"LITERAL\" SSI=\"MAN-PAGE-DIVISION-NAME\">"
4040 Emit $localizedAutoGeneratedStringArray($message)
4042 StartBlock "" "MAN-PAGE-DIVISION" "" 1
4043 StartParagraph "" "" ""
4044 Emit "$manNames - $manPurpose"
4049 # change the OutputString routine into one that will save the content
4050 # of this element for use as the man-page descriptor, e.g., the
4051 # "string" in "string(3C)"
4052 proc DivertOutputToManDescriptor {} {
4053 rename OutputString SaveManDescriptorOutputString
4054 rename ManDescriptorOutputString OutputString
4058 # change the output stream back to the OutputString in effect at the
4059 # time of the call to DivertOutputToManDescriptor
4060 proc RestoreOutputStreamFromManDescriptor {} {
4061 rename OutputString ManDescriptorOutputString
4062 rename SaveManDescriptorOutputString OutputString
4066 # a routine to buffer the output into the string "manDescriptor" for
4067 # later use in the top corners of man-pages
4068 proc ManDescriptorOutputString {string} {
4069 global manDescriptor
4071 append manDescriptor $string
4075 # change the OutputString routine into one that will save the content
4076 # of this element for use as the man-page command or function name,
4077 # e.g., the "cat" in "cat(1)"
4078 proc DivertOutputToManNames {} {
4079 rename OutputString SaveManNamesOutputString
4080 rename ManNamesOutputString OutputString
4084 # change the output stream back to the OutputString in effect at the
4085 # time of the call to DivertOutputToManNames
4086 proc RestoreOutputStreamFromManNames {} {
4087 rename OutputString ManNamesOutputString
4088 rename SaveManNamesOutputString OutputString
4092 # a routine to buffer the output into the string "manNames" for
4093 # later use in the top corners of man-pages
4094 proc ManNamesOutputString {string} {
4097 append manNames $string
4101 # collect RefName elements into a single string; start diversion to
4102 # the string on the first man name
4103 proc StartAManName {} {
4104 global numManNames currentManName
4106 if {$currentManName == 1} {
4107 DivertOutputToManNames
4112 # end diversion on the last man name; append "(), " to each name but
4113 # the last to which we only append "()"
4114 proc EndAManName {} {
4115 global numManNames currentManName manDescriptor manNames
4117 if {($currentManName == 1) && ($manDescriptor == "")} {
4118 set manDescriptor $manNames
4121 if {$currentManName < $numManNames} {
4123 } elseif {$currentManName == $numManNames} {
4124 RestoreOutputStreamFromManNames
4131 # change the OutputString routine into one that will save the content
4132 # of this element for use as the man-page purpose; this string will
4133 # follow the function or command name(s) separated by a "-"
4134 proc DivertOutputToManPurpose {} {
4135 rename OutputString SaveManPurposeOutputString
4136 rename ManPurposeOutputString OutputString
4140 # change the output stream back to the OutputString in effect at the
4141 # time of the call to DivertOutputToManPurpose
4142 proc RestoreOutputStreamFromManPurpose {} {
4143 rename OutputString ManPurposeOutputString
4144 rename SaveManPurposeOutputString OutputString
4148 # a routine to buffer the output into the string "manPurpose" for
4149 # later use in the NAME section of man-pages
4150 proc ManPurposeOutputString {string} {
4153 append manPurpose $string
4157 # start a reference synopsis division - create a FORM to hold the
4158 # division and, potentially, any RefSect2-3; if there is a Title on
4159 # RefSynopsisDiv, use it, else default to "SYNOPSIS"
4160 proc StartRefSynopsisDiv {id haveTitle nSynopses} {
4161 global remainingSynopses
4162 global localizedAutoGeneratedStringArray
4164 set remainingSynopses $nSynopses
4167 StartManPageDivisionTitle ""
4168 set message "SYNOPSIS"
4169 Emit $localizedAutoGeneratedStringArray($message)
4170 EndManPageDivisionTitle
4175 # the user provided a title for this section, use it
4176 proc StartManPageDivisionTitle {id} {
4178 set id " ID=\"$id\""
4180 Emit "<HEAD$id TYPE=\"LITERAL\" SSI=\"MAN-PAGE-DIVISION-NAME\">"
4184 # the user provided a title for this section, we need to open a form
4185 # to hold the section now
4186 proc EndManPageDivisionTitle {} {
4188 PushForm "" "MAN-PAGE-DIVISION" ""
4191 # begin a Synopsis - if this is the first of any of the synopses, emit
4192 # a FORM to hold them all
4193 proc StartSynopsis {id linespecific} {
4194 if {$linespecific == ""} {
4199 StartParagraph id "" $type
4203 # end any of Synopsis, CmdSynopsis or FuncSynopsis - close out the
4204 # form if it's the last one
4205 proc EndSynopses {parent} {
4206 global remainingSynopses
4210 if {($parent == "REFSYNOPSISDIV") && ([incr remainingSynopses -1] == 0)} {
4216 # begin a CmdSynopsis
4217 proc StartCmdSynopsis {id} {
4218 StartParagraph id "" ""
4222 # start a man-page argument - surround the arg in a KEY element
4223 proc StartArg {id choice separator} {
4224 # mark this spot if there's a user supplied ID
4227 # emit nothing at start of list, v-bar inside of Group else space
4230 Emit "<KEY CLASS=\"NAME\" SSI=\"MAN-PAGE-ARG\">"
4231 if {$choice == "OPT"} {
4233 } elseif {$choice == "REQ"} {
4239 # end a man-page argument - if choice is not "plain", emit the proper
4240 # close character for the choice; if repeat is "repeat", emit an
4241 # ellipsis after the arg
4242 proc EndArg {choice repeat} {
4243 if {$choice == "OPT"} {
4245 } elseif {$choice == "REQ"} {
4248 if {$repeat == "REPEAT"} {
4249 Emit "<SPC NAME=\"\[hellip\]\">"
4255 # start an argument, filename, etc., group in a man-page command
4257 proc StartGroup {id choice separator} {
4258 # mark this spot if there's a user supplied ID
4261 # emit nothing at start of list, v-bar inside of Group else space
4264 # clean up optmult/reqmult since, for example, req+repeat == reqmult,
4265 # optmult and reqmult are redundant
4266 if {$choice == "OPTMULT"} {
4268 } elseif {$choice == "REQMULT"} {
4272 if {$choice == "OPT"} {
4274 } elseif {$choice == "REQ"} {
4280 # end an argument, filename, etc., group in a man-page command
4282 proc EndGroup {choice repeat} {
4283 # clean up optmult/reqmult since, for example, req+repeat == reqmult,
4284 # optmult and reqmult are redundant
4285 if {$choice == "OPTMULT"} {
4288 } elseif {$choice == "REQMULT"} {
4292 if {$choice == "OPT"} {
4294 } elseif {$choice == "REQ"} {
4297 if {$repeat == "REPEAT"} {
4298 Emit "<SPC NAME=\"\[hellip\]\">"
4303 # start a command name in a man-page command synopsis
4304 proc StartCommand {id separator} {
4305 # mark this spot if there's a user supplied ID
4308 # emit nothing at start of synopsis else space
4311 Emit "<KEY CLASS=\"NAME\" SSI=\"MAN-PAGE-COMMAND\">"
4315 # begin a FuncSynopsis
4316 proc StartFuncSynopsis {id} {
4320 # check that the GI of the element pointed to by a SynopFragmentRef
4321 # is really a SynopFragment
4322 proc CheckSynopFragmentRef {gi id} {
4323 if {$gi != "SYNOPFRAGMENT"} {
4324 set badValMess1 "SynopFragmentRef LinkEnd=$id"
4325 set badValMess2 "must refer to a SynopFragment"
4326 UserError "$badValMess1 $badValMess2" yes
4331 # begin a FuncSynopsisInfo - emit a P to hold it
4332 proc StartFuncSynopsisInfo {id linespecific} {
4333 if {$linespecific == "LINESPECIFIC"} {
4334 set type " TYPE=\"LINED\""
4339 StartParagraph $id "FUNCSYNOPSISINFO" $type
4343 # begin a FuncDef - emit a P to hold it
4344 proc StartFuncDef {id} {
4345 StartParagraph $id "FUNCDEF" ""
4349 # end a FuncDef, emit the open paren in preparation for the args
4350 proc EndFuncDef {} {
4355 # handle Void or Varargs in a FuncSynopsis - wrap it in a KEY and
4356 # emit the string "VOID" or "VARARGS"
4357 proc DoVoidOrVarargs {gi id} {
4358 # mark this spot if there's a user supplied ID
4361 Emit "<KEY CLASS=\"NAME\" SSI=\"FUNCDEF-ARGS\">"
4368 # start a ParamDef - just emit an anchor, if needed, for now
4369 proc StartParamDef {id} {
4370 # mark this spot if there's a user supplied ID
4375 # end of a ParamDef - emit either the ", " for the next one or, if the
4376 # last, emit the closing ")"
4377 proc EndParamDef {separator} {
4382 # start a FuncParams - just emit an anchor, if needed, for now
4383 proc StartFuncParams {id} {
4384 # mark this spot if there's a user supplied ID
4389 # end of a FuncParams - emit either the ", " for the next one or, if the
4390 # last, emit the closing ")"
4391 proc EndFuncParams {separator} {
4396 ######################################################################
4397 ######################################################################
4401 ######################################################################
4402 ######################################################################
4403 # open an intradocument link
4404 proc StartLink {id linkend type} {
4405 StartParagraphMaybe "" "P" $id
4407 Emit "<LINK RID=\"$linkend\""
4409 set type [string toupper $type]
4411 JUMPNEWVIEW {Emit " WINDOW=\"NEW\""}
4412 DEFINITION {Emit " WINDOW=\"POPUP\""}
4421 # defer a Link at the start of a Para until we see if the following
4422 # InlineGraphic has Role=graphic and we want it in a HEAD
4423 proc DeferLink {id linkend type} {
4426 set deferredLink(gi) LINK
4427 set deferredLink(id) $id
4428 set deferredLink(linkend) $linkend
4429 set deferredLink(type) $type
4433 # open an interdocument link; this link will require an SNB entry
4434 proc StartOLink {id localInfo type} {
4435 StartParagraphMaybe "" "P" $id
4437 set type [string toupper $type]
4439 set linkType CURRENT
4441 JUMP {set linkType CURRENT}
4442 JUMPNEWVIEW {set linkType NEW}
4444 DEFINITION {set linkType POPUP}
4447 set snbType CROSSDOC
4449 EXECUTE {set snbType SYS-CMD}
4450 APP-DEFINED {set snbType CALLBACK}
4451 MAN {set snbType MAN-PAGE}
4454 set snbId [AddToSNB $snbType $localInfo]
4456 Emit "<LINK RID=\"$snbId\""
4457 if {$linkType != "CURRENT"} {
4458 Emit " WINDOW=\"$linkType\""
4464 # defer an OLink at the start of a Para until we see if the following
4465 # InlineGraphic has Role=graphic and we want it in a HEAD
4466 proc DeferOLink {id localInfo type} {
4469 set deferredLink(gi) OLINK
4470 set deferredLink(id) $id
4471 set deferredLink(localinfo) $localinfo
4472 set deferredLink(type) $type
4476 # defer a ULink at the start of a Para until we see if the following
4477 # InlineGraphic has Role=graphic and we want it in a HEAD
4478 proc DeferULink {id} {
4481 set deferredLink(gi) ULINK
4482 set deferredLink(id) $id
4492 ######################################################################
4493 ######################################################################
4495 # character formatting
4497 ######################################################################
4498 ######################################################################
4499 # open a Quote; we'll emit two open single quotes wrapped in a
4500 # key with a style that will put them in a proportional font so they
4501 # fit together and look like an open double quote
4502 proc StartQuote {id} {
4503 Emit "<KEY CLASS=\"QUOTE\" SSI=\"PROPORTIONAL\">"
4508 # close a Quote; we'll emit two close single quotes wrapped in a
4509 # key with a style that will put them in a proportional font so they
4510 # fit together and look like a close double quote
4512 Emit "<KEY CLASS=\"QUOTE\" SSI=\"PROPORTIONAL\">''</KEY>"
4515 ######################################################################
4516 ######################################################################
4518 # end of document stuff
4520 ######################################################################
4521 ######################################################################
4523 # write out the .snb file - first update the file location for
4524 # insertion of the SNB by the second pass to reflect the addition
4525 # of the INDEX; also incorporate the INDEX and update the TOSS to
4526 # reflect any additions necessary to support tables
4528 global savedSNB indexLocation tossLocation baseName
4530 # get a handle for the index file and the existing .sdl file;
4531 # prepare to write the updated .sdl file and the .snb file by
4532 # blowing away the current names so the second open of the .sdl
4533 # file is creating a new file and we don't have leftover .snb
4534 # or .idx files laying around
4536 set sdlInFile [open "${baseName}.sdl" r]
4537 set sdlSize [file size "${baseName}.sdl"]
4539 set idxFile [open "${baseName}.idx" r]
4540 set idxSize [file size "${baseName}.idx"]
4542 exec rm -f ${baseName}.sdl ${baseName}.idx ${baseName}.snb
4543 set sdlOutFile [open "${baseName}.sdl" w]
4545 # create any additional TOSS entries made necessary by COLW and
4546 # COLJ settings for TGroup or EntryTbl elements.
4547 set toss [CreateTableTOSS]
4548 set tossSize [string length $toss]
4550 # get a list of the byte offsets into the .sdl file for the
4552 set snbLocations [lsort -integer [array names savedSNB]]
4554 # and write out the .snb file updating the locations as we go
4555 if {[llength $snbLocations] > 0} {
4556 set snbFile [open "${baseName}.snb" w]
4557 foreach location $snbLocations {
4558 puts $snbFile [expr "$location + $idxSize + $tossSize"]
4559 puts -nonewline $snbFile $savedSNB($location)
4564 # now update the toss and include the index file into the sdl file
4565 # by copying the old .sdl file to the new up to the location of
4566 # the first FORMSTYLE in the TOSS and emitting the new TOSS
4567 # entries then continue copying the old .sdl file up to the index
4568 # location and copying the .idx file to the new .sdl file followed
4569 # by the rest of the old .sdl file (the old .sdl and .idx files
4570 # have already been deleted from the directory), finally, close
4573 # 1: copy the sdl file up to the first FORMSTYLE element or, if
4574 # none, to just after the open tag for the TOSS
4575 set location $tossLocation
4577 while {$location > 0} {
4578 if {$location < $readSize} { set readSize $location }
4579 puts -nonewline $sdlOutFile [read $sdlInFile $readSize]
4580 incr location -$readSize
4582 # 2: emit the TOSS updates, if any
4583 puts -nonewline $sdlOutFile $toss
4584 # 3: copy the sdl file up to the index location
4585 set location [expr "$indexLocation - $tossLocation"]
4587 while {$location > 0} {
4588 if {$location < $readSize} { set readSize $location }
4589 puts -nonewline $sdlOutFile [read $sdlInFile $readSize]
4590 incr location -$readSize
4592 # 4: copy over the index file
4593 set location $idxSize
4595 while {$location > 0} {
4596 if {$location < $readSize} { set readSize $location }
4597 puts -nonewline $sdlOutFile [read $idxFile $readSize]
4598 incr location -$readSize
4600 # 5: and copy over the rest of the sdl file
4601 set location [expr "$sdlSize - $indexLocation"]
4603 while {$location > 0} {
4604 if {$location < $readSize} { set readSize $location }
4605 puts -nonewline $sdlOutFile [read $sdlInFile $readSize]
4606 incr location -$readSize
4608 # 6: close the output
4613 # read the global variable newTOSS and use the information to create
4614 # TOSS entries for THead, TBody and TFoot; these entries will contain
4615 # the justification and width information for the table sub-components;
4616 # return the new TOSS elements
4617 proc CreateTableTOSS {} {
4621 foreach ssi [array names newTOSS] {
4622 array set thisTOSSdata $newTOSS($ssi)
4623 set vAlign $thisTOSSdata(vAlign)
4627 TOP { set vJust "TOP" }
4628 MIDDLE { set vJust "CENTER" }
4629 BOTTOM { set vJust "BOTTOM" }
4632 append returnValue "<FORMSTYLE\n"
4633 append returnValue " CLASS=\"TABLE\"\n"
4634 append returnValue " SSI=\"$ssi\"\n"
4635 append returnValue \
4636 " PHRASE=\"TGroup, THead or TBody specification\"\n"
4637 append returnValue " COLW=\"$thisTOSSdata(colW)\"\n"
4638 append returnValue " COLJ=\"$thisTOSSdata(colJ)\"\n"
4640 append returnValue " VJUST=\"${vJust}-VJUST\"\n"
4642 append returnValue ">\n"
4649 # try to open a file named docbook.tss either in our current
4650 # directory or on TOSS_PATH - if it exists, copy it to
4651 # the output file as the TOSS - when the first line containing
4652 # "<FORMSTYLE" is seen, save the location so we can include the
4653 # updates to the TOSS necessary due to needing FORMSTYLE entries for
4654 # tables with the appropriate COLJ and COLW values
4655 proc IncludeTOSS {} {
4656 global tossLocation TOSS_PATH
4661 # look for docbook.tss in the current directory first, then on the path
4662 set path ". [split $TOSS_PATH :]"
4664 set tssFileName $dir/docbook.tss
4665 if {[file exists $tssFileName]} {
4672 if {[file readable $tssFileName]} {
4673 set tssFile [open $tssFileName r]
4674 set eof [gets $tssFile line]
4675 while {$eof != -1} {
4676 if {[string match "*<FORMSTYLE*" [string toupper $line]]} {
4677 set tossLocation [tell stdout]
4680 set eof [gets $tssFile line]
4684 UserError "$tssFileName exists but is not readable" no
4687 UserWarning "Could not find docbook.tss - continuing with null TOSS" no
4690 if {$tossLocation == -1} {
4691 set tossLocation [tell stdout]
4695 proc GetLocalizedAutoGeneratedStringArray {filename} {
4696 global localizedAutoGeneratedStringArray
4698 set buffer [ReadLocaleStrings $filename]
4700 set regExp {^(".*")[ ]*(".*")$} ;# look for 2 quoted strings
4702 set stringList [split $buffer \n]
4703 set listLength [llength $stringList]
4705 while {$listLength > 0} {
4706 set line [lindex $stringList $index]
4707 set line [string trim $line]
4708 if {([string length $line] > 0) && ([string index $line 0] != "#")} {
4709 if {[regexp $regExp $line match match1 match2]} {
4710 set match1 [string trim $match1 \"]
4711 set match2 [string trim $match2 \"]
4712 set localizedAutoGeneratedStringArray($match1) $match2
4715 "Malformed line in $filename line [expr $index + 1]" no
4722 set message "Home Topic"
4723 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4724 set localizedAutoGeneratedStringArray($message) $message
4726 set message "No home topic (PartIntro) was specified by the author."
4727 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4728 set localizedAutoGeneratedStringArray($message) $message
4731 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4732 set localizedAutoGeneratedStringArray($message) $message
4734 set message "See Also"
4735 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4736 set localizedAutoGeneratedStringArray($message) $message
4739 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4740 set localizedAutoGeneratedStringArray($message) $message
4742 set message "SYNOPSIS"
4743 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4744 set localizedAutoGeneratedStringArray($message) $message
4749 # start - initialize variables and write the preamble
4750 proc OpenDocument {host base date} {
4751 global docId baseName indexLocation snbLocation
4752 global validMarkArray partIntroId nextId
4753 global NO_UNIQUE_ID LOCALE_STRING_DIR
4754 global language charset
4756 # NO_UNIQUE_ID will be set to YES for test purposes so we don't
4757 # get spurious mismatches from the timestamp of from the system on
4758 # which the document was processed.
4759 if {[string toupper $NO_UNIQUE_ID] == "YES"} {
4767 GetLocalizedAutoGeneratedStringArray ${LOCALE_STRING_DIR}/strings
4769 # split out the language and charset info from LOCALE_STRING_DIR
4770 # first, remove any directory information
4771 set languageAndCharset [lindex [split $LOCALE_STRING_DIR /] end]
4772 # then split the language and charset at the dot
4773 set languageAndCharset [split $languageAndCharset .]
4774 # and extract the values from the resulting list
4775 set language [lindex $languageAndCharset 0]
4776 set charset [lindex $languageAndCharset 1]
4780 # set up the validMarkArray values
4783 # if we have a PartIntro element, use its ID as the first-page
4784 # attribute - if no ID, assign one; if no PartIntro, assign an
4785 # ID and we'll dummy in a hometopic when we try to emit the first
4787 if {![info exists partIntroId]} {
4790 if {$partIntroId == ""} {
4791 # set partIntroId SDL-RESERVED[incr nextId]
4792 set partIntroId SDL-RESERVED-HOMETOPIC
4796 Emit "<SDLDOC PUB-ID=\"CDE 2.1\""
4797 Emit " DOC-ID=\"$docId\""
4798 Emit " LANGUAGE=\"$language\""
4799 Emit " CHARSET=\"$charset\""
4800 Emit " FIRST-PAGE=\"$partIntroId\""
4801 Emit " TIMESTMP=\"$timeStamp\""
4802 Emit " SDLDTD=\"1.1.1\">\n"
4804 # and create the VSTRUCT - the INDEX goes in it, the SNB goes after
4805 # it; if there's a Title later, it'll reset the SNB location;
4806 # we also need to read in docbook.tss (if any) and to create an
4807 # empty TOSS to cause the second pass to replace docbook.tss with
4808 # <src file name>.tss (if any) in the new .sdl file
4809 Emit "<VSTRUCT DOC-ID=\"$docId\">\n"
4810 Emit "<LOIDS>\n</LOIDS>\n<TOSS>\n"
4813 set indexLocation [tell stdout]
4815 set snbLocation [tell stdout]
4819 # done - write the index and close the document
4820 proc CloseDocument {} {
4821 global inVirpage errorCount warningCount
4822 global snbLocation savedSNB currentSNB
4824 # close any open block and the current VIRPAGE
4826 Emit $inVirpage; set inVirpage ""
4828 # if the last VIRPAGE in the document had any system notation
4829 # block references, we need to add them to the saved snb array
4830 # before writing it out
4831 set names [array names currentSNB]
4832 if {[llength $names] != 0} {
4833 foreach name $names {
4834 # split the name into the GI and xid of the SNB entry
4835 set colonLoc [string first "::" $name]
4836 set type [string range $name 0 [incr colonLoc -1]]
4837 set data [string range $name [incr colonLoc 3] end]
4840 append tempSNB "<$type ID=\"$currentSNB($name)\" "
4848 TEXTFILE { set command "XID" }
4849 SYS-CMD { set command "COMMAND" }
4850 CALLBACK { set command "DATA" }
4852 append tempSNB "$command=\"$data\">\n"
4854 set savedSNB($snbLocation) $tempSNB
4858 # close the document and write out the stored index and system
4864 if {$errorCount || $warningCount} {
4865 puts stderr "DtDocBook total user errors: $errorCount"
4866 puts stderr "DtDocBook total user warnings: $warningCount"
4869 if {$errorCount > 0} {
4873 if {$warningCount > 0} {