1 # set the global variables
2 set nextId 0 ;# gets incremented before each use
4 set errorCount 0 ;# number of user errors
5 set warningCount 0 ;# number of user warnings
7 set havePartIntro 0 ;# need to emit a hometopic
9 set firstPInBlock 0 ;# allows a different SSI for first P
10 set inBlock "" ;# holds "</BLOCK>\n" when in a BLOCK
11 set inVirpage "" ;# holds "</VIRPAGE>\n" when in a VIRPAGE
12 set needFData "" ;# holds "<FDATA>\n" if needed (starting a FORM)
13 set inP 0 ;# flag that we're in an SDL paragraph
15 set formStack {} ;# need to stack FORMs when they contain others
17 set listStack {} ;# holds type of list and spacing for ListItem
19 # create some constants for converting list count to ordered label
20 set ROMAN0 [list "" I II III IV V VI VII VIII IX]
21 set ROMAN10 [list "" X XX XXX XL L LX LXX LXXX XC]
22 set ROMAN100 [list "" C CC CCC CD D DC DCC DCCC CM]
23 set roman0 [list "" i ii iii iv v vi vii viii ix]
24 set roman10 [list "" x xx xxx xl l lx lxx lxxx xc]
25 set roman100 [list "" c cc ccc cd d dc dcc dccc cm]
26 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]
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 DIGITS [list 0 1 2 3 4 5 6 7 8 9]
29 set NZDIGITS [list "" 1 2 3 4 5 6 7 8 9]
31 # specify the "level" value to be given to VIRPAGEs (based on SSI);
32 # the indexes for this associative array are also used to determine
33 # whether the closing of a DocBook Title should re-position the
34 # snbLocation (because the SNB follows HEADs, if any)
35 set virpageLevels(FOOTNOTE) 0
36 set virpageLevels(TITLE) 0
37 set virpageLevels(AUTHORGROUP) 0
38 set virpageLevels(ABSTRACT) 0
39 set virpageLevels(REVHISTORY) 0
40 set virpageLevels(LEGALNOTICE) 0
41 set virpageLevels(PARTINTRO) 1
42 set virpageLevels(CHAPTER) 2
43 set virpageLevels(APPENDIX) 2
44 set virpageLevels(BIBLIOGRAPHY) 2
45 set virpageLevels(GLOSSARY) 2
46 set virpageLevels(INDEX) 2
47 set virpageLevels(LOT) 2
48 set virpageLevels(PREFACE) 2
49 set virpageLevels(REFENTRY) 2
50 set virpageLevels(REFERENCE) 2
51 set virpageLevels(TOC) 2
52 set virpageLevels(SECT1) 3
53 set virpageLevels(SECT2) 4
54 set virpageLevels(SECT3) 5
55 set virpageLevels(SECT4) 6
56 set virpageLevels(SECT5) 7
58 # assume the first ID used is SDL-RESERVED1 - if we get a INDEXTERM
59 # before anything has started, default to the assumed ID
60 set mostRecentId "SDL-RESERVED1"
62 # a counter for use in pre-numbering footnotes - will create an
63 # associative array indexed by "FOOTNOTE ID=" values to hold
64 # the number of the FOOTNOTE for use by FOOTNOTEREF
67 # the absolute byte offset into the output file where the SNB should be
68 # inserted by the second pass - the location and snb get saved at
69 # the end of each VIRPAGE with a little special handling for the
70 # SDLDOC SNB, the entire snb gets written to the .snb file at
71 # the close of the document after the saved locations get incremented
72 # by the size of the index
75 # normally, we dafault paragraphs to no TYPE= attribute; when in an
76 # EXAMPLE, for instance, we need to default to TYPE="LITERAL"
77 set defaultParaType ""
80 # print internal error message and exit
81 proc InternalError {what} {
88 # print a warning message
89 proc UserWarning {what location} {
92 puts stderr "DtDocBook User Warning: $what"
100 # print an error message plus the location in the source file of the
101 # error; if we get more than 100 errors, quit
102 proc UserError {what location} {
105 puts stderr "DtDocBook User Error: $what"
109 if {[incr errorCount] >= 100} {
110 puts stderr "Too many errors - quitting"
116 # set up a default output string routine so everything works even
117 # if run outside of instant(1)
118 if {[info commands OutputString] == ""} {
119 proc OutputString {string} {
120 puts -nonewline "$string"
125 # set up a default string compare routine so everything works even
126 # if run outside of instant(1); it won't really be i18n safe, but
127 # it'll give us a dictionary sort
128 if {[info commands CompareI18NStrings] == ""} {
129 proc CompareI18NStrings {string1 string2} {
130 set string1 [string toupper $string1]
131 set string2 [string toupper $string2]
132 if {$string1 > $string2} {
134 } else if {$string1 < $string2} {
143 # emit a string to the output stream
149 # push an item onto a stack (a list); return item pushed
150 proc Push {stack item} {
157 # pop an item from a stack (i.e., a list); return the popped item
162 InternalError "Stack underflow in Pop"
165 set item [lindex $s $top]
167 set s [lrange $s 0 $top]
172 # return the top of a stack (the stack is a list)
177 set item [lindex $s $top]
181 # replace the top of the stack with the new item; return the item
182 proc Poke {stack item} {
186 set s [lreplace $s $top $top $item]
191 # emit an ID and save it for reference as the most recently emitted ID;
192 # the saved value will be used to mark locations for index entries
196 set mostRecentId $name
197 return "ID=\"$name\""
201 # emit an ANCHOR into the SDL stream; if the passed id is empty, don't
205 Emit "<ANCHOR [Id $id]>"
210 # emit an ANCHOR into the SDL stream; if the passed id is empty, don't
211 # emit the anchor; if we're not in an SDL P yet, start one and use
212 # the id there rather than emitting an SDL ANCHOR
213 proc AnchorInP {id} {
218 StartParagraph $id "P" ""
220 Emit "<ANCHOR [Id $id]>"
226 # set up containers for the IDs of the blocks holding marks - clear
227 # on entry to each <virpage> but re-use within the <virpage> as much as
228 # possible; we need two each of the regular and loose versions because
229 # we need to alternate to avoid the <form> runtime code thinking we're
230 # trying to span columns
232 # specify a routine to (re-)initialize all the variables for use
234 proc ReInitPerMarkInfo {} {
235 global validMarkArray
237 foreach mark [array names validMarkArray] {
238 global FIRSTTIGHT${mark}Id
239 set FIRSTTIGHT${mark}Id ""
241 global FIRSTLOOSE${mark}Id
242 set FIRSTLOOSE${mark}Id ""
244 global TIGHT${mark}Id0
245 set TIGHT${mark}Id0 ""
247 global TIGHT${mark}Id1
248 set TIGHT${mark}Id1 ""
250 global LOOSE${mark}Id0
251 set LOOSE${mark}Id0 ""
253 global LOOSE${mark}Id1
254 set LOOSE${mark}Id1 ""
256 global TIGHT${mark}num
257 set TIGHT${mark}num 1
259 global LOOSE${mark}num
260 set LOOSE${mark}num 1
265 # add a new mark to the mark array and initialize all the variables
266 # that depend on the mark; the index for the mark is just the mark
267 # itself with the square brackets removed and whitespace deleted;
268 # we've already guaranteed that the mark will be of the form
269 # "[??????]" (open-square, 6 characters, close-square) and that this
270 # mark isn't in the array already
271 proc AddToMarkArray {mark} {
272 global validMarkArray
274 set m [string range $mark 1 6]
275 set m [string trim $m]
277 set validMarkArray($m) $mark
279 global FIRSTTIGHT${m}Id
280 set FIRSTTIGHT${m}Id ""
282 global FIRSTLOOSE${m}Id
283 set FIRSTLOOSE${m}Id ""
307 # start a new paragraph; start a block if necessary
308 proc StartParagraph {id ssi type} {
309 global inBlock firstPInBlock inP defaultParaType
311 # close any open paragraph
312 if {$inP} { Emit "</P>\n" }
314 # if not in a BLOCK, open one
315 if {$inBlock == ""} { StartBlock "" "" "" 1 }
318 if {$id != ""} { Emit " [Id $id]" }
320 # don't worry about whether we're the first para if there's no SSI
323 if {$firstPInBlock} {
329 Emit " SSI=\"$ssi$firstString\""
333 Emit $defaultParaType
335 Emit " TYPE=\"$type\""
341 set inBlock "</P>\n</BLOCK>\n"
345 # conditionally start a paragraph - that is, only start a new
346 # paragraph if we aren't in one already
347 proc StartParagraphMaybe {id ssi type} {
353 StartParagraph $id $ssi $type
358 # start a compound paragraph - a compound paragraph is when a Para
359 # contains some other element that requires starting its own SDL
360 # BLOCK or FORM, e.g., VariableList; we need to create a FORM to hold
361 # the Para and its parts - put the id and ssi on the FORM rather than
363 proc StartCompoundParagraph {id ssi type} {
367 if {$firstPInBlock} {
372 PushForm "" $ssi$firstString $id
377 StartParagraph "" "" ""
381 # given the path of parentage of an element, return its n'th ancestor
382 # (parent == 1), removing the child number (if any); e.g., convert
383 # "PART CHAPTER(0) TITLE" into "CHAPTER" if level is 2
384 proc Ancestor {path level} {
385 if {$level < 0} { return "_UNDERFLOW_" }
387 set last [llength $path]
390 if {$level > $last} { return "_OVERFLOW_" }
392 # invert "level" about "last" so we count from the end
393 set level [expr "$last - $level"]
395 set parent [lindex $path $level]
396 set parent [lindex [split $parent "("] 0] ;# remove child #
400 # start a HEAD element for the DocBook Title - use the parent's
401 # GI in the SSI= of the HEAD except that all titles to things in
402 # their own topic (VIRPAGE) will use an SSI of CHAPTER-TITLE;
403 # if we are in a topic with a generated id (e.g., _glossary or
404 # _title), we might have saved an id or two in savedId to be
405 # emitted in the HEAD
406 proc Title {id parent} {
407 global virpageLevels partID inP savedId
415 # if we are the Title of a PartIntro, we'd like to emit the
416 # partID as an anchor so linking to the volume will succeed;
417 # add it to the list of saved ids to be emitted
418 if {$parent == "PARTINTRO"} {
419 lappend savedId $partID
422 # make the HEAD for all topics (VIRPAGE) have an SSI of
423 # "CHAPTER-HEAD", use LEVEL to distinguish between them
424 set topicNames [array names virpageLevels]
425 foreach name $topicNames {
426 if {$parent == $name} {
432 Emit " SSI=\"$parent-TITLE\">"
434 # being in a HEAD is equivalent to being in a P for content model
435 # but we use "incr" instead of setting inP directly so that if we
436 # are in a P->HEAD, we won't prematurely clear inP when leaving
440 if {[info exists savedId]} {
441 foreach id $savedId {
449 # close a HEAD element for a DocBook Title - if the Title is one for
450 # a DocBook element that gets turned into an SDL VIRPAGE, set the
451 # location for the insertion of an SNB (if any) to follow the HEAD
452 proc CloseTitle {parent} {
453 global snbLocation virpageLevels inP
457 # we incremented inP on entry to the HEAD so decrement it here
460 # get a list of DocBook elements that start VIRPAGEs
461 set names [array names virpageLevels]
463 # add the start of the help volume, PART, to the list
466 # if our parent is a VIRPAGE creator or the start of the document,
467 # we must be dealing with the heading of a VIRPAGE or with the
468 # heading of the SDLDOC so move the spot where we want to include
469 # the SNB to immediately after this HEAD
470 foreach name $names {
471 if {$name == $parent} {
472 set snbLocation [tell stdout]
479 # open an SGML tag - add punctuation as guided by the class attribute
480 proc StartSgmlTag {id class} {
482 ELEMENT {set punct "&<"}
483 ATTRIBUTE {set punct ""}
484 GENENTITY {set punct "&&"}
485 PARAMENTITY {set punct "%"}
491 # close an SGML tag - add punctuation as guided by the class attribute
492 proc EndSgmlTag {class} {
494 ELEMENT {set punct ">"}
495 ATTRIBUTE {set punct ""}
496 GENENTITY {set punct ";"}
497 PARAMENTITY {set punct ";"}
503 # end a trademark, append a symbol if needed
504 proc EndTradeMark {class} {
506 SERVICE {set punct ""}
507 TRADE {set punct "<SPC NAME=\"\[trade \]\">"}
508 REGISTERED {set punct "<SPC NAME=\"\[reg \]\">"}
509 COPYRIGHT {set punct "<SPC NAME=\"\[copy \]\">"}
515 # handle the BridgeHead tag; emit a FORM to hold a HEAD and put the
516 # BridgeHead there - use the procedure Title to do all the work, the
517 # renderas attributre simply become the parent to Title
518 proc StartBridgeHead {id renderas} {
521 # default renderas to CHAPTER - arbitrarily
522 if {$renderas == "OTHER"} {
529 # end a BridgeHead; we need to close out the SDL HEAD and close the
530 # FORM - use CloseTitle to close out the HEAD but give it a null
531 # parent so it doesn't try to save the SNB now
532 proc EndBridgeHead {} {
539 proc EndParagraph {} {
546 # we set inBlock to </P></BLOCK> in StartParagraph so we need
547 # to remove the </P> here; if we're continuing a paragraph
548 # inBlock will have been set to "" when we closed the BLOCK to
549 # open the embedded FORM so we need to leave it empty to cause
550 # a new BLOCK to be opened
551 if {$inBlock != ""} {
552 set inBlock "</BLOCK>\n"
555 # and flag that we're not in a paragraph anymore
560 # continue a PARA that was interrupted by something from %object.gp;
561 # first pop the FORM that held the indent attributes for the object
562 # then start a new paragraph with an SSI that indicates we are
564 proc ContinueParagraph {} {
566 StartParagraph "" "P-CONT" ""
570 # start a new BLOCK element; close the old one, if any;
571 # return the ID in case we allocated one and someone else wants it
572 proc StartBlock {class ssi id enterInForm} {
573 global needFData inBlock formStack nextId firstPInBlock inP
575 # if we are the first BLOCK in a FORM, emit the FDATA tag
576 Emit $needFData; set needFData ""
578 # close any open block and flag that we're opening one
579 # but that we haven't seen a paragraph yet
581 set inBlock "</BLOCK>\n"
584 # if a FORM is in progress, add our ID to the row vector,
585 # FROWVEC - create an ID if one wasn't provided
586 if {$enterInForm && [llength $formStack] != 0} {
587 if {$id == ""} { set id "SDL-RESERVED[incr nextId]" }
593 if {$id != ""} { Emit " [Id $id]" }
594 if {$class != ""} { Emit " CLASS=\"$class\"" }
595 if {$ssi != ""} { Emit " SSI=\"$ssi\"" }
598 # and flag that the next paragraph is the first in a block
605 # close any open BLOCK - no-op if not in a BLOCK otherwise emit the
606 # BLOCK etag or both BLOCK and P etags if there's an open paragraph
610 if {$inBlock != ""} {
611 Emit $inBlock ;# has been prefixed with </P> if needed
618 # add another FROWVEC element to the top of the form stack
619 proc AddRowVec {ids} {
622 Push formStack "[Pop formStack]<FROWVEC CELLS=\"$ids\">\n"
626 # start a new FORM element within a THead, TBody or TFoot ("push"
627 # because they're recursive); return the ID in case we allocated one;
628 # do not enter the ID in the parent's FROWVEC, we'll do that later
629 # from the rowDope that we build to compute horizontal spans and
631 proc PushFormCell {ssi id} {
632 global needFData formStack nextId
634 Emit $needFData ;# in case we're the first in an old FORM
635 set needFData "<FDATA>\n" ;# and were now starting a new FORM
637 # close any open BLOCK
640 # make sure we have an ID
641 if {$id == ""} { set id "SDL-RESERVED[incr nextId]" }
643 # add a new (empty) string to the formStack list (i.e., push)
647 if {$id != ""} { Emit " [Id $id]" }
648 Emit " CLASS=\"CELL\""
649 if {$ssi != ""} { Emit " SSI=\"$ssi\"" }
656 # start a new FORM element ("push" because they're recursive);
657 # return the ID in case we allocated one
658 proc PushForm {class ssi id} {
659 global needFData formStack nextId
661 Emit $needFData ;# in case we're the first in an old FORM
662 set needFData "<FDATA>\n" ;# and were now starting a new FORM
664 # close any open BLOCK
667 if {[llength $formStack] != 0} {
668 # there is a <form> in progress
669 if {$id == ""} { set id "SDL-RESERVED[incr nextId]" }
673 # add a new (empty) string to the formStack list (i.e., push)
677 if {$id != ""} { Emit " [Id $id]" }
678 if {$class != ""} { Emit " CLASS=\"$class\"" }
679 if {$ssi != ""} { Emit " SSI=\"$ssi\"" }
686 # start a new FORM element to hold a labeled list item ("push"
687 # because they're recursive), adding it to an already open two
688 # column FORM, if any; we assume the first ID is the block holding
689 # the label and always defined on entry but we return the second
690 # ID in case we allocated one
691 proc PushFormItem {ssi id1 id2} {
692 global needFData formStack nextId
694 Emit $needFData ;# in case we're the first in an old FORM
695 set needFData "<FDATA>\n" ;# and were now starting a new FORM
697 # close any open BLOCK
700 if {$id2 == ""} { set id2 "SDL-RESERVED[incr nextId]" }
702 if {[llength $formStack] != 0} {
703 # there is a <form> in progress
704 if {$id2 == ""} { set id2 "SDL-RESERVED[incr nextId]" }
705 AddRowVec "$id1 $id2"
708 # add a new (empty) string to the formStack list (i.e., push)
711 Emit "<FORM [Id $id2] CLASS=\"ITEM\""
712 if {$ssi != ""} { Emit " SSI=\"$ssi\"" }
719 # close out a THead, TBody or TFoot; create the FROWVEC from the
720 # rowDope - save it if we aren't popping the FORM yet (which happens
721 # if no ColSpec elements were given at the THead or TFoot level and
722 # we're merging one, the other or both with the TBody), emit the
723 # saved ROWVEC, if any, and newly created one if we are popping the
724 # FORM in which case we also want to blow away the top of the
725 # formStack; we can also blow away the current rowDope here since
726 # we write or save the FROWVEC and we're done with the dope vector
727 proc PopTableForm {parent gi popForm} {
730 # get the proper row descriptor(s) and number of columns
731 if {$parent == "ENTRYTBL"} {
732 upvar #0 entryTableRowDope rowDope
733 upvar #0 entryTableSavedFRowVec fRowVec
734 global entryTableAttributes
735 set nCols $entryTableAttributes(cols)
737 upvar #0 tableGroupRowDope rowDope
738 upvar #0 tableGroupSavedFRowVec fRowVec
739 global tableGroupAttributes
740 set nCols $tableGroupAttributes(cols)
743 # flush the unused formStack entry if we're actually popping
748 # determine whether we are a "header", i.e., inside a TFoot or
750 if {$gi == "TBODY"} {
753 set hdr " HDR=\"YES\""
756 # if actually popping the FORM here (i.e., writing the FSTYLE),
757 # emit the FSTYLE wrapper
759 Emit "</FDATA>\n<FSTYLE"
761 Emit " NCOLS=\"$nCols\""
766 set nRows $rowDope(nRows)
767 while {$currentRow <= $nRows} {
768 append fRowVec "<FROWVEC$hdr CELLS=\""
769 append fRowVec $rowDope(row$currentRow)
770 append fRowVec "\">\n"
774 # if actually popping the FORM here (i.e., writing the FSTYLE),
775 # emit the FROWVEC elements, zero out the saved fRowVec and close
780 Emit "</FSTYLE>\n</FORM>\n"
785 # close out one FORM on the stack; if there hasn't been a block added
786 # to the FORM, create an empty one to make it legal SDL
790 if {[Peek formStack] == ""} {
791 # oops, empty FROWVEC means empty FORM so add an empty BLOCK
792 StartBlock "" "" "" 1
795 # close any open BLOCK
798 # write out the saved FROWVEC information wrapped in an FSTYLE
799 set openStyle "</FDATA>\n<FSTYLE>\n"
800 set closeStyle "</FSTYLE>\n</FORM>"
801 Emit "$openStyle[Pop formStack]$closeStyle\n"
805 # close out one N columned FORM on the stack; if there hasn't been a
806 # block added to the FORM, create an empty one to make it legal SDL
807 proc PopFormN {nCols} {
810 if {[Peek formStack] == ""} {
811 # oops, empty FROWVEC means empty FORM so add an empty BLOCK
812 # and bring this down to a single column FORM containing only
814 StartBlock "" "" "" 1
818 # close any open BLOCK
821 # write out the saved FROWVEC information wrapped in an FSTYLE
822 set openStyle "</FDATA>\n<FSTYLE NCOLS=\"$nCols\">\n"
823 set closeStyle "</FSTYLE>\n</FORM>"
824 Emit "$openStyle[Pop formStack]$closeStyle\n"
828 # check the Role attribute on lists to verify that it's either "LOOSE"
829 # or "TIGHT"; return upper cased version of verified Role
830 proc CheckSpacing {spacing} {
831 set uSpacing [string toupper $spacing]
834 TIGHT {return $uSpacing}
836 UserError "Bad value (\"$role\") for Role attribute in a list" yes
841 # start a simple list - if Type is not INLINE, we need to save the
842 # Ids of the BLOCKs we create and lay them out in a HORIZONTAL or
843 # VERTICAL grid when we have them all
844 proc StartSimpleList {id type spacing parent} {
845 global listStack firstString
847 if {$type == "INLINE"} {
848 StartParagraphMaybe $id P ""
850 # if we are inside a Para, we need to issue a FORM to hang the
851 # indent attributes on
852 if {$parent == "PARA"} {
853 PushForm "" "INSIDE-PARA" ""
856 # insure "spacing" is upper case and valid (we use it in the SSI)
857 set spacing [CheckSpacing $spacing]
859 # save the list type and spacing for use by <Member>;
860 set listDope(type) simple
861 set listDope(spacing) $spacing
862 Push listStack [array get listDope]
864 PushForm LIST SIMPLE-$spacing $id
865 set firstString "FIRST-"
870 # end a simple list - if Type was INLINE, we're done, otherwise, we
871 # need to lay out the grid based on Type and Columns
872 proc EndSimpleList {columns type parent} {
873 global listStack lastList listMembers
876 UserWarning "must have at least one column in a simple list" yes
880 if {$type != "INLINE"} {
881 # get the most recently opened list and remove it from the stack
882 array set lastList [Pop listStack]
884 # calculate the number of rows and lay out the BLOCK ids
885 # as per the type attribute
886 set length [llength $listMembers]
887 set rows [expr ($length + $columns - 1) / $columns]
891 if {$type == "HORIZ"} {
894 set ids [lrange $listMembers $c [incr c $cols]]
900 set lastRowLength [expr $cols - (($rows * $cols) - $length)]
902 while {$r <= $rows} {
907 set cols $lastRowLength
910 lappend ids [lindex $listMembers $i]
912 if {$c < $lastRowLength} {
923 # close the open FORM using the newly generated ROWVECs
926 # if we are inside a Para, we need to close the FORM we issued for
927 # hanging the indent attributes
928 if {$parent == "PARA"} {
935 # collect another Member of a SimpleList; if we're a Vert(ical) or
936 # Horiz(ontal) list, don't put the BLOCK's id on the list's FORM
937 # yet - we need to collect them all and lay them out afterward in
938 # EndSimpleList; if we're an Inline list, don't create a BLOCK, we'll
939 # add punctuation to seperate them in EndMember
940 proc StartMember {id type} {
941 global nextId listStack firstString listMembers
943 if {$type == "INLINE"} {
946 # put it in a BLOCK, make sure we have an id and add it to
947 # the list of members
949 set id SDL-RESERVED[incr nextId]
951 lappend listMembers $id
953 # get the current list info
954 array set listTop [Peek listStack]
955 set spacing $listTop(spacing)
957 # use an SSI of, e.g., FIRST-LOOSE-SIMPLE
958 StartBlock ITEM $firstString$spacing-SIMPLE $id 0
959 StartParagraph "" P ""
965 # end a SimpleList Member; if it's an Inline list, emit the
966 # punctuation ("", ", " or "and") based on the position of the
967 # Member in the list - otherwise, do nothing and the StartBlock from
968 # the next Member or the PopFormN in EndSimpleList will close the
970 proc EndMember {type punct} {
971 if {$type == "INLINE"} {
977 # check the value of a ITEMIZEDLIST MARK - issue warning and default
978 # it to BULLET if it's unrecognized
979 proc ValidMark {mark} {
980 global validMarkArray
982 if {[string toupper $mark] == "PLAIN"} { return PLAIN }
984 # if an SDATA entity was used, it'll have spurious "\|" at the
985 # beginning and the end added by [n]sgmls
986 if {[string match {\\|????????\\|} $mark]} {
987 set mark [string range $mark 2 9]
990 if {![string match {\[??????\]} $mark]} {
991 UserError "Unknown list mark \"$mark\" specified, using PLAIN" yes
994 foreach m [array names validMarkArray] {
995 if {$validMarkArray($m) == $mark} {return $m}
997 return [AddToMarkArray $mark]
1002 # start an itemized list
1003 proc ItemizedList {id mark spacing parent} {
1004 global listStack firstString
1006 # if we are inside a Para, we need to issue a FORM to hang the
1007 # indent attributes on
1008 if {$parent == "PARA"} {
1009 PushForm "" "INSIDE-PARA" ""
1012 # make sure we recognize the mark
1013 set mark [ValidMark $mark]
1015 # insure "spacing" is upper case and valid (we use it in the SSI)
1016 set spacing [CheckSpacing $spacing]
1018 # save the list type, mark and spacing for use by <ListItem>
1019 set listDope(type) itemized
1020 set listDope(spacing) $spacing
1021 set listDope(mark) $mark
1022 Push listStack [array get listDope]
1024 # create a FORM to hold the list items
1025 if {$mark == "PLAIN"} {
1026 PushForm LIST "PLAIN-$spacing" $id
1028 PushForm LIST "MARKED-$spacing" $id
1031 set firstString "FIRST-"
1035 # turn absolute item count into proper list number e.g., 2, B, or II
1036 proc MakeOrder {numeration count} {
1037 global ROMAN0 ROMAN10 ROMAN100
1038 global roman0 roman10 roman100
1039 global ALPHABET alphabet
1040 global NZDIGITS DIGITS
1042 if {$count == ""} { return "" }
1044 if {$count > 999} { set count 999 } ;# list too big - cap it
1046 # initialize the 3 digits of the result value
1051 # first get the 3 digits in the proper base (26 or 10)
1052 switch -exact $numeration {
1055 set c3 [expr "$count % 26"]
1056 if {$c3 == 0} { set c3 26 }
1057 if {[set count [expr "$count / 26"]]} {
1058 set c2 [expr "$count % 26"]
1059 if {$c2 == 0} { set c2 26 }
1060 set c1 [expr "$count / 26"]
1066 set c3 [expr "$count % 10"]
1067 if {[set count [expr "$count / 10"]]} {
1068 set c2 [expr "$count % 10"]
1069 if {[set count [expr "$count / 10"]]} {
1070 set c1 [expr "$count % 10"]
1076 # then point to proper conversion list(s)
1077 switch -exact $numeration {
1079 set c1List $ALPHABET
1080 set c2List $ALPHABET
1081 set c3List $ALPHABET
1084 set c1List $alphabet
1085 set c2List $alphabet
1086 set c3List $alphabet
1091 set c1List $ROMAN100
1096 set c1List $roman100
1103 set c1List $NZDIGITS
1105 set c2List $NZDIGITS
1111 # and do the conversion
1112 set string [lindex $c1List $c1]
1113 append string [lindex $c2List $c2]
1114 append string [lindex $c3List $c3]
1121 # start an ordered list
1122 proc OrderedList {id numeration inheritNum continue spacing parent} {
1123 global listStack lastList firstString
1125 # if we are inside a Para, we need to issue a FORM to hang the
1126 # indent attributes on
1127 if {$parent == "PARA"} {
1128 PushForm "" "INSIDE-PARA" ""
1131 # make sure the INHERIT param is compatible with enclosing list
1132 if {$inheritNum == "INHERIT"} {
1133 if {[llength $listStack] > 0} {
1134 array set outerList [Peek listStack]
1135 if {$outerList(type) != "ordered"} {
1136 UserError "Can only inherit numbering from an ordered list" yes
1137 set inheritNum IGNORE
1141 "Attempt to inherit a list number with no previous list" yes
1142 set inheritNum IGNORE
1146 # make sure the CONTINUE param is compatible with previous list;
1147 # also inherit numeration here if unset (else error if different)
1148 # and we're continuing
1149 if {$continue == "CONTINUES"} {
1150 if {![array exists lastList]} {
1151 # nothing to inherit from
1152 UserError "Attempt to continue a list with no previous list" yes
1153 set continue RESTARTS
1154 } elseif {$lastList(type) != "ordered"} {
1155 UserError "Only ordered lists can be continued" yes
1156 set continue RESTARTS
1157 } elseif {$numeration == ""} {
1158 set numeration $lastList(numeration)
1159 } elseif {$lastList(numeration) != $numeration} {
1160 UserError "Can't continue a list with different numeration" yes
1161 set continue RESTARTS
1165 # if no numeration specified, default to Arabic
1166 if {$numeration == ""} {
1167 set numeration ARABIC
1170 set count 0 ;# assume we are restarting the item count
1171 set inheritString "" ;# fill in later if set
1173 if {$continue == "CONTINUES"} {
1174 # continuing means use the old inherit string (if any) and
1175 # pick up with the old count
1176 set count $lastList(count)
1177 if {($lastList(inheritString) != "") && ($inheritNum != "INHERIT")} {
1179 "Must continue inheriting if continuing list numbering" yes
1180 set inheritNum INHERIT
1184 if {$inheritNum == "INHERIT"} {
1185 # inheriting a string to preface the current number - e.g., "A.1."
1186 set inheritString $outerList(inheritString)
1187 append inheritString \
1188 [MakeOrder $outerList(numeration) $outerList(count)]
1191 # insure "spacing" is upper case and valid (we use it in the SSI)
1192 set spacing [CheckSpacing $spacing]
1194 # save the list type and spacing for use by <ListItem>
1195 set listDope(type) ordered
1196 set listDope(spacing) $spacing
1197 set listDope(numeration) $numeration
1198 set listDope(inheritString) $inheritString
1199 set listDope(count) $count
1200 Push listStack [array get listDope]
1202 # create a FORM to hold the list items
1203 PushForm LIST "ORDER-$spacing" $id
1205 set firstString "FIRST-"
1209 # start a variable list (i.e., labeled list)
1210 proc VariableList {id role parent} {
1211 global listStack firstString
1213 # if we are inside a Para, we need to issue a FORM to hang the
1214 # indent attributes on
1215 if {$parent == "PARA"} {
1216 PushForm "" "INSIDE-PARA" ""
1219 # parse out the possible role values (loose/tight and
1221 set role [split [string toupper $role]]
1222 set role1 [lindex $role 0]
1224 set length [llength $role]
1226 set role2 [lindex $role 1]
1229 UserError "Too many values (> 2) for Role in a VARIABLELIST" yes
1235 TIGHT {set spacing $role1}
1237 NOWRAP {set wrap $role1}
1238 default {UserError "Bad value for Role ($role1) in a VARIABLELIST" yes
1244 TIGHT {if {$spacing == ""} {
1247 UserError "Only specify LOOSE/TIGHT once per Role" yes
1251 NOWRAP {if {$wrap == ""} {
1254 UserError "Only specify WRAP/NOWRAP once per Role" yes
1257 default {UserError "Bad value for Role ($role2) in a VARIABLELIST" yes
1260 if {$spacing == ""} {
1267 # insure "spacing" is upper case and valid (we use it in the SSI)
1268 set spacing [CheckSpacing $spacing]
1270 # save the list type and spacing for use by <ListItem>;
1271 # also save a spot for the current label ID
1272 set listDope(type) variable
1273 set listDope(spacing) $spacing
1274 set listDope(labelId) $id
1275 set listDope(wrap) $wrap
1276 Push listStack [array get listDope]
1278 # create a FORM to hold the list items
1279 PushForm LIST "VARIABLE-$spacing" $id
1281 set firstString "FIRST-"
1285 # open a variable list entry - create a BLOCK to hold the term(s)
1286 proc VarListEntry {id} {
1287 global firstString listStack nextId
1289 # get the list spacing, i.e., TIGHT or LOOSE
1290 array set listDope [Peek listStack]
1291 set spacing $listDope(spacing)
1293 # make sure we have an ID for the label (it goes in a FORM)
1294 # save the ID for use in PushFormItem
1296 set id SDL-RESERVED[incr nextId]
1298 array set listDope [Pop listStack]
1299 set listDope(labelId) $id
1300 Push listStack [array get listDope]
1302 StartBlock ITEM "$firstString$spacing-TERMS" $id 0
1305 # process a term in a variablelist
1306 proc StartTerm {id} {
1309 # get the current list info
1310 array set listTop [Peek listStack]
1311 set wrap $listTop(wrap)
1314 if {$wrap == "NOWRAP"} {
1318 StartParagraph $id "P" $lined
1322 # process an item in an ordered, variable or itemized list
1323 proc ListItem {id override} {
1324 global listStack firstString nextId needFData validMarkArray
1326 # get the current list info
1327 array set listTop [Peek listStack]
1328 set spacing $listTop(spacing)
1330 # if it's an itemized list, are we overriding the mark?
1331 if {$listTop(type) == "itemized"} {
1332 if {$override == "NO"} {
1333 set mark $listTop(mark)
1334 } elseif {$override == ""} {
1337 set mark [ValidMark $override]
1341 if {($listTop(type) == "itemized") && ($mark != "PLAIN")} {
1342 # marked itemized list, try to reuse an existing mark <BLOCK>
1343 if {$firstString == ""} {
1344 # not a FIRST, calculate the next id index - we flip
1345 # between 0 and 1 to avoid column span in viewer
1346 set numName $spacing${mark}num ;# get index name
1347 upvar #0 $numName idNum
1348 set idNum [expr "-$idNum + 1"] ;# flip it
1350 if {$firstString != ""} {
1351 set idName FIRST$spacing${mark}Id
1353 set idName $spacing${mark}Id$idNum
1355 upvar #0 $idName labelId
1356 if {$labelId == ""} {
1357 # need to create a <BLOCK> and save the id
1358 set labelId "SDL-RESERVED[incr nextId]"
1359 Emit $needFData; set needFData ""
1360 Emit "<BLOCK [Id $labelId] CLASS=\"ITEM\""
1361 Emit " TIMING=\"ASYNC\" "
1362 Emit "SSI=\"$firstString$spacing-MARKED\""
1363 Emit ">\n<P SSI=\"P1\"><SPC NAME=\"$validMarkArray($mark)\""
1364 Emit "></P>\n</BLOCK>\n"
1368 # emit the SSI and label for an ordered list
1369 if {$listTop(type) == "ordered"} {
1370 # start a block for the label
1371 set labelId "SDL-RESERVED[incr nextId]"
1372 Emit $needFData; set needFData ""
1373 Emit "<BLOCK [Id $labelId] CLASS=\"ITEM\" SSI=\""
1375 # create, e.g., FIRST-LOOSE-ORDERED
1376 Emit "$firstString$spacing-ORDERED\">\n"
1378 # emit the label (inherit string followed by order string)
1379 # and close the block
1380 Emit "<P SSI=\"P1\">"
1381 Emit $listTop(inheritString)
1382 Emit [MakeOrder $listTop(numeration) [incr listTop(count)]]
1383 Emit "</P>\n</BLOCK>\n"
1385 # then update the top of the list stack
1386 Poke listStack [array get listTop]
1389 # or just get the label id for a variable (labeled) list - the
1390 # label was emitted in another production
1391 if {$listTop(type) == "variable"} {
1392 set labelId $listTop(labelId)
1395 # emit a one (for PLAIN) or two column FORM to wrap this list item
1396 set ssi "$firstString$spacing"
1397 if {($listTop(type) == "itemized") && ($mark == "PLAIN")} {
1398 PushForm ITEM $ssi $id
1400 PushFormItem $ssi $labelId $id
1406 # start a segmented list, e.g.,
1412 proc SegmentedList {id spacing parent} {
1413 global listStack firstString
1415 # if we are inside a Para, we need to issue a FORM to hang the
1416 # indent attributes on
1417 if {$parent == "PARA"} {
1418 PushForm "" "INSIDE-PARA" ""
1421 # insure "spacing" is upper case and valid (we use it in the SSI)
1422 set spacing [CheckSpacing $spacing]
1424 # save the list type and spacing for use by <ListItem>;
1425 set listDope(type) segmented
1426 set listDope(spacing) $spacing
1427 Push listStack [array get listDope]
1429 # create a FORM to hold the list items
1430 PushForm LIST "SEGMENTED-$spacing" $id
1432 set firstString "FIRST-"
1435 # emit the SegTitle elements, each in its own BLOCK - we'll reuse
1436 # them on each Seg of each SegListItem
1437 proc StartSegTitle {id} {
1438 global firstString listStack segTitleList nextId
1440 # get the list spacing, i.e., TIGHT or LOOSE
1441 array set listDope [Peek listStack]
1442 set spacing $listDope(spacing)
1444 # make sure we have an ID for the label (it goes in a FORM)
1445 # save the ID for use in PushFormItem
1447 set id SDL-RESERVED[incr nextId]
1449 lappend segTitleList $id
1451 # start the block but don't put in on the FORM, we'll put this
1452 # BLOCK and the one containing the SegListItem.Seg into a two
1454 StartBlock ITEM "$firstString$spacing-SEGTITLE" $id 0
1457 StartParagraph "" SEGTITLE ""
1461 # start a SegListItem - save the id (if any) of the SegListItem to
1462 # be emitted as an anchor in the first Seg
1463 proc StartSegListItem {id} {
1464 global segListItemNumber segListItemId firstString
1466 set segListItemId $id
1467 set segListItemNumber 0
1468 set firstString "FIRST-"
1472 # process a Seg in a SegListItem - get the corresponding SegTitle ID
1473 # and create a BLOCK for the item then put the pair into the FORM that
1474 # was created back in SegmentedList
1475 proc StartSeg {id isLastSeg} {
1476 global segTitleList segListItemNumber segListItemId firstString
1477 global listStack nextId
1479 set nTitles [llength $segTitleList]
1480 if {$segListItemNumber >= $nTitles} {
1482 "More Seg than SegTitle elements in a SegmentedList" yes
1486 if {[expr "$segListItemNumber" + 1] != $nTitles} {
1488 "More SegTitle than Seg elements in a SegmentedList" yes
1492 # get the current list info
1493 array set listTop [Peek listStack]
1494 set spacing $listTop(spacing)
1496 # open a BLOCK and P to hold the Seg content; put any user
1497 # supplied Id on the BLOCK and the saved segListItem Id (if
1501 set itemId "SDL-RESERVED[incr nextId]"
1503 StartBlock ITEM $firstString$spacing $itemId 0
1505 StartParagraph $segListItemId P ""
1506 set segListItemId ""
1508 # we've already guaranteed that we don't overflow the list
1509 set titleId [lindex $segTitleList $segListItemNumber]
1510 incr segListItemNumber
1512 # add the title and item to a row vector (FROWVEC)
1513 AddRowVec "$titleId $itemId"
1518 proc EndList {parent} {
1519 global listStack lastList
1521 # get the most recently opened list and remove it from the stack
1522 array set lastList [Pop listStack]
1524 if {($lastList(type) == "itemized") && ($lastList(mark) == "PLAIN") } {
1530 # if we are inside a Para, we need to close the FORM we issued for
1531 # hanging the indent attributes
1532 if {$parent == "PARA"} {
1538 # start a super- or sub-scripted phrase; if there's an ID, emit the
1539 # anchor before the SPHRASE
1540 proc StartSPhrase {id gi} {
1543 SUPERSCRIPT {set type SUPER}
1544 SUBSCRIPT {set type SUB}
1547 Emit "<KEY CLASS=\"EMPH\" SSI=\"SUPER-SUB\"><SPHRASE CLASS=\"$type\">"
1550 # end a super- or sub-scripted phrase
1551 proc EndSPhrase {} {
1552 Emit "</SPHRASE></KEY>"
1556 # start an admonition (note/caution/warning/tip/important),
1557 # emit a FORM to hold it and the HEAD for the icon (if any);
1558 # if the admonition has no Title, emit one using the GI of the
1559 # admonition; map Tip to Note and Important to Caution
1560 proc StartAdmonition {id gi haveTitle} {
1561 PushForm "" ADMONITION $id
1566 TIP {set icon "graphics/noteicon.pm"}
1568 IMPORTANT {set icon "graphics/cauticon.pm"}
1569 WARNING {set icon "graphics/warnicon.pm"}
1571 set snbId [AddToSNB GRAPHIC $icon]
1573 # emit the icon wrapped in a head for placement
1574 Emit "<HEAD SSI=\"ADMONITION-ICON\"><SNREF>"
1575 Emit "<REFITEM RID=\"$snbId\" CLASS=\"ICON\"></REFITEM>\n"
1576 Emit "</SNREF></HEAD>"
1578 # emit a title if none provided
1580 Emit "<HEAD SSI=\"ADMONITION-TITLE\">$gi</HEAD>\n"
1585 # start a Procedure - emit a <FORM> to hold it
1586 proc StartProcedure {id} {
1587 PushForm "" PROCEDURE $id
1591 # start a Step inside a Procedure, emit another FORM to hold it
1592 proc StartStep {id} {
1593 PushForm "" STEP $id
1597 # start a SubStep inside a Stop, emit yet another FORM to hold it
1598 proc StartSubStep {id} {
1599 PushForm "" SUBSTEP $id
1603 # start a Part; make the PARTGlossArray be the current glossary array
1604 proc StartPart {id} {
1605 global partID glossStack
1609 # make sure the glossary array exists but is empty
1610 Push glossStack PARTGlossArray
1611 upvar #0 [Peek glossStack] currentGlossArray
1612 set currentGlossArray(foo) ""
1613 unset currentGlossArray(foo)
1617 # end a Part; check for definitions for all glossed terms
1621 # get a convenient handle on the glossary array
1622 upvar #0 [Peek glossStack] currentGlossArray
1624 # check that all the glossed terms have been defined
1625 foreach name [array names currentGlossArray] {
1626 if {[lindex $currentGlossArray($name) 1] != "defined"} {
1627 set glossString [lindex $currentGlossArray($name) 2]
1628 UserError "No glossary definition for \"$glossString\"" no
1632 # delete this glossary array
1633 unset currentGlossArray
1637 # create and populate a dummy home page title - if no Title was
1638 # specified we want it to be "Home Topic"
1639 proc SynthesizeHomeTopicTitle {} {
1641 global localizedAutoGeneratedStringArray
1643 Title $partID PARTINTRO
1644 set message "Home Topic"
1645 Emit $localizedAutoGeneratedStringArray($message)
1646 CloseTitle PARTINTRO
1650 # create and populate a dummy home page because there was no
1651 # PartIntro in this document
1652 proc SynthesizeHomeTopic {} {
1654 global localizedAutoGeneratedStringArray
1657 StartNewVirpage PARTINTRO ""
1658 SynthesizeHomeTopicTitle
1659 StartParagraph $partID P ""
1660 set message "No home topic (PartIntro) was specified by the author."
1661 Emit $localizedAutoGeneratedStringArray($message)
1666 # start a virpage for, e.g., a SECTn - close the previous first;
1667 # compute the level rather than specifying it in the transpec to allow
1668 # one specification to do for all SECTn elements; if level=2 and we
1669 # haven't emitted a PartIntro (aka HomeTopic), emit one
1670 proc StartNewVirpage {ssi id} {
1671 global nextId virpageLevels inVirpage firstPInBlock
1672 global indexLocation snbLocation savedSNB currentSNB
1673 global lastList language charset docId havePartIntro partIntroId
1675 global manTitle manVolNum manDescriptor manNames manPurpose
1677 # get the LEVEL= value for this VIRPAGE (makes for a shorter
1678 # transpec to not have to specify level there)
1679 if {[info exists virpageLevels($ssi)]} {
1680 set level $virpageLevels($ssi)
1685 # if we are opening the PartIntro, use the generated ID (which
1686 # may be the assigned ID, if present) and flag that we've seen
1688 if {$ssi == "PARTINTRO"} {
1694 # if we haven't seen a PartIntro but we're trying to create a
1695 # level 2 VIRPAGE, emit a dummy PartInto
1696 if {($level == 2) && !$havePartIntro} {
1700 if {[string match {SECT[1-5]} $ssi]} {
1701 # make Chapter and all Sect? have an SSI of "CHAPTER", use LEVEL
1702 # to distinguish between them
1705 # make Reference, RefEntry and all RefSect? have an SSI of
1706 # "REFERENCE", use LEVEL to distinguish between them
1707 if {$ssi == "REFENTRY"} {
1710 if {[string match {REFSECT[1-3]} $ssi]} { set ssi REFERENCE }
1713 if {($ssi == "REFERENCE") || ($ssi == "REFENTRY")} {
1714 # assume no section, we'll get one in RefMeta.ManVolNum, if any
1717 set manDescriptor ""
1722 # close an open BLOCK, if any
1725 # close any open VIRPAGE
1726 Emit $inVirpage; set inVirpage "</VIRPAGE>\n"
1728 # if the first paragraph on the page is a compound para, we want
1729 # to emit a FORM with an SSI="P1" so set the first P flag
1732 # stash away the SNB for this VIRPAGE (or SDLDOC) - make an
1733 # associative array of the file location and the SNB data so
1734 # we can update the file location by adding the INDEX size before
1735 # writing the .snb file
1736 set names [array names currentSNB]
1737 if {[llength $names] != 0} {
1738 foreach name $names {
1739 # split the name into the GI and xid of the SNB entry
1740 set colonLoc [string first "::" $name]
1741 set type [string range $name 0 [incr colonLoc -1]]
1742 set data [string range $name [incr colonLoc 3] end]
1745 append tempSNB "<$type ID=\"$currentSNB($name)\" "
1753 TEXTFILE { set command "XID" }
1754 SYS-CMD { set command "COMMAND" }
1755 CALLBACK { set command "DATA" }
1757 append tempSNB "$command=\"$data\">\n"
1759 set savedSNB($snbLocation) $tempSNB
1763 if {[array exists lastList]} {
1764 unset lastList ;# don't allow lists to continue across virpage
1767 # delete the list of empty cells used for indefined Entries in
1768 # tables - we can only re-use them on the same virpage
1769 if {[array exists emptyCells]} {
1773 # we have to create new BLOCKs to hold the marks on the new page
1776 if {$id == ""} { set id "SDL-RESERVED[incr nextId]" }
1777 Emit "<VIRPAGE [Id $id] LEVEL=\"$level\" "
1778 Emit "LANGUAGE=\"$language\" "
1779 Emit "CHARSET=\"$charset\" "
1780 Emit "DOC-ID=\"$docId\" "
1781 Emit "SSI=\"$ssi\">\n"
1783 set snbLocation [tell stdout] ;# assume no HEAD for now
1787 # save the virpageLevels setting for this ssi (if any) and unset it
1788 # then call StartNewVirpage; on return, restore the virpagelevels
1789 # setting and continue - this will force the virpage to be a level 0
1790 # virpage and not show up in the TOC
1791 proc StartNewLevel0Virpage {ssi id} {
1792 global virpageLevels
1794 if {[info exists virpageLevels($ssi)]} {
1795 set savedLevel $virpageLevels($ssi)
1796 unset virpageLevels($ssi)
1799 StartNewVirpage $ssi $id
1801 if {[info exists savedLevel]} {
1802 set virpageLevels($ssi) $savedLevel
1807 # call StartNewVirpage, then if the user supplied ID is not same as
1808 # the default ID for that topic, emit an empty paragragh to contain
1809 # the user supplied ID; also, convert the ID of
1810 # SDL-RESERVED-LEGALNOTICE to SDL-RESERVED-COPYRIGHT for backwards
1811 # compatibility, preserve the original default ID so we're consistent
1812 # on this release too
1813 proc StartNewVirpageWithID {ssi id defaultID haveTitle} {
1816 # do we need to replace LEGALNOTICE with COPYRIGHT?
1818 if {[string toupper $defaultID] == "SDL-RESERVED-LEGALNOTICE"} {
1819 set defaultID SDL-RESERVED-COPYRIGHT
1823 StartNewVirpage $ssi $defaultID
1825 # if no user supplied ID but we changed the default, emit the
1826 # original default on the empty paragraph
1827 if {($id == "") && $legalNotice} {
1828 set id SDL-RESERVED-LEGALNOTICE
1832 # id is either user supplied or the original default (if changed);
1833 # if the VIRPAGE has a HEAD (Title), save this id (these ids) and
1834 # emit it (them) there, otherwise, emit an empty paragraph with
1837 if {[string toupper $id] != [string toupper $defaultID]} {
1841 # had both a user supplied ID and we changed the default
1842 lappend savedId SDL-RESERVED-LEGALNOTICE
1845 StartParagraph $id "" ""
1847 # had both a user supplied ID and we changed the default
1848 Anchor SDL-RESERVED-LEGALNOTICE
1857 # start a VIRPAGE for an appendix; if there's no ROLE=NOTOC, use the
1858 # virpage level from the level array, otherwise, use level 0
1859 proc StartAppendix {ssi id role} {
1860 global virpageLevels
1862 set uRole [string toupper $role]
1864 if {$uRole == "NOTOC"} {
1865 set saveAppendixLevel $virpageLevels(APPENDIX)
1866 set virpageLevels(APPENDIX) 0
1867 } elseif {$role != ""} {
1868 UserError "Bad value (\"$role\") for Role attribute in Appendix" yes
1871 StartNewVirpage $ssi $id
1873 if {$uRole == "NOTOC"} {
1874 set virpageLevels(APPENDIX) $saveAppendixLevel
1879 # start a new VIRPAGE for a topic that may contain a glossary; if
1880 # there is a glossary, start a new one and make it the current glossary,
1881 # otherwise, make the parent's glossary the current one.
1882 proc StartGlossedTopic {gi id haveGlossary} {
1885 if {$haveGlossary} {
1886 # save the glossary array name so we can get back here
1887 # when this topic is done
1888 Push glossStack ${gi}GlossArray
1890 # start a new (empty) glossary array for this glossary
1891 upvar #0 ${gi}GlossArray currentGlossArray
1892 set currentGlossArray(foo) ""
1893 unset currentGlossArray(foo)
1896 StartNewVirpage $gi $id
1900 # end a topic that may contain a glossary; if it did, check that all
1901 # glossed terms have been defined and remove the array - restore the
1902 # previous glossary array
1903 proc EndGlossedTopic {haveGlossary} {
1906 # get a convenient handle on the glossary array
1907 upvar #0 [Peek glossStack] currentGlossArray
1909 if {$haveGlossary} {
1910 # check that all the glossed terms have been defined
1911 foreach name [array names currentGlossArray] {
1912 if {[lindex $currentGlossArray($name) 1] != "defined"} {
1913 set glossString [lindex $currentGlossArray($name) 2]
1914 UserError "No glossary definition for \"$glossString\"" no
1918 # delete this glossary array and restore the previous one
1919 unset currentGlossArray
1925 # alternate OutputString routine for when in a glossed term - merely
1926 # buffer the output rather than sending to the output stream; we'll
1927 # emit the SDL when the whole term has been seen
1928 proc GlossOutputString {string} {
1931 append glossBuffer $string
1935 # prepare to link a glossed term to its definition in the glossary -
1936 # at this point, we simply divert the output into a buffer
1937 proc StartAGlossedTerm {} {
1941 rename OutputString SaveGlossOutputString
1942 rename GlossOutputString OutputString
1946 # strip any SDL markup from the string, upper case it and return
1947 # the result; takes advantage of the fact that we never split
1948 # start or end tags across lines (operates a line at a time)
1949 proc StripMarkup {markup} {
1950 set exp {(^|([^&]*))</?[A-Z]+[^>]*>}
1952 set mList [split $markup "\n"]; # split into a list of lines
1953 set listLen [llength $mList]
1954 while {[incr listLen -1] >= 0} {
1955 set mString [lindex $mList 0]; # get the first line from the
1956 set mList [lreplace $mList 0 0]; # list and delete it
1957 if {[string length $mString] == 0} {
1958 # empty line of pcdata (no markup)
1959 append stripped "\n"
1962 # force to upper case and delete all start and end tags
1963 set mString [string toupper $mString]
1964 while {[regsub -all $exp $mString {\1} mString]} {#}
1965 if {[string length $mString] == 0} {
1966 # empty line after removing markup; skip it
1969 append stripped $mString "\n"; # concat this line to result
1975 # done collecting a glossed term - if we're not NOGLOSS, emit the SDL
1976 # wrapped in a LINK; save the term, baseform (if any) and the ID
1977 # used in the link - we'll define the ID in the glossary itself
1978 proc EndAGlossedTerm {id role} {
1979 global glossBuffer nextId glossStack
1981 # get a convenient handle on the glossary array
1982 upvar #0 [Peek glossStack] currentGlossArray
1984 # get the original output routine back
1985 rename OutputString GlossOutputString
1986 rename SaveGlossOutputString OutputString
1988 set qualifier [string toupper [string range $role 0 8]]
1989 if {$qualifier == "NOGLOSS"} {
1990 Emit "<KEY CLASS=\"TERM\" SSI=\"GLOSSARY\">"
1994 if {$qualifier == "BASEFORM="} {
1995 set glossString [string range $role 9 end]
1997 set glossString $glossBuffer
2000 # trim whitespace from the front and back of the string to be
2001 # glossed, also turn line feeds into spaces and compress out
2002 # duplicate whitespace
2003 set glossString [string trim $glossString]
2004 set glossString [split $glossString '\n']
2005 set tmpGlossString $glossString
2006 set glossString [lindex $tmpGlossString 0]
2007 foreach str [lrange $tmpGlossString 1 end] {
2009 append glossString " " [string trim $str]
2013 # upper case the glossary entry and strip it of markup to
2014 # use as an index so we get a case insensitive match - we'll
2015 # save the original string too for error messages; if there's
2016 # no glossary entry yet, issue an ID - the second entry in
2017 # the list will be set to "defined" when we see the definition
2018 set glossIndex [StripMarkup $glossString]
2019 if {[info exists currentGlossArray($glossIndex)]} {
2020 set refId [lindex $currentGlossArray($glossIndex) 0]
2022 set refId SDL-RESERVED[incr nextId]
2023 set currentGlossArray($glossIndex) [list $refId "" $glossString]
2026 # now we can emit the glossed term wrapped in a popup link
2027 Emit "<LINK WINDOW=\"POPUP\" RID=\"$refId\">"
2028 Emit "<KEY CLASS=\"TERM\" SSI=\"GLOSSARY\">"
2030 Emit "</KEY></LINK>"
2035 # done collecting a term in a glossary - emit the anchor, if not
2036 # already done; if we are to be followed by alternate names (i.e.,
2037 # Abbrev and/or Acronym), emit the opening paren, otherwise, close
2039 proc EndATermInAGlossary {id} {
2040 global glossBuffer nextId nGlossAlts glossStack
2041 global strippedGlossIndex
2043 # get a convenient handle on the glossary array
2044 upvar #0 [Peek glossStack] currentGlossArray
2046 # get the original output routine back
2047 rename OutputString GlossOutputString
2048 rename SaveGlossOutputString OutputString
2050 # emit the user supplied ID
2053 # trim whitespace from the front and back of the string to be
2054 # placed in the glossary, also turn line feeds into spaces and
2055 # compress out duplicate whitespace
2056 set glossString [split $glossBuffer '\n']
2057 set tmpGlossString $glossString
2058 set glossString [lindex $tmpGlossString 0]
2059 foreach str [lrange $tmpGlossString 1 end] {
2061 append glossString " " [string trim $str]
2065 # create an upper cased version of the glossed string with markup
2066 # removed to use as a case insensitive index to the array
2067 set strippedGlossIndex [StripMarkup $glossString]
2069 # get or create the generated ID; update the glossary array to
2070 # reflect that we now have a definition
2071 if {[info exists currentGlossArray($strippedGlossIndex)]} {
2072 set id [lindex $currentGlossArray($strippedGlossIndex) 0]
2073 set defined [lindex $currentGlossArray($strippedGlossIndex) 1]
2074 if {$defined == "defined"} {
2076 "multiple definitions for glossary term \"$glossBuffer\"" yes
2077 set id SDL-RESERVED[incr nextId]
2080 set id SDL-RESERVED[incr nextId]
2082 set currentGlossArray($strippedGlossIndex) \
2083 [list $id defined $glossString "" ""]
2085 # emit the generated ID
2087 Emit "<KEY CLASS=\"TERM\" SSI=\"GLOSSARY\">"
2089 if {$nGlossAlts != 0} {
2098 proc EndAcronymInGlossary {id} {
2101 if {[incr nGlossAlts -1] != 0} {
2110 proc EndAbbrevInGlossary {id} {
2118 # start an entry in a glossary or glosslist; divert the output - we
2119 # need to sort the terms before emitting them
2120 proc StartGlossEntry {id nAlternates nDefs} {
2121 global nGlossAlts nGlossDefs currentGlossDef
2122 global glossEntryBuffer
2124 # this helps when determining if a comma is needed after an alt
2125 # (either an Abbrev or an Acronym)
2126 set nGlossAlts $nAlternates
2128 # this lets us know when to close the FORM holding the GlossDef+
2129 set nGlossDefs $nDefs
2130 set currentGlossDef 0
2132 set glossEntryBuffer ""
2133 rename OutputString SaveGlossEntryOutputString
2134 rename GlossEntryOutputString OutputString
2136 PushForm "" GLOSSENTRY $id
2137 StartParagraph "" "" ""
2141 # alternate OutputString routine for when in a GlossEntry - merely
2142 # buffer the output rather than sending to the output stream; we'll
2143 # save this text for emission when the entire GlossDiv, Glossary or
2144 # GlossList has been processed and we've sorted the entries.
2145 proc GlossEntryOutputString {string} {
2146 global glossEntryBuffer
2148 append glossEntryBuffer $string
2152 # end an entry in a glossary or glosslist; save the entry in the
2153 # glossarray so we can later sort it for output
2154 proc EndGlossEntry {sortAs} {
2155 global glossEntryBuffer strippedGlossIndex glossStack
2159 # get the original output routine back
2160 rename OutputString GlossEntryOutputString
2161 rename SaveGlossEntryOutputString OutputString
2163 # get a convenient handle on the glossary array and element
2164 upvar #0 [Peek glossStack] currentGlossArray
2165 upvar 0 currentGlossArray($strippedGlossIndex) currentEntryList
2167 # save any user supplied sort key and the content of this glossary
2168 # entry for use when all entries are defined to sort them and emit
2169 # them in the sorted order
2170 set currentEntryList \
2171 [lreplace $currentEntryList 3 4 $sortAs $glossEntryBuffer]
2176 # the current batch of glossary entries (to a Glossary, GlossList or
2177 # GlossDiv has been saved in the glossArray - we need to sort them
2178 # based on the sortAs value if given (list index 3) or the index into
2179 # the glossArray of no sortAs was provided; when sorted, we can emit
2180 # entries (list index 4) in the new order and delete the emitted text
2181 # so that we don't try to emit it again (we want to save the
2182 # glossArray until, e.g., all GlossDiv elements are processed so we
2183 # can tell if all glossed terms have been defined); do a PopForm
2184 # when we're done if requested (for, e.g., GlossList)
2185 proc SortAndEmitGlossary {popForm} {
2188 # get a convenient handle on the glossary array
2189 upvar #0 [Peek glossStack] currentGlossArray
2191 # start with an empty sortArray
2192 set sortArray(foo) ""
2193 unset sortArray(foo)
2195 set names [array names currentGlossArray]
2196 foreach name $names {
2197 upvar 0 currentGlossArray($name) glossEntryList
2199 # skip this array entry if we've already emitted it; mark as
2200 # emitted after we've extracted the content for emission
2201 if {[set content [lindex $glossEntryList 4]] == ""} {
2202 continue; # already been processed
2204 set glossEntryList [lreplace $glossEntryList 4 4 ""]
2206 # sort by the GlossTerm content or sortAs, if provided
2207 if {[set sortAs [lindex $glossEntryList 3]] == ""} {
2211 # append the content in case we have equal sort values
2212 append sortArray($sortAs) $content
2215 set names [lsort -command CompareI18NStrings [array names sortArray]]
2216 foreach name $names {
2217 Emit $sortArray($name)
2220 if {[string toupper $popForm] == "POPFORM"} {
2226 # start a "See ..." in a glossary; if there was an otherterm, duplicate
2227 # its content and wrap it in a link to the GlossTerm holding the content
2228 proc StartGlossSee {id otherterm} {
2229 global localizedAutoGeneratedStringArray
2231 StartBlock "" GLOSSSEE $id 1
2232 StartParagraph "" "" ""
2234 Emit $localizedAutoGeneratedStringArray($message)
2236 if {$otherterm != ""} {
2237 Emit "<LINK RID=\"$otherterm\">"
2242 # check the target of an OtherTerm attribute in a GlossSee to verify
2243 # that it is indeed the ID of a GlossTerm inside a GlossEntry
2244 proc CheckOtherTerm {id gi parent} {
2247 set errorMess "Other term (\"$id\") referenced from a"
2249 if {$gi != "GLOSSTERM"} {
2250 UserError "$errorMess $glossType must be a GlossTerm" yes
2251 } elseif {$parent != "GLOSSENTRY"} {
2252 UserError "$errorMess GlossSee must be in a GlossEntry" yes
2257 # start a definition in a glossary; we wrap a FORM around the whole
2258 # group of GlossDef elements in the GlossEntry
2259 proc StartGlossDef {id} {
2260 global nGlossDefs currentGlossDef
2262 if {$currentGlossDef == 0} {
2263 PushForm "" GLOSSDEF $id
2265 StartBlock "" "" $id 1
2269 # end a definition in a glossary; if this is the last definition,
2270 # close the FORM that holds the group
2271 proc EndGlossDef {} {
2272 global nGlossDefs currentGlossDef
2274 if {[incr currentGlossDef] == $nGlossDefs} {
2276 unset nGlossDefs currentGlossDef
2281 # start a "See Also ..." in a glossary definition; if there was an
2282 # otherterm, duplicate its content and wrap it in a link to the
2283 # GlossTerm holding the content
2284 proc StartGlossSeeAlso {id otherterm} {
2285 global localizedAutoGeneratedStringArray
2287 StartBlock "" GLOSSSEE $id 1
2288 StartParagraph "" "" ""
2289 set message "See Also"
2290 Emit $localizedAutoGeneratedStringArray($message)
2292 if {$otherterm != ""} {
2293 Emit "<LINK RID=\"$otherterm\">"
2298 # end a "See ..." or a "See Also ..." in a glossary definition; if there
2299 # was an otherterm, end the link to it
2300 proc EndGlossSeeOrSeeAlso {otherterm} {
2301 if {$otherterm != ""} {
2307 # alternate OutputString routine for when in IndexTerm - merely
2308 # buffer the output rather than sending to the output stream (index
2309 # entries get emitted into the index, not where they are defined)
2310 proc IndexOutputString {string} {
2313 append indexBuffer $string
2317 # alternate Id routine for when in IndexTerm - merely
2318 # return the string rather than also setting the "most recently used"
2319 # variable. The markup inside the IndexTerm goes into the index
2320 # not the current virpage so we don't want to use the ids here
2321 proc IndexId {name} {
2322 return "ID=\"$name\""
2326 # start an index entry
2327 proc StartIndexTerm {id} {
2328 global indexBuffer inP inBlock
2333 } elseif {$inBlock != ""} {
2334 StartParagraph "" "P" ""
2341 # prepare to buffer the output while in IndexTerm
2343 rename OutputString DefaultOutputString
2344 rename IndexOutputString OutputString
2350 # add an index sub-entry
2351 proc AddIndexEntry {loc} {
2352 global indexBuffer indexVals indexArray
2354 # trim superfluous whitespace at the beginning and end of the
2356 set indexBuffer [string trim $indexBuffer]
2358 # get an array index and determine whether 1st, 2nd or 3rd level
2359 set index [join $indexVals ", "]
2360 set level [llength $indexVals]
2361 set value [lindex $indexVals [expr "$level - 1"]]
2363 # look for the string we want to put into the index; if the string
2364 # isn't there, add it - if it's there, verify that the content
2365 # being indexed is marked up the same as the last time we saw it
2366 # and that the primary/secondary/tertiary fields are split the
2367 # same way (bad check for now, we really need to save the
2368 # individual values) and add the location ID to the list of locs.
2369 set names [array names indexArray]
2371 set indexArray($index) [list $level $value $loc $indexBuffer]
2376 set thisIndex $indexArray($index)
2377 if {$indexBuffer != [lindex $thisIndex 3]} {
2378 UserError "Indexing same terms with different markup" yes
2380 if {$level != [lindex $thisIndex 0]} {
2381 UserError "Index botch: levels don't match" yes
2384 set locs [lindex $thisIndex 2]
2385 if {$locs != ""} { append locs " " }
2387 set thisIndex [lreplace $thisIndex 2 2 $locs]
2388 set indexArray($index) $thisIndex
2395 set indexArray($index) [list $level $value $loc $indexBuffer]
2402 # end an index entry
2403 proc EndIndexTerm {} {
2406 AddIndexEntry $mostRecentId
2408 # start emitting to output stream again
2409 rename OutputString IndexOutputString
2410 rename DefaultOutputString OutputString
2416 # start a primary index term
2417 proc StartPrimaryIndexEntry {id cdata} {
2420 set indexVals [list [string trim $cdata]]
2424 # end a primary index term
2425 proc EndPrimaryIndexEntry {} {
2429 # start a secondary index term
2430 proc StartSecondaryIndexEntry {id cdata} {
2433 AddIndexEntry "" ;# make sure our primary is defined
2434 lappend indexVals [string trim $cdata]
2438 # end a secondary index term
2439 proc EndSecondaryIndexEntry {} {
2443 # start a tertiary index term
2444 proc StartTertiaryIndexEntry {id cdata} {
2447 AddIndexEntry "" ;# make sure our secondary is defined
2448 lappend indexVals [string trim $cdata]
2452 # end a tertiary index term
2453 proc EndTertiaryIndexEntry {} {
2457 # compute the proper string for LOCS= in an index entry - primarily,
2458 # we want to avoid emitting the LOCS= if there are no locations
2459 # defined for this entry
2461 set locs [lindex $entry 2]
2463 return " LOCS=\"$locs\""
2469 # open a .idx file and write the index into it
2470 proc WriteIndex {} {
2471 global baseName indexArray
2473 set file [open "${baseName}.idx" w]
2475 # sort the index using our special I18N safe sort function that
2476 # gives us a dictionary (case insensitive) sort
2477 set names [lsort -command CompareI18NStrings [array names indexArray]]
2479 if {[set length [llength $names]]} {
2481 puts $file "<INDEX COUNT=\"$length\">"
2482 foreach name $names {
2483 set thisEntry $indexArray($name)
2484 switch [lindex $thisEntry 0] {
2485 1 { switch $oldLevel {
2486 1 { puts $file "</ENTRY>" }
2487 2 { puts $file "</ENTRY>\n</ENTRY>" }
2488 3 { puts $file "</ENTRY>\n</ENTRY>\n</ENTRY>" }
2491 2 { switch $oldLevel {
2492 2 { puts $file "</ENTRY>" }
2493 3 { puts $file "</ENTRY>\n</ENTRY>" }
2496 3 { if {$oldLevel == 3} { puts $file "</ENTRY>" } }
2498 puts -nonewline $file "<ENTRY[Locs $thisEntry]>"
2499 puts -nonewline $file [lindex $thisEntry 3]
2500 set oldLevel [lindex $thisEntry 0]
2504 1 { puts $file "</ENTRY>" }
2505 2 { puts $file "</ENTRY>\n</ENTRY>" }
2506 3 { puts $file "</ENTRY>\n</ENTRY>\n</ENTRY>" }
2508 puts $file "</INDEX>"
2515 # called at the beginning of CHAPTER on each FOOTNOTE element - save
2516 # their numbering for use by FOOTNOTEREF and emit a VIRPAGE for each
2518 proc GatherFootnote {id} {
2519 global footnoteArray footnoteCounter nextId
2521 incr footnoteCounter
2523 set footnoteArray($id) $footnoteCounter
2525 set id SDL-RESERVED[incr nextId]
2528 StartNewVirpage FOOTNOTE $id
2532 # emit the footnote number of the id surrounded by a <LINK> so we can
2533 # get to it; skip out if there's no id to reference
2534 proc FootnoteRef {idref} {
2535 global footnoteArray
2538 if {[info exists footnoteArray($idref)]} {
2539 Emit "<LINK RID=\"$idref\" WINDOW=\"popup\">"
2540 Emit "<KEY CLASS=\"EMPH\" SSI=\"FOOTNOTE\">"
2541 Emit "$footnoteArray($idref)</KEY></LINK>"
2547 # add an element to the current SNB - try to reuse an entry if
2549 proc AddToSNB {type data} {
2550 global currentSNB nextId
2552 set index "$type::$data"
2554 if {[info exists currentSNB($index)]} {
2555 set snbId $currentSNB($index)
2557 set snbId "SDL-RESERVED[incr nextId]"
2558 set currentSNB($index) $snbId
2564 # emit a DocBook Graphic element - create an SNB entry and point to
2566 proc Graphic {id entityref fileref gi} {
2569 if {$gi == "GRAPHIC"} {
2575 # if "entityref" is present, it overrides "fileref"
2576 if {$entityref != ""} {
2577 # need to remove "<OSFILE ASIS>" (or equivalent for different
2578 # system identifiers) from the beginning of the entity name
2579 # if nsgmls was used for the original parse; the regular
2580 # expression below should work by simply ignoring any leading
2581 # angle bracket delimited string
2582 regsub {^(<.*>)(.*)$} $entityref {\2} entityref
2589 UserError "No file name or entity specified for $gi" yes
2592 # if not in a paragraph, start one
2593 if {($gi == "GRAPHIC") && (!$inP)} { StartParagraph "" "P" "" }
2595 set snbId [AddToSNB GRAPHIC $file]
2598 Emit "<REFITEM RID=\"$snbId\" CLASS=\"$class\"></REFITEM>\n"
2603 # emit a deferred link; we deferred it when we saw that it was first
2604 # in a Para and that it contained only an InlineGraphic - we had
2605 # to wait for the InlineGraphic to come along to see if it not only
2606 # met the contextual constraints but also had a Remap=Graphic
2608 proc EmitDeferredLink {} {
2611 if {![array exists deferredLink]} return
2613 switch $deferredLink(gi) {
2614 LINK {StartLink "" $deferredLink(linkend) $deferredLink(type)}
2615 OLINK {StartOLink "" $deferredLink(localinfo) $deferredLink(type)}
2622 # emit an InlineGraphic that might be remapped to a Graphic (via
2623 # Remap=) and might have text wrapped around it (if it's first in
2624 # a Para or first in a [OU]Link that is itself first in a Para)
2625 proc InFlowGraphic {id entityref fileref parent remap role} {
2628 # we only map InlineGraphic to Graphic if we're either the first
2629 # thing in a Para or the only thing in a link which is itself
2630 # the first thing in a Para
2632 set haveDeferredLink [array exists deferredLink]
2637 ULINK {set ok $haveDeferredLink}
2640 Graphic $id $entityref $fileref INLINEGRAPHIC
2644 set uRemap [string toupper $remap]
2645 if {$uRemap == "GRAPHIC"} {
2646 set uRole [string toupper $role]
2649 "" {set role "LEFT"}
2650 RIGHT {set role "RIGHT"}
2652 set badValMess "Bad value (\"$role\") for Role attribute"
2653 UserError "$badValMess in InlineGraphic" yes
2657 if {$haveDeferredLink} {
2658 set linkID " ID=\"$deferredLink(id)\""
2659 if {$deferredLink(gi) == "ULINK"} {
2661 set haveDeferredLink 0
2666 Emit "<HEAD$linkID SSI=\"GRAPHIC-$role\">"
2667 if {$haveDeferredLink} {
2670 Graphic $id $entityref $fileref GRAPHIC
2671 if {$haveDeferredLink} {
2676 } elseif {$remap != ""} {
2677 set badValMess "Bad value (\"$remap\") for Remap attribute"
2678 UserError "$badValMess in InlineGraphic" yes
2681 Graphic $id $entityref $fileref INLINEGRAPHIC
2685 # start a figure; for now, ignore Role (as it was ignored in HelpTag)
2686 # but make sure Role contains only legal values
2687 proc StartFigure {id role} {
2689 set uRole [string toupper $role]
2695 set badValMess "Bad value for Role (\"$role\") attribute"
2696 UserError "$badValMess in Figure" yes
2701 PushForm "" "FIGURE" $id
2705 # emit a CiteTitle in a KEY with the SSI set to the PubWork attr.
2706 proc CiteTitle {id type} {
2707 Emit "<KEY CLASS=\"PUB-LIT\""
2711 Emit " SSI=\"$type\">"
2715 # start a KEY element - each parameter is optional (i.e, may be "")
2716 proc StartKey {id class ssi} {
2722 Emit " CLASS=\"$class\""
2725 Emit " SSI=\"$ssi\""
2730 # start an emphasis with role=heading; want want a different ssi
2731 # so we can make it bold rather than italic for use as a list
2733 proc StartHeading {id role} {
2734 set role [string toupper $role]
2735 if {$role != "HEADING"} {
2737 UserWarning "Bad value for Role (!= \"Heading\") in EMPHASIS" yes
2741 set ssi LIST-HEADING
2743 StartKey $id EMPH $ssi
2747 # start an Example or InformalExample - we need to put ourselves
2748 # in a mode where lines and spacing are significant
2750 global defaultParaType
2752 set defaultParaType " TYPE=\"LITERAL\""
2753 PushForm "" "EXAMPLE" $id
2757 # close an Example or InformalExample - put ourselves back in
2758 # the normal (non-literal) mode
2759 proc CloseExample {} {
2760 global defaultParaType
2762 set defaultParaType ""
2767 # start a Table or InformalTable - save the global attributes and
2768 # open a FORM to hold the table
2769 proc StartTable {id colSep frame label rowSep} {
2770 global tableAttributes
2772 set tableAttributes(colSep) $colSep
2773 set tableAttributes(label) $label
2774 set tableAttributes(rowSep) $rowSep
2776 PushForm TABLE "TABLE-$frame" $id
2778 # create a list of ids of empty blocks to be used to fill in
2779 # undefined table cells
2783 # check the "char" attribute - we only support "." at this time;
2784 # return "." if char="." and "" otherwise; issue warning if char
2785 # is some character other than "."
2786 proc CheckChar {char} {
2787 if {($char != "") && ($char != ".")} {
2788 UserError "Only \".\" supported for character alignment" yes
2795 # start a TGROUP - prepare to build a list of column specifications
2796 # and an array of span specifications to be accessed by name; a column
2797 # specification may be numbered, in which case default (all #IMPLIED)
2798 # column specifications will be inserted to come up to the specified
2799 # number - if there are already more column specifications than the
2800 # given number, it's an error; open a FORM to hold the TGroup
2801 proc StartTGroup {id align char cols colSep rowSep nColSpecs} {
2802 global tableGroupAttributes tableAttributes
2803 global tableGroupColSpecs tableGroupSpanSpecs
2804 global numberOfColSpecs colNames haveTFoot
2805 global needTGroupTHeadForm needTFootForm
2806 global tableGroupSavedFRowVec
2808 set numberOfColSpecs $nColSpecs
2810 # do a sanity check on the number of columns, there must be
2813 UserError "Unreasonable number of columns ($cols) in TGroup" yes
2817 # check for more COLSPECs than COLS - error if so
2818 if {$nColSpecs > $cols} {
2819 UserError "More ColSpecs defined than columns in the TGroup" yes
2822 set tableGroupAttributes(align) $align
2823 set tableGroupAttributes(char) [CheckChar $char]
2824 set tableGroupAttributes(cols) $cols
2825 if {$colSep == ""} {
2826 set tableGroupAttributes(colSep) $tableAttributes(colSep)
2828 set tableGroupAttributes(colSep) $colSep
2830 if {$rowSep == ""} {
2831 set tableGroupAttributes(rowSep) $tableAttributes(rowSep)
2833 set tableGroupAttributes(rowSep) $rowSep
2836 # make sure we have a blank colName array so we don't get errors
2837 # if we try to read or delete it when there have been no named
2838 # ColSpecs in this tableGroup - use a numeric key since that is
2839 # not a NMTOKEN and so can never be a colName - note that all
2840 # colNames share a common name space within each tGroup.
2843 # create an empty column specification list for this TGroup;
2844 # if no ColSpec definitions at this level, set them all to the
2845 # defaults - take advantage of the fact that the function ColSpec
2846 # will create default column specifications to fill out up to an
2847 # explicitly set ColNum
2848 set tableGroupColSpecs ""
2849 if {$nColSpecs == 0} {
2850 ColSpec "" TGROUP "" "" "" $cols "" "" ""
2853 PushForm TABLE TGROUP $id
2855 # set a flag to indicate that we haven't seen a TFoot yet; this
2856 # flag is used in EndRow and StartCell to determine if a Row is
2857 # the last row in this TGroup (the last row will be in the TFoot,
2858 # if present, otherwise it will be in the TBody)
2861 # initialize variables used to determine if we need separate FORM
2862 # elements for THead or TFoot - if ColSpec elements are not given
2863 # at those levels, they can go in the same FORM as the TBody and
2864 # we can guarantee that the columns will line up
2865 set needTGroupTHeadForm 0
2868 # and initialize a variable to hold saved FROWVEC elements across
2869 # THead, TBody and TFoot in case we are merging them into one or
2870 # two FORM elements rather than putting each in its own
2871 set tableGroupSavedFRowVec ""
2875 # close a table group; delete the info arrays and lists and close the
2878 global tableGroupAttributes tableGroupColSpecs tableGroupSpanSpecs
2881 unset tableGroupAttributes
2882 unset tableGroupColSpecs
2883 if {[info exists tableGroupSpanSpecs]} {
2884 unset tableGroupSpanSpecs
2888 # see the explanation for this variable under StartTGroup
2893 # process one of a series of column specifications - use the parent GI
2894 # to determine which column specifications we're dealing with; fill up
2895 # to the specified column number with default COLSPECs, using the
2896 # TGROUP, THEAD or TFOOT values as defaults; any COLSPEC values not
2897 # specified in the parameter list should also be defaulted
2898 proc ColSpec {grandparent parent align char colName colNum
2899 colSep colWidth rowSep} {
2900 # the number of currently defined colSpecs in this context
2901 global numberOfColSpecs
2904 # get the proper list of ColSpecs for the current context
2905 if {$grandparent == "ENTRYTBL"} {
2906 set gpName entryTable
2908 set gpName tableGroup
2911 THEAD { upvar #0 ${gpName}HeadColSpecs colSpecs }
2912 TGROUP { upvar #0 tableGroupColSpecs colSpecs }
2913 TFOOT { upvar #0 tableFootColSpecs colSpecs }
2914 ENTRYTBL { upvar #0 entryTableColSpecs colSpecs }
2917 # get the proper number of columns (either from TGroup or EntryTbl);
2918 # a THead could be in either a TGroup or EntryTbl so we need
2919 # to check the grandparent if we aren't at the top level
2920 if {$parent == "TGROUP"} {
2921 upvar #0 tableGroupAttributes attributes
2922 } elseif {$parent == "ENTRYTBL"} {
2923 upvar #0 entryTableAttributes attributes
2924 } elseif {$grandparent == "ENTRYTBL"} {
2925 upvar #0 entryTableAttributes attributes
2927 upvar #0 tableGroupAttributes attributes
2929 set nCols $attributes(cols)
2931 # check for more COLSPECs than COLS - we've already issued an error if so
2933 set currentLength [llength $colSpecs]
2934 if {$currentLength >= $nCols} {
2938 # create a default ColSpec
2939 set thisColSpec(align) $attributes(align)
2940 set thisColSpec(char) $attributes(char)
2941 set thisColSpec(colName) ""
2942 set thisColSpec(colSep) $attributes(colSep)
2943 set thisColSpec(colWidth) "1*"
2944 set thisColSpec(rowSep) $attributes(rowSep)
2946 # back fill with default COLSPECs if given an explicit COLNUM and
2947 # it's greater than our current position
2949 if {($colNum != "")} {
2950 if {($colNum < $currentLength)} {
2951 set badValMess1 "Explicit colNum ($colNum) less than current"
2952 set badValMess2 "number of ColSpecs ($currentLength)"
2953 UserError "$badValMess1 $badValMess2" yes
2956 while {$currentLength < $colNum} {
2957 set thisColSpec(colNum) $currentLength
2958 lappend colSpecs [array get thisColSpec]
2963 set colNum $currentLength
2965 # set this COLSPEC, we've already set the defaults
2967 set thisColSpec(align) $align
2970 set thisColSpec(char) [CheckChar $char]
2972 set thisColSpec(colName) $colName
2973 if {$colName != ""} {
2974 # save name to num mapping for later lookup by Entry
2975 set colNames($colName) $colNum
2977 set thisColSpec(colNum) $colNum
2978 if {$colSep != ""} {
2979 set thisColSpec(colSep) $colSep
2981 if {$colWidth != ""} {
2982 set thisColSpec(colWidth) $colWidth
2984 if {$rowSep != ""} {
2985 set thisColSpec(rowSep) $rowSep
2987 if {$colNum == $nCols} {
2988 set thisColSpec(colSep) 0; # ignore COLSEP on last column
2990 lappend colSpecs [array get thisColSpec]
2992 # fill out to the number of columns if we've run out of COLSPECs
2993 if {[incr numberOfColSpecs -1] <= 0} {
2994 # restore the default COLSPEC
2995 set thisColSpec(align) $attributes(align)
2996 set thisColSpec(char) $attributes(char)
2997 set thisColSpec(colName) ""
2998 set thisColSpec(colSep) $attributes(colSep)
2999 set thisColSpec(colWidth) "1*"
3000 set thisColSpec(rowSep) $attributes(rowSep)
3002 while {$colNum < $nCols} {
3004 set thisColSpec(colNum) $colNum
3005 if {$colNum == $nCols} {
3006 set thisColSpec(colSep) 0; # ignore on last column
3008 lappend colSpecs [array get thisColSpec]
3014 # process a SpanSpec - we can't take defaults yet because the Namest
3015 # and Nameend attributes may refer to ColSpecs that don't get defined
3016 # until a TFoot or THead
3017 proc SpanSpec {parent align char colSep nameEnd nameSt rowSep spanName} {
3018 if {$parent == "TGROUP"} {
3019 upvar #0 tableGroupSpanSpecs spanSpecs
3021 upvar #0 entryTableSpanSpecs spanSpecs
3024 set thisSpanSpec(align) $align
3025 set thisSpanSpec(char) [CheckChar $char]
3026 set thisSpanSpec(colSep) $colSep
3027 set thisSpanSpec(nameEnd) $nameEnd
3028 set thisSpanSpec(nameSt) $nameSt
3029 set thisSpanSpec(rowSep) $rowSep
3031 if {[info exists spanSpecs($spanName)]} {
3032 UserError "duplicate span name \"$spanName\"" yes
3036 set spanSpecs($spanName) [array get thisSpanSpec]
3040 # make a list of empty strings for use as an empty Row
3041 proc MakeEmptyRow {nCols} {
3043 while {$nCols > 0} {
3051 # given a ColSpec list, compute a COLW= vector for SDL;
3052 # the idea is to assume the page is 9360 units wide - that's
3053 # 6.5 inches in points at approximately 1/72 in. per point,
3054 # subtract all the absolute widths and divide the remnant by
3055 # the number of proportional width values then re-add the absolute
3056 # widths back in to the proper columns; this technique should
3057 # make pages that are exactly 6.5 in. in printing surface look just
3058 # right and then go proportional from there
3059 proc ComputeCOLW {colSpecList} {
3061 set nCols [llength $colSpecList]
3063 # build lists of just the ColWidth specs - one for the proporional
3064 # values and one for the absolutes
3068 while {$index < $nCols} {
3069 array set thisColSpec [lindex $colSpecList $index]
3070 set colWidth $thisColSpec(colWidth)
3071 set colWidth [string trimleft $colWidth]
3072 set colWidth [string trimright $colWidth]
3073 set colWidth [string tolower $colWidth]
3074 set widths [split $colWidth '+']
3075 set nWidths [llength $widths]
3079 while {$wIndex < $nWidths} {
3080 set thisWidth [lindex $widths $wIndex]
3081 if {[scan $thisWidth "%f%s" val qual] != 2} {
3082 UserError "Malformed ColWidth \"$thisWidth\"" yes
3088 switch -exact $qual {
3089 * {set thisProp $val}
3090 pt {set thisAbs [expr "$val * 1 * 20"]}
3091 pi {set thisAbs [expr "$val * 12 * 20"]}
3092 cm {set thisAbs [expr "$val * 28 * 20"]}
3093 mm {set thisAbs [expr "$val * 3 * 20"]}
3094 in {set thisAbs [expr "$val * 72 * 20"]}
3096 set propWidth [expr "$propWidth + $thisProp"]
3097 set absWidth [expr "$absWidth + $thisAbs"]
3100 lappend propWidths $propWidth
3101 lappend absWidths $absWidth
3102 set totalProps [expr "$totalProps + $propWidth"]
3103 set totalAbs [expr "$totalAbs + $absWidth"]
3106 if {$totalProps == 0} {
3107 # we need at least some proportionality; assume each cell
3108 # had been set to 1* to distribute evenly
3109 set totalProps $nCols
3111 if {[info exists propWidths]} {
3114 while {$index < $nCols} {
3115 lappend propWidths 1
3120 if {$totalAbs > $tableWidth} {
3121 set tableWidth $totalAbs
3123 set propAvail [expr "$tableWidth - $totalAbs"]
3124 set oneProp [expr "$propAvail / $totalProps"]
3126 # now we know what a 1* is worth and we know the absolute size
3127 # requests, create a ColWidth by adding the product of the
3128 # proportional times a 1* plus any absolute request; we'll allow
3129 # 20% growth and shrinkage
3132 while {$index < $nCols} {
3133 set thisAbs [lindex $absWidths $index]
3134 set thisProp [lindex $propWidths $index]
3135 set thisWidth [expr "$thisAbs + ($thisProp * $oneProp)"]
3136 set thisSlop [expr "$thisWidth * 0.2"]
3137 # make thisWidth an integer
3138 set dotIndex [string last "." $thisWidth]
3139 if {$dotIndex == 0} {
3141 } elseif {$dotIndex > 0} {
3143 set thisWidth [string range $thisWidth 0 $dotIndex]
3145 # make thisSlop an integer
3146 set dotIndex [string last "." $thisSlop]
3147 if {$dotIndex == 0} {
3149 } elseif {$dotIndex > 0} {
3151 set thisSlop [string range $thisSlop 0 $dotIndex]
3153 append returnValue "$space$thisWidth,$thisSlop"
3163 # given a ColSpec list, compute a COLJ= vector for SDL;
3164 proc ComputeCOLJ {colSpecList} {
3166 set nCols [llength $colSpecList]
3170 while {$index < $nCols} {
3171 array set thisColSpec [lindex $colSpecList $index]
3172 switch -exact $thisColSpec(align) {
3175 "" { set thisColJ l}
3176 CENTER { set thisColJ c}
3177 RIGHT { set thisColJ r}
3178 CHAR { set thisColJ d}
3180 append returnValue "$space$thisColJ"
3190 # given a ColSpec, create the COLW= and COLJ= attributes; check the
3191 # list of current TOSS entries to see if one matches - if so, return
3192 # its SSI= else add it and create an SSI= to return
3193 proc CreateOneTOSS {ssi vAlign colSpec} {
3194 global newTOSS nextId
3196 set colW [ComputeCOLW $colSpec]
3197 set colJ [ComputeCOLJ $colSpec]
3198 set names [array names newTOSS]
3199 foreach name $names {
3200 array set thisTOSS $newTOSS($name)
3201 if {[string compare $colW $thisTOSS(colW)]} {
3202 if {[string compare $colJ $thisTOSS(colJ)]} {
3203 if {[string compare $vAlign $thisTOSS(vAlign)]} {
3210 # no matching colW,colJ, add an entry
3212 set ssi HBF-SDL-RESERVED[incr nextId]
3214 set thisTOSS(colW) $colW
3215 set thisTOSS(colJ) $colJ
3216 set thisTOSS(vAlign) $vAlign
3217 set newTOSS($ssi) [array get thisTOSS]
3222 # save values from TFoot, we'll actually process TFoot after TBody
3223 # but we need to know whether we have a TFoot and whether that TFoot
3224 # has ColSpec elements in order to push/pop a FORM for the TBody if
3226 proc PrepForTFoot {nColSpecs} {
3227 global haveTFoot needTFootForm
3230 set needTFootForm [expr "$nColSpecs > 0"]
3234 # start a table header, footer or body - create a FORM to hold the rows;
3235 # create an empty row to be filled in by the Entry elements - set the
3236 # current row and number of rows to 1
3237 proc StartTHeadTFootTBody {parent gi haveTHead id vAlign nRows nColSpecs} {
3238 global numberOfColSpecs haveTFoot
3239 global needTFootForm
3241 if {$parent == "ENTRYTBL"} {
3242 upvar #0 entryTableRowDope rowDope
3243 upvar #0 needEntryTblTHeadForm needTHeadForm
3244 global entryTableAttributes
3245 set nCols $entryTableAttributes(cols)
3246 set entryTableAttributes(vAlign) $vAlign
3247 set entryTableAttributes(rows) $nRows
3249 upvar #0 tableGroupRowDope rowDope
3250 upvar #0 needTGroupTHeadForm needTHeadForm
3251 global tableGroupAttributes
3252 set nCols $tableGroupAttributes(cols)
3253 set tableGroupAttributes(vAlign) $vAlign
3254 set tableGroupAttributes(rows) $nRows
3257 set numberOfColSpecs $nColSpecs
3259 # get the proper list of ColSpecs for the current context
3260 if {$parent == "ENTRYTBL"} {
3261 set parentName entryTable
3263 set parentName tableGroup
3266 THEAD {upvar #0 ${parentName}HeadColSpecs colSpecs}
3267 TBODY {upvar #0 ${parentName}ColSpecs colSpecs}
3268 TFOOT {upvar #0 tableFootColSpecs colSpecs }
3271 # if no ColSpec definitions at this level, copy the parent's
3272 # ColSpec definition to here
3273 if {$nColSpecs == 0} {
3275 THEAD {upvar #0 ${parentName}ColSpecs parentColSpecs}
3276 TFOOT {upvar #0 tableGroupColSpecs parentColSpecs}
3278 if {$gi != "TBODY"} {
3279 set colSpecs $parentColSpecs
3283 # if we have ColSpec elements on a THead, we'll need to put it
3284 # in its own FORM; we saved this value for TFoot earlier
3285 # because TFoot precedes TBody in the content model but doesn't
3286 # get processed until after TBody (as EndText: to TGroup)
3287 if {$gi == "THEAD"} {
3288 set needTHeadForm [expr "$nColSpecs > 0"]
3291 # determine whether we need to push a new FORM here - we always
3292 # have to push a FORM for a THead, we only push one for TBody
3293 # if THead needed its own or there was no THead and we only push
3294 # one for TFoot if it needs its own
3298 set needTBodyForm $needTHeadForm
3303 TBODY {set doit $needTBodyForm}
3304 TFOOT {set doit $needTFootForm}
3307 # and push it, if so
3309 set ssi [CreateOneTOSS $id "" $colSpecs]
3310 PushForm TABLE "$ssi" $id
3313 set rowDope(nRows) 0
3314 set rowDope(currentRow) 0
3318 # end a table header footer or body - delete the global row
3319 # information and close the FORM; also delete the ColSpec info for
3320 # this THead or TFoot (TBody always uses the parent's)
3321 proc EndTHeadTFootTBody {parent gi} {
3322 global numberOfColSpecs needTFootForm haveTFoot
3324 if {$parent == "ENTRYTBL"} {
3325 upvar #0 needEntryTblTHeadForm needTHeadForm
3327 upvar #0 needTGroupTHeadForm needTHeadForm
3330 # determine whether we want to terminate this FORM here - we
3331 # only terminate the THead FORM if it needed its own, we only
3332 # terminate the TBody FORM if the TFoot needs its own or there
3333 # is no TFoot and we always terminate the FORM for TFoot
3334 if {($parent == "ENTRYTBL") || !$haveTFoot} {
3337 set needTBodyForm $needTFootForm
3341 THEAD {set doit $needTHeadForm}
3342 TBODY {set doit $needTBodyForm}
3345 PopTableForm $parent $gi $doit
3347 # blow away the list of ColSpecs for the current context
3349 THEAD { if {$parent == "ENTRYTBL"} {
3350 global entryTableHeadColSpecs
3351 unset entryTableHeadColSpecs
3353 global tableGroupHeadColSpecs
3354 unset tableGroupHeadColSpecs
3357 TFOOT { global tableFootColSpecs
3358 unset tableFootColSpecs
3364 # start a table row - save the attribute values for when we
3365 # actually emit the entries of this row; when we emit the first
3366 # entry we'll emit the ID on the rowSep FORM that we create for each
3367 # Entry and set the ID field to "" so we only emit the ID once
3368 proc StartRow {grandparent parent id rowSep vAlign} {
3369 if {$grandparent == "ENTRYTBL"} {
3370 upvar #0 entryTableRowDope rowDope
3371 global entryTableAttributes
3372 set nCols $entryTableAttributes(cols)
3373 if {$vAlign == ""} {
3374 set vAlign $entryTableAttributes(vAlign)
3377 upvar #0 tableGroupRowDope rowDope
3378 global tableGroupAttributes
3379 set nCols $tableGroupAttributes(cols)
3380 if {$vAlign == ""} {
3381 set vAlign $tableGroupAttributes(vAlign)
3384 upvar 0 rowDope(currentRow) currentRow
3385 upvar 0 rowDope(nRows) nRows
3388 set rowDope(rowSep) $rowSep
3389 set rowDope(vAlign) $vAlign
3392 if {![info exists rowDope(row$currentRow)]} {
3393 set rowDope(row$currentRow) [MakeEmptyRow $nCols]
3398 # a debugging procedure
3399 proc DumpRowDope {rowDopeName} {
3400 upvar 1 $rowDopeName rowDope
3402 puts stderr "rowDope:"
3404 while {[incr index] <= $rowDope(nRows)} {
3406 " $index: ([llength $rowDope(row$index)]) $rowDope(row$index)"
3412 proc EndRow {grandparent parent} {
3413 global emptyCells nextId haveTFoot
3415 # this row could be in a TGroup or an EntryTbl
3416 if {$grandparent == "ENTRYTBL"} {
3417 upvar #0 entryTableRowDope rowDope
3418 global entryTableAttributes
3419 set nCols $entryTableAttributes(cols)
3420 set nRowDefs $entryTableAttributes(rows)
3422 upvar #0 tableGroupRowDope rowDope
3423 global tableGroupAttributes
3424 set nCols $tableGroupAttributes(cols)
3425 set nRowDefs $tableGroupAttributes(rows)
3428 # get the proper list of ColSpecs for the current context
3430 THEAD { if {$grandparent == "ENTRYTBL"} {
3431 upvar #0 entryTableHeadColSpecs colSpecs
3433 upvar #0 tableGroupHeadColSpecs colSpecs
3436 TBODY { if {$grandparent == "ENTRYTBL"} {
3437 upvar #0 entryTableColSpecs colSpecs
3439 upvar #0 tableGroupColSpecs colSpecs
3442 TFOOT { upvar #0 tableFootColSpecs colSpecs }
3445 # go over the row filing empty cells with an empty FORM containing
3446 # an empty BLOCK. The FORM SSI= is chosen to give a RowSep based
3447 # upon the current ColSpec and rowDope, if we are on the last row
3448 # we want to set the RowSep to 0 unless there were more rows
3449 # created via the MoreRows attribute of Entry or EntryTbl forcing
3450 # the table to be longer than the number of Rows specified in which
3451 # case we want to fill in all those rows too and only force RowSep
3452 # to 0 on the last one; the inner BLOCK SSI= is chosen to give a
3453 # ColSep based upon the current ColSpec and Row definition - if
3454 # the column is the last one in the row, the ColSep is set to 0
3455 set currentRow $rowDope(currentRow)
3456 if {$currentRow == $nRowDefs} {
3457 set moreRows [expr "$rowDope(nRows) - $nRowDefs"]
3461 upvar 0 rowDope(row$currentRow) thisRow
3462 upvar 0 rowDope(row[expr "$currentRow - 1"]) prevRow
3463 while {$moreRows >= 0} {
3465 while {$colIndex < $nCols} {
3466 set thisCellId [lindex $thisRow $colIndex]
3467 if {$thisCellId == ""} {
3468 array set thisColSpec [lindex $colSpecs $colIndex]
3469 set desiredCell(colSep) $thisColSpec(colSep)
3470 set desiredCell(rowSep) $thisColSpec(rowSep)
3471 if {$rowDope(rowSep) != ""} {
3472 set desiredCell(rowSep) $rowDope(rowSep)
3474 if {$colIndex == $nCols} {
3475 set desiredCell(colSep) 0
3477 if {($moreRows == 0) && ($currentRow == $nRowDefs)} {
3478 if {($parent == "TFOOT") ||
3479 (($parent == "TBODY") && (!$haveTFoot))} {
3480 set desiredCell(rowSep) 0
3483 if {$desiredCell(colSep) == ""} {
3484 set desiredCell(colSep) 1
3486 if {$desiredCell(rowSep) == ""} {
3487 set desiredCell(rowSep) 1
3490 foreach id [array names emptyCells] {
3491 array set thisCell $emptyCells($id)
3492 if {$thisCell(colSep) != $desiredCell(colSep)} {
3495 if {$thisCell(rowSep) != $desiredCell(rowSep)} {
3498 if {$currentRow > 1} {
3499 if {[lindex $prevRow $colIndex] == $id} {
3503 if {$colIndex > 0} {
3504 if {$lastCellId == $id} {
3513 if {$desiredCell(rowSep)} {
3514 set ssi BORDER-BOTTOM
3518 set id [PushFormCell $ssi ""]
3519 if {$desiredCell(colSep)} {
3520 set ssi ENTRY-NONE-YES-NONE
3522 set ssi ENTRY-NONE-NO-NONE
3524 StartBlock CELL $ssi "" 1
3526 set emptyCells($id) [array get desiredCell]
3529 Replace thisRow $colIndex 1 $thisCellId
3531 set lastCellId $thisCellId
3536 upvar 0 thisRow prevRow
3537 upvar 0 rowDope(row$currentRow) thisRow
3540 # blow away the variables that get reset on each row
3542 unset rowDope(rowSep)
3543 unset rowDope(vAlign)
3547 # given a row list, an id and start and stop columns, replace the
3548 # entries in the list from start to stop with id - use "upvar" on
3549 # the row list so we actually update the caller's row
3550 proc Replace {callersRow start length id} {
3551 upvar $callersRow row
3553 # length will be 0 if there was an error on the row
3558 # make a list of ids long enough to fill the gap
3560 set ids $id; # we pad all the others with a starting space
3561 while {$i < $length} {
3566 # do the list replacement - need to "eval" because we want the
3567 # ids to be seen a individual args, not a list so we need to
3568 # evaluate the command twice
3569 set stop [expr "$start + $length - 1"]
3570 set command "set row \[lreplace \$row $start $stop $ids\]"
3575 # process a table cell (Entry or EntryTbl); attributes are inherited
3576 # in the following fashion:
3583 # with later values (going down the list) overriding earlier ones;
3584 # Table, TGroup, etc., values have already been propagated to the
3586 proc StartCell {ancestor grandparent gi id align char colName cols
3587 colSep moreRows nameEnd nameSt rowSep spanName
3588 vAlign nColSpecs nTBodies} {
3589 global colNames tableGroupAttributes entryTableAttributes
3590 global numberOfColSpecs entryTableColSpecs nextId haveTFoot
3591 global needEntryTblTHeadForm entryTableSavedFRowVec
3593 # get the appropriate SpanSpec list, if any; also get the row
3594 # row dope vector which also contains the current row number
3595 # and number of rows currently allocated (we might get ahead
3596 # of ourselves due to a vertical span via MOREROWS=)
3597 if {$ancestor == "TGROUP"} {
3598 upvar #0 tableGroupSpanSpecs spanSpecs
3599 upvar #0 tableGroupRowDope rowDope
3600 set nCols $tableGroupAttributes(cols)
3601 set nRowDefs $tableGroupAttributes(rows)
3603 upvar #0 entryTableSpanSpecs spanSpecs
3604 upvar #0 entryTableRowDope rowDope
3605 set nCols $entryTableAttributes(cols)
3606 set nRowDefs $entryTableAttributes(rows)
3609 # get the proper list of ColSpecs for the current context
3610 switch $grandparent {
3611 THEAD { if {$ancestor == "ENTRYTBL"} {
3612 upvar #0 entryTableHeadColSpecs colSpecs
3614 upvar #0 tableGroupHeadColSpecs colSpecs
3617 TBODY { if {$ancestor == "ENTRYTBL"} {
3618 upvar #0 entryTableColSpecs colSpecs
3620 upvar #0 tableGroupColSpecs colSpecs
3623 TFOOT { upvar #0 tableFootColSpecs colSpecs }
3627 if {$spanName != ""} {
3628 if {[info exists spanSpecs($spanName)]} {
3629 array set thisSpan $spanSpecs($spanName)
3630 # SpanSpec column names win over explicit ones
3631 set nameSt $thisSpan(nameSt)
3632 set nameEnd $thisSpan(nameEnd)
3634 UserError "Attempt to use undefined SpanSpec \"$spanName\"" yes
3638 # nameSt, whether explicit or from a span, wins over colName
3639 if {$nameSt != ""} {
3643 # get the row information - use upvar so we can update rowDope
3644 upvar 0 rowDope(currentRow) currentRow
3645 upvar 0 rowDope(row$currentRow) thisRow
3646 upvar 0 rowDope(nRows) nRows
3648 # by now, if no colName we must have neither colName, nameSt nor
3649 # a horizontal span - find the next open spot in this row
3650 if {$colName != ""} {
3651 if {[info exists colNames($colName)]} {
3652 set startColNum $colNames($colName)
3653 if {$startColNum > $nCols} {
3654 UserError "Attempt to address column outside of table" yes
3657 incr startColNum -1 ;# make the column number 0 based
3660 UserError "Attempt to use undefined column name \"$colName\"" yes
3664 if {$colName == ""} {
3666 while {[lindex $thisRow $index] != ""} {
3669 if {$index == $nCols} {
3670 UserError "More entries defined than columns in this row" yes
3673 set startColNum $index
3676 # if we have a nameEnd, it was either explicit or via a span -
3677 # get the stop column number; else set the stop column to the
3678 # start column, i.e., a span of 1
3679 if {$nameEnd == ""} {
3680 set stopColNum $startColNum
3682 if {[info exists colNames($nameEnd)]} {
3683 set stopColNum $colNames($nameEnd)
3684 if {$stopColNum > $nCols} {
3685 UserError "Attempt to address column outside of table" yes
3686 set stopColNum $nCols
3688 incr stopColNum -1 ;# make the column number 0 based
3689 if {$startColNum > $stopColNum} {
3690 UserError "End of column span is before the start" yes
3691 set stopColNum $startColNum
3694 UserError "Attempt to use undefined column name \"$nameEnd\"" yes
3695 set stopColNum $startColNum
3699 # create an empty set of attributes for the cell - we'll fill
3700 # them in from the ColSpec, SpanSpec, Row and Entry or EntryTbl
3701 # defined values, if any, in that order
3707 # initialize the cell description with the ColSpec data
3708 # Table, TGroup and EntryTable attributes have already
3709 # percolated to the ColSpec
3710 if {$startColNum >= 0} {
3711 array set thisColSpec [lindex $colSpecs $startColNum]
3712 if {$thisColSpec(colSep) != ""} {
3713 set cellColSep $thisColSpec(colSep)
3715 if {$thisColSpec(rowSep) != ""} {
3716 set cellRowSep $thisColSpec(rowSep)
3720 # overlay any attributes defined on the span, that is, SpanSpec
3721 # attributes win over ColSpec ones
3722 if {[info exists thisSpan]} {
3723 if {$thisSpan(align) != ""} {
3724 set cellAlign $thisSpan(align)
3726 if {$thisSpan(colSep) != ""} {
3727 set cellColSep $thisSpan(colSep)
3729 if {$thisSpan(rowSep) != ""} {
3730 set cellRowSep $thisSpan(rowSep)
3734 # overlay any attributes defined on the Row
3735 if {$rowDope(rowSep) != ""} {
3736 set cellRowSep $rowDope(rowSep)
3738 if {$rowDope(vAlign) != ""} {
3739 set cellVAlign $rowDope(vAlign)
3742 # check for a char other than "" or "."; just a check, we don't
3743 # do anything with char
3744 set char [CheckChar $char]
3746 # overlay any attributes defined on the Entry or EntryTbl - these
3749 set cellAlign $align
3751 if {$colSep != ""} {
3752 set cellColSep $colSep
3754 if {$rowSep != ""} {
3755 set cellRowSep $rowSep
3757 if {$vAlign != ""} {
3758 set cellVAlign $vAlign
3761 # if this cell is the first on the row, feed it the (possible)
3762 # Row ID and set the Row ID to ""
3763 if {[set cellId $rowDope(id)] == ""} {
3764 set cellId SDL-RESERVED[incr nextId]
3769 # now put the cell into the rowDope vector - if there's a
3770 # span, we'll put the cell in several slots; if there's a
3771 # vertical straddle, we may need to add more rows to rowDope
3772 if {$startColNum >= 0} {
3773 set stopRowNum [expr "$currentRow + $moreRows"]
3774 set spanLength [expr "($stopColNum - $startColNum) + 1"]
3775 set rowIndex $currentRow
3776 while {$rowIndex <= $stopRowNum} {
3777 if {![info exists rowDope(row$rowIndex)]} {
3778 set rowDope(row$rowIndex) [MakeEmptyRow $nCols]
3781 upvar 0 rowDope(row$rowIndex) thisRow
3782 set colIndex $startColNum
3783 while {$colIndex <= $stopColNum} {
3784 if {[lindex $thisRow $colIndex] != ""} {
3785 set badValMess1 "Multiple definitions for column"
3786 set badValMess2 "of row $rowIndex"
3788 "$badValMess1 [expr $colIndex + 1] $badValMess2" yes
3795 Replace thisRow $startColNum $spanLength $cellId
3800 # on the last column, the column separator should be 0; on the
3801 # last row, the row separator should be 0 - the table frame will
3802 # set the border on the right and bottom sides
3803 if {$stopColNum == $nCols} {
3806 if {$currentRow == $nRowDefs} {
3807 if {($grandparent == "TFOOT") ||
3808 (($grandparent == "TBODY") && (!$haveTFoot))} {
3813 # push a form to hold the RowSep
3814 if {$cellRowSep == 1} {
3815 set ssi "BORDER-BOTTOM"
3817 set ssi "BORDER-NONE"
3819 PushFormCell $ssi $cellId
3821 # build the SSI= for the cell and push a form to hold it
3822 if {$gi == "ENTRY"} {
3828 "" { append ssi "NONE-" }
3829 LEFT { append ssi "LEFT-" }
3830 RIGHT { append ssi "RIGHT-" }
3831 CENTER { append ssi "CENTER-" }
3832 JUSTIFY { append ssi "LEFT-" }
3833 CHAR { append ssi "CHAR-" }
3835 switch $cellColSep {
3836 0 { append ssi "NO-" }
3837 1 { append ssi "YES-" }
3839 switch $cellVAlign {
3841 NONE { append ssi "NONE" }
3842 TOP { append ssi "TOP" }
3843 MIDDLE { append ssi "MIDDLE" }
3844 BOTTOM { append ssi "BOTTOM" }
3846 PushForm CELL $ssi $id
3848 # if we are in an Entry, open a paragraph in case all that's in
3849 # the Entry are inline objects - this may end up in an empty P
3850 # if the Entry contains paragraph level things, e.g., admonitions,
3851 # lists or paragraphs; if we are an EntryTbl, set up the defaults
3852 # for the recursive calls to, e.g., THead or TBody
3853 if {$gi == "ENTRY"} {
3854 StartParagraph "" "" ""
3856 # the syntax would allow multiple TBODY in an ENTRYTBL but
3857 # we (and the rest of the SGML community, e.g., SGML/Open)
3858 # don't allow more than one - the transpec will keep us from
3859 # seeing the extras but we need to flag the error to the user
3860 if {$nTBodies != 1} {
3861 UserError "More than one TBODY in an ENTRYTBL" yes
3864 set entryTableAttributes(align) $align
3865 set entryTableAttributes(char) [CheckChar $char]
3867 # do a sanity check on the number of columns, there must be
3870 UserError "Unreasonable number of columns ($cols) in EntryTbl" yes
3873 set entryTableAttributes(cols) $cols
3875 if {$colSep == ""} {
3876 set entryTableAttributes(colSep) 1
3878 set entryTableAttributes(colSep) $colSep
3880 if {$rowSep == ""} {
3881 set entryTableAttributes(rowSep) 1
3883 set entryTableAttributes(rowSep) $rowSep
3886 # check for more COLSPECs than COLS - error if so
3887 if {$nColSpecs > $cols} {
3889 "More ColSpecs defined than columns in an EntryTbl" yes
3892 set numberOfColSpecs $nColSpecs
3894 set entryTableColSpecs ""
3896 # if no ColSpec definitions at this level, set them all to the
3897 # defaults - take advantage of the fact that the function ColSpec
3898 # will create default column specifications to fill out up to an
3899 # explicitly set ColNum
3900 if {$nColSpecs == 0} {
3901 ColSpec "" ENTRYTBL "" "" "" $cols "" "" ""
3904 # initialize a variable used to determine if we need a separate
3905 # FORM element for THead - if ColSpec elements are not given
3906 # at that level, it can go in the same FORM as the TBody and
3907 # we can guarantee that the columns will line up
3908 set needEntryTblTHeadForm 0
3910 # and initialize a variable to hold saved FROWVEC elements
3911 # across THead into TBody in case we are merging them into
3912 # one FORM element rather than putting each in its own
3913 set entryTableSavedFRowVec ""
3918 # end a table Entry - pop the form holding the cell
3919 # attributes and the form holding the RowSep
3926 # end a table EntryTbl - pop the form holding the cell
3927 # attributes and the form holding the RowSep and clean up the
3929 proc EndEntryTbl {} {
3930 global entryTableSpanSpecs numberOfColSpecs entryTableColSpecs
3935 if {[info exists entryTableSpanSpecs]} {
3936 unset entryTableSpanSpecs
3939 unset entryTableColSpecs
3942 ######################################################################
3943 ######################################################################
3947 ######################################################################
3948 ######################################################################
3950 # change the OutputString routine into one that will save the content
3951 # of this element for use as the man-page title, e.g., the "cat"
3952 # in "cat(1)"; this name may be overridden by RefDescriptor in
3953 # RefNameDiv if the sort name is different (e.g., "memory" for
3955 proc DivertOutputToManTitle {} {
3956 rename OutputString SaveManTitleOutputString
3957 rename ManTitleOutputString OutputString
3961 # change the output stream back to the OutputString in effect at the
3962 # time of the call to DivertOutputToManTitle
3963 proc RestoreOutputStreamFromManTitle {} {
3964 rename OutputString ManTitleOutputString
3965 rename SaveManTitleOutputString OutputString
3969 # a routine to buffer the output into the string "manTitle" for later
3970 # use in the top corners of man-pages
3971 proc ManTitleOutputString {string} {
3974 append manTitle $string
3978 # change the OutputString routine into one that will save the content
3979 # of this element for use as the man-page volume number, e.g., the "1"
3981 proc DivertOutputToManVolNum {} {
3982 rename OutputString SaveManVolNumOutputString
3983 rename ManVolNumOutputString OutputString
3987 # change the output stream back to the OutputString in effect at the
3988 # time of the call to DivertOutputToManVolNum
3989 proc RestoreOutputStreamFromManVolNum {} {
3990 rename OutputString ManVolNumOutputString
3991 rename SaveManVolNumOutputString OutputString
3995 # a routine to buffer the output into the string "manVolNum" for later
3996 # use in the top corners of man-pages
3997 proc ManVolNumOutputString {string} {
4000 append manVolNum $string
4004 # start a reference name division; nothing to emit now, just save
4005 # the number of names defined in this division and initialize the
4006 # current name count to 1
4007 proc StartRefNameDiv {nNames} {
4008 global numManNames currentManName
4010 set numManNames $nNames
4011 set currentManName 1
4015 # end a reference name division; we can now emit the HEAD elements to
4016 # create the titles in the upper corners and the "NAME" section of the
4018 proc EndRefNameDiv {id} {
4019 global manTitle manVolNum manDescriptor manNames manPurpose
4020 global localizedAutoGeneratedStringArray
4022 set manPageName $manTitle
4023 if {$manDescriptor != ""} {
4024 set manPageName $manDescriptor
4027 # emit the titles in the upper left and right corners
4028 Emit "<HEAD TYPE=\"LITERAL\" SSI=\"MAN-PAGE-TITLE-LEFT\">"
4029 Emit "${manPageName}($manVolNum)"
4031 Emit "<HEAD TYPE=\"LITERAL\" SSI=\"MAN-PAGE-TITLE-RIGHT\">"
4032 Emit "${manPageName}($manVolNum)"
4035 # and the NAME section
4037 Emit "<HEAD TYPE=\"LITERAL\" SSI=\"MAN-PAGE-DIVISION-NAME\">"
4039 Emit $localizedAutoGeneratedStringArray($message)
4041 StartBlock "" "MAN-PAGE-DIVISION" "" 1
4042 StartParagraph "" "" ""
4043 Emit "$manNames - $manPurpose"
4048 # change the OutputString routine into one that will save the content
4049 # of this element for use as the man-page descriptor, e.g., the
4050 # "string" in "string(3C)"
4051 proc DivertOutputToManDescriptor {} {
4052 rename OutputString SaveManDescriptorOutputString
4053 rename ManDescriptorOutputString OutputString
4057 # change the output stream back to the OutputString in effect at the
4058 # time of the call to DivertOutputToManDescriptor
4059 proc RestoreOutputStreamFromManDescriptor {} {
4060 rename OutputString ManDescriptorOutputString
4061 rename SaveManDescriptorOutputString OutputString
4065 # a routine to buffer the output into the string "manDescriptor" for
4066 # later use in the top corners of man-pages
4067 proc ManDescriptorOutputString {string} {
4068 global manDescriptor
4070 append manDescriptor $string
4074 # change the OutputString routine into one that will save the content
4075 # of this element for use as the man-page command or function name,
4076 # e.g., the "cat" in "cat(1)"
4077 proc DivertOutputToManNames {} {
4078 rename OutputString SaveManNamesOutputString
4079 rename ManNamesOutputString OutputString
4083 # change the output stream back to the OutputString in effect at the
4084 # time of the call to DivertOutputToManNames
4085 proc RestoreOutputStreamFromManNames {} {
4086 rename OutputString ManNamesOutputString
4087 rename SaveManNamesOutputString OutputString
4091 # a routine to buffer the output into the string "manNames" for
4092 # later use in the top corners of man-pages
4093 proc ManNamesOutputString {string} {
4096 append manNames $string
4100 # collect RefName elements into a single string; start diversion to
4101 # the string on the first man name
4102 proc StartAManName {} {
4103 global numManNames currentManName
4105 if {$currentManName == 1} {
4106 DivertOutputToManNames
4111 # end diversion on the last man name; append "(), " to each name but
4112 # the last to which we only append "()"
4113 proc EndAManName {} {
4114 global numManNames currentManName manDescriptor manNames
4116 if {($currentManName == 1) && ($manDescriptor == "")} {
4117 set manDescriptor $manNames
4120 if {$currentManName < $numManNames} {
4122 } elseif {$currentManName == $numManNames} {
4123 RestoreOutputStreamFromManNames
4130 # change the OutputString routine into one that will save the content
4131 # of this element for use as the man-page purpose; this string will
4132 # follow the function or command name(s) separated by a "-"
4133 proc DivertOutputToManPurpose {} {
4134 rename OutputString SaveManPurposeOutputString
4135 rename ManPurposeOutputString OutputString
4139 # change the output stream back to the OutputString in effect at the
4140 # time of the call to DivertOutputToManPurpose
4141 proc RestoreOutputStreamFromManPurpose {} {
4142 rename OutputString ManPurposeOutputString
4143 rename SaveManPurposeOutputString OutputString
4147 # a routine to buffer the output into the string "manPurpose" for
4148 # later use in the NAME section of man-pages
4149 proc ManPurposeOutputString {string} {
4152 append manPurpose $string
4156 # start a reference synopsis division - create a FORM to hold the
4157 # division and, potentially, any RefSect2-3; if there is a Title on
4158 # RefSynopsisDiv, use it, else default to "SYNOPSIS"
4159 proc StartRefSynopsisDiv {id haveTitle nSynopses} {
4160 global remainingSynopses
4161 global localizedAutoGeneratedStringArray
4163 set remainingSynopses $nSynopses
4166 StartManPageDivisionTitle ""
4167 set message "SYNOPSIS"
4168 Emit $localizedAutoGeneratedStringArray($message)
4169 EndManPageDivisionTitle
4174 # the user provided a title for this section, use it
4175 proc StartManPageDivisionTitle {id} {
4177 set id " ID=\"$id\""
4179 Emit "<HEAD$id TYPE=\"LITERAL\" SSI=\"MAN-PAGE-DIVISION-NAME\">"
4183 # the user provided a title for this section, we need to open a form
4184 # to hold the section now
4185 proc EndManPageDivisionTitle {} {
4187 PushForm "" "MAN-PAGE-DIVISION" ""
4190 # begin a Synopsis - if this is the first of any of the synopses, emit
4191 # a FORM to hold them all
4192 proc StartSynopsis {id linespecific} {
4193 if {$linespecific == ""} {
4198 StartParagraph id "" $type
4202 # end any of Synopsis, CmdSynopsis or FuncSynopsis - close out the
4203 # form if it's the last one
4204 proc EndSynopses {parent} {
4205 global remainingSynopses
4209 if {($parent == "REFSYNOPSISDIV") && ([incr remainingSynopses -1] == 0)} {
4215 # begin a CmdSynopsis
4216 proc StartCmdSynopsis {id} {
4217 StartParagraph id "" ""
4221 # start a man-page argument - surround the arg in a KEY element
4222 proc StartArg {id choice separator} {
4223 # mark this spot if there's a user supplied ID
4226 # emit nothing at start of list, v-bar inside of Group else space
4229 Emit "<KEY CLASS=\"NAME\" SSI=\"MAN-PAGE-ARG\">"
4230 if {$choice == "OPT"} {
4232 } elseif {$choice == "REQ"} {
4238 # end a man-page argument - if choice is not "plain", emit the proper
4239 # close character for the choice; if repeat is "repeat", emit an
4240 # ellipsis after the arg
4241 proc EndArg {choice repeat} {
4242 if {$choice == "OPT"} {
4244 } elseif {$choice == "REQ"} {
4247 if {$repeat == "REPEAT"} {
4248 Emit "<SPC NAME=\"\[hellip\]\">"
4254 # start an argument, filename, etc., group in a man-page command
4256 proc StartGroup {id choice separator} {
4257 # mark this spot if there's a user supplied ID
4260 # emit nothing at start of list, v-bar inside of Group else space
4263 # clean up optmult/reqmult since, for example, req+repeat == reqmult,
4264 # optmult and reqmult are redundant
4265 if {$choice == "OPTMULT"} {
4267 } elseif {$choice == "REQMULT"} {
4271 if {$choice == "OPT"} {
4273 } elseif {$choice == "REQ"} {
4279 # end an argument, filename, etc., group in a man-page command
4281 proc EndGroup {choice repeat} {
4282 # clean up optmult/reqmult since, for example, req+repeat == reqmult,
4283 # optmult and reqmult are redundant
4284 if {$choice == "OPTMULT"} {
4287 } elseif {$choice == "REQMULT"} {
4291 if {$choice == "OPT"} {
4293 } elseif {$choice == "REQ"} {
4296 if {$repeat == "REPEAT"} {
4297 Emit "<SPC NAME=\"\[hellip\]\">"
4302 # start a command name in a man-page command synopsis
4303 proc StartCommand {id separator} {
4304 # mark this spot if there's a user supplied ID
4307 # emit nothing at start of synopsis else space
4310 Emit "<KEY CLASS=\"NAME\" SSI=\"MAN-PAGE-COMMAND\">"
4314 # begin a FuncSynopsis
4315 proc StartFuncSynopsis {id} {
4319 # check that the GI of the element pointed to by a SynopFragmentRef
4320 # is really a SynopFragment
4321 proc CheckSynopFragmentRef {gi id} {
4322 if {$gi != "SYNOPFRAGMENT"} {
4323 set badValMess1 "SynopFragmentRef LinkEnd=$id"
4324 set badValMess2 "must refer to a SynopFragment"
4325 UserError "$badValMess1 $badValMess2" yes
4330 # begin a FuncSynopsisInfo - emit a P to hold it
4331 proc StartFuncSynopsisInfo {id linespecific} {
4332 if {$linespecific == "LINESPECIFIC"} {
4333 set type " TYPE=\"LINED\""
4338 StartParagraph $id "FUNCSYNOPSISINFO" $type
4342 # begin a FuncDef - emit a P to hold it
4343 proc StartFuncDef {id} {
4344 StartParagraph $id "FUNCDEF" ""
4348 # end a FuncDef, emit the open paren in preparation for the args
4349 proc EndFuncDef {} {
4354 # handle Void or Varargs in a FuncSynopsis - wrap it in a KEY and
4355 # emit the string "VOID" or "VARARGS"
4356 proc DoVoidOrVarargs {gi id} {
4357 # mark this spot if there's a user supplied ID
4360 Emit "<KEY CLASS=\"NAME\" SSI=\"FUNCDEF-ARGS\">"
4367 # start a ParamDef - just emit an anchor, if needed, for now
4368 proc StartParamDef {id} {
4369 # mark this spot if there's a user supplied ID
4374 # end of a ParamDef - emit either the ", " for the next one or, if the
4375 # last, emit the closing ")"
4376 proc EndParamDef {separator} {
4381 # start a FuncParams - just emit an anchor, if needed, for now
4382 proc StartFuncParams {id} {
4383 # mark this spot if there's a user supplied ID
4388 # end of a FuncParams - emit either the ", " for the next one or, if the
4389 # last, emit the closing ")"
4390 proc EndFuncParams {separator} {
4395 ######################################################################
4396 ######################################################################
4400 ######################################################################
4401 ######################################################################
4402 # open an intradocument link
4403 proc StartLink {id linkend type} {
4404 StartParagraphMaybe "" "P" $id
4406 Emit "<LINK RID=\"$linkend\""
4408 set type [string toupper $type]
4410 JUMPNEWVIEW {Emit " WINDOW=\"NEW\""}
4411 DEFINITION {Emit " WINDOW=\"POPUP\""}
4420 # defer a Link at the start of a Para until we see if the following
4421 # InlineGraphic has Role=graphic and we want it in a HEAD
4422 proc DeferLink {id linkend type} {
4425 set deferredLink(gi) LINK
4426 set deferredLink(id) $id
4427 set deferredLink(linkend) $linkend
4428 set deferredLink(type) $type
4432 # open an interdocument link; this link will require an SNB entry
4433 proc StartOLink {id localInfo type} {
4434 StartParagraphMaybe "" "P" $id
4436 set type [string toupper $type]
4438 set linkType CURRENT
4440 JUMP {set linkType CURRENT}
4441 JUMPNEWVIEW {set linkType NEW}
4443 DEFINITION {set linkType POPUP}
4446 set snbType CROSSDOC
4448 EXECUTE {set snbType SYS-CMD}
4449 APP-DEFINED {set snbType CALLBACK}
4450 MAN {set snbType MAN-PAGE}
4453 set snbId [AddToSNB $snbType $localInfo]
4455 Emit "<LINK RID=\"$snbId\""
4456 if {$linkType != "CURRENT"} {
4457 Emit " WINDOW=\"$linkType\""
4463 # defer an OLink at the start of a Para until we see if the following
4464 # InlineGraphic has Role=graphic and we want it in a HEAD
4465 proc DeferOLink {id localInfo type} {
4468 set deferredLink(gi) OLINK
4469 set deferredLink(id) $id
4470 set deferredLink(localinfo) $localinfo
4471 set deferredLink(type) $type
4475 # defer a ULink at the start of a Para until we see if the following
4476 # InlineGraphic has Role=graphic and we want it in a HEAD
4477 proc DeferULink {id} {
4480 set deferredLink(gi) ULINK
4481 set deferredLink(id) $id
4491 ######################################################################
4492 ######################################################################
4494 # character formatting
4496 ######################################################################
4497 ######################################################################
4498 # open a Quote; we'll emit two open single quotes wrapped in a
4499 # key with a style that will put them in a proportional font so they
4500 # fit together and look like an open double quote
4501 proc StartQuote {id} {
4502 Emit "<KEY CLASS=\"QUOTE\" SSI=\"PROPORTIONAL\">"
4507 # close a Quote; we'll emit two close single quotes wrapped in a
4508 # key with a style that will put them in a proportional font so they
4509 # fit together and look like a close double quote
4511 Emit "<KEY CLASS=\"QUOTE\" SSI=\"PROPORTIONAL\">''</KEY>"
4514 ######################################################################
4515 ######################################################################
4517 # end of document stuff
4519 ######################################################################
4520 ######################################################################
4522 # write out the .snb file - first update the file location for
4523 # insertion of the SNB by the second pass to reflect the addition
4524 # of the INDEX; also incorporate the INDEX and update the TOSS to
4525 # reflect any additions necessary to support tables
4527 global savedSNB indexLocation tossLocation baseName
4529 # get a handle for the index file and the existing .sdl file;
4530 # prepare to write the updated .sdl file and the .snb file by
4531 # blowing away the current names so the second open of the .sdl
4532 # file is creating a new file and we don't have leftover .snb
4533 # or .idx files laying around
4535 set sdlInFile [open "${baseName}.sdl" r]
4536 set sdlSize [file size "${baseName}.sdl"]
4538 set idxFile [open "${baseName}.idx" r]
4539 set idxSize [file size "${baseName}.idx"]
4541 exec rm -f ${baseName}.sdl ${baseName}.idx ${baseName}.snb
4542 set sdlOutFile [open "${baseName}.sdl" w]
4544 # create any additional TOSS entries made necessary by COLW and
4545 # COLJ settings for TGroup or EntryTbl elements.
4546 set toss [CreateTableTOSS]
4547 set tossSize [string length $toss]
4549 # get a list of the byte offsets into the .sdl file for the
4551 set snbLocations [lsort -integer [array names savedSNB]]
4553 # and write out the .snb file updating the locations as we go
4554 if {[llength $snbLocations] > 0} {
4555 set snbFile [open "${baseName}.snb" w]
4556 foreach location $snbLocations {
4557 puts $snbFile [expr "$location + $idxSize + $tossSize"]
4558 puts -nonewline $snbFile $savedSNB($location)
4563 # now update the toss and include the index file into the sdl file
4564 # by copying the old .sdl file to the new up to the location of
4565 # the first FORMSTYLE in the TOSS and emitting the new TOSS
4566 # entries then continue copying the old .sdl file up to the index
4567 # location and copying the .idx file to the new .sdl file followed
4568 # by the rest of the old .sdl file (the old .sdl and .idx files
4569 # have already been deleted from the directory), finally, close
4572 # 1: copy the sdl file up to the first FORMSTYLE element or, if
4573 # none, to just after the open tag for the TOSS
4574 set location $tossLocation
4576 while {$location > 0} {
4577 if {$location < $readSize} { set readSize $location }
4578 puts -nonewline $sdlOutFile [read $sdlInFile $readSize]
4579 incr location -$readSize
4581 # 2: emit the TOSS updates, if any
4582 puts -nonewline $sdlOutFile $toss
4583 # 3: copy the sdl file up to the index location
4584 set location [expr "$indexLocation - $tossLocation"]
4586 while {$location > 0} {
4587 if {$location < $readSize} { set readSize $location }
4588 puts -nonewline $sdlOutFile [read $sdlInFile $readSize]
4589 incr location -$readSize
4591 # 4: copy over the index file
4592 set location $idxSize
4594 while {$location > 0} {
4595 if {$location < $readSize} { set readSize $location }
4596 puts -nonewline $sdlOutFile [read $idxFile $readSize]
4597 incr location -$readSize
4599 # 5: and copy over the rest of the sdl file
4600 set location [expr "$sdlSize - $indexLocation"]
4602 while {$location > 0} {
4603 if {$location < $readSize} { set readSize $location }
4604 puts -nonewline $sdlOutFile [read $sdlInFile $readSize]
4605 incr location -$readSize
4607 # 6: close the output
4612 # read the global variable newTOSS and use the information to create
4613 # TOSS entries for THead, TBody and TFoot; these entries will contain
4614 # the justification and width information for the table sub-components;
4615 # return the new TOSS elements
4616 proc CreateTableTOSS {} {
4620 foreach ssi [array names newTOSS] {
4621 array set thisTOSSdata $newTOSS($ssi)
4622 set vAlign $thisTOSSdata(vAlign)
4626 TOP { set vJust "TOP" }
4627 MIDDLE { set vJust "CENTER" }
4628 BOTTOM { set vJust "BOTTOM" }
4631 append returnValue "<FORMSTYLE\n"
4632 append returnValue " CLASS=\"TABLE\"\n"
4633 append returnValue " SSI=\"$ssi\"\n"
4634 append returnValue \
4635 " PHRASE=\"TGroup, THead or TBody specification\"\n"
4636 append returnValue " COLW=\"$thisTOSSdata(colW)\"\n"
4637 append returnValue " COLJ=\"$thisTOSSdata(colJ)\"\n"
4639 append returnValue " VJUST=\"${vJust}-VJUST\"\n"
4641 append returnValue ">\n"
4648 # try to open a file named docbook.tss either in our current
4649 # directory or on TOSS_PATH - if it exists, copy it to
4650 # the output file as the TOSS - when the first line containing
4651 # "<FORMSTYLE" is seen, save the location so we can include the
4652 # updates to the TOSS necessary due to needing FORMSTYLE entries for
4653 # tables with the appropriate COLJ and COLW values
4654 proc IncludeTOSS {} {
4655 global tossLocation TOSS_PATH
4660 # look for docbook.tss in the current directory first, then on the path
4661 set path ". [split $TOSS_PATH :]"
4663 set tssFileName $dir/docbook.tss
4664 if {[file exists $tssFileName]} {
4671 if {[file readable $tssFileName]} {
4672 set tssFile [open $tssFileName r]
4673 set eof [gets $tssFile line]
4674 while {$eof != -1} {
4675 if {[string match "*<FORMSTYLE*" [string toupper $line]]} {
4676 set tossLocation [tell stdout]
4679 set eof [gets $tssFile line]
4683 UserError "$tssFileName exists but is not readable" no
4686 UserWarning "Could not find docbook.tss - continuing with null TOSS" no
4689 if {$tossLocation == -1} {
4690 set tossLocation [tell stdout]
4694 proc GetLocalizedAutoGeneratedStringArray {filename} {
4695 global localizedAutoGeneratedStringArray
4697 set buffer [ReadLocaleStrings $filename]
4699 set regExp {^(".*")[ ]*(".*")$} ;# look for 2 quoted strings
4701 set stringList [split $buffer \n]
4702 set listLength [llength $stringList]
4704 while {$listLength > 0} {
4705 set line [lindex $stringList $index]
4706 set line [string trim $line]
4707 if {([string length $line] > 0) && ([string index $line 0] != "#")} {
4708 if {[regexp $regExp $line match match1 match2]} {
4709 set match1 [string trim $match1 \"]
4710 set match2 [string trim $match2 \"]
4711 set localizedAutoGeneratedStringArray($match1) $match2
4714 "Malformed line in $filename line [expr $index + 1]" no
4721 set message "Home Topic"
4722 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4723 set localizedAutoGeneratedStringArray($message) $message
4725 set message "No home topic (PartIntro) was specified by the author."
4726 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4727 set localizedAutoGeneratedStringArray($message) $message
4730 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4731 set localizedAutoGeneratedStringArray($message) $message
4733 set message "See Also"
4734 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4735 set localizedAutoGeneratedStringArray($message) $message
4738 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4739 set localizedAutoGeneratedStringArray($message) $message
4741 set message "SYNOPSIS"
4742 if {![info exists localizedAutoGeneratedStringArray($message)]} {
4743 set localizedAutoGeneratedStringArray($message) $message
4748 # start - initialize variables and write the preamble
4749 proc OpenDocument {host base date} {
4750 global docId baseName indexLocation snbLocation
4751 global validMarkArray partIntroId nextId
4752 global NO_UNIQUE_ID LOCALE_STRING_DIR
4753 global language charset
4755 # NO_UNIQUE_ID will be set to YES for test purposes so we don't
4756 # get spurious mismatches from the timestamp of from the system on
4757 # which the document was processed.
4758 if {[string toupper $NO_UNIQUE_ID] == "YES"} {
4766 GetLocalizedAutoGeneratedStringArray ${LOCALE_STRING_DIR}/strings
4768 # split out the language and charset info from LOCALE_STRING_DIR
4769 # first, remove any directory information
4770 set languageAndCharset [lindex [split $LOCALE_STRING_DIR /] end]
4771 # then split the language and charset at the dot
4772 set languageAndCharset [split $languageAndCharset .]
4773 # and extract the values from the resulting list
4774 set language [lindex $languageAndCharset 0]
4775 set charset [lindex $languageAndCharset 1]
4779 # set up the validMarkArray values
4782 # if we have a PartIntro element, use its ID as the first-page
4783 # attribute - if no ID, assign one; if no PartIntro, assign an
4784 # ID and we'll dummy in a hometopic when we try to emit the first
4786 if {![info exists partIntroId]} {
4789 if {$partIntroId == ""} {
4790 # set partIntroId SDL-RESERVED[incr nextId]
4791 set partIntroId SDL-RESERVED-HOMETOPIC
4795 Emit "<SDLDOC PUB-ID=\"CDE 2.1\""
4796 Emit " DOC-ID=\"$docId\""
4797 Emit " LANGUAGE=\"$language\""
4798 Emit " CHARSET=\"$charset\""
4799 Emit " FIRST-PAGE=\"$partIntroId\""
4800 Emit " TIMESTMP=\"$timeStamp\""
4801 Emit " SDLDTD=\"1.1.1\">\n"
4803 # and create the VSTRUCT - the INDEX goes in it, the SNB goes after
4804 # it; if there's a Title later, it'll reset the SNB location;
4805 # we also need to read in docbook.tss (if any) and to create an
4806 # empty TOSS to cause the second pass to replace docbook.tss with
4807 # <src file name>.tss (if any) in the new .sdl file
4808 Emit "<VSTRUCT DOC-ID=\"$docId\">\n"
4809 Emit "<LOIDS>\n</LOIDS>\n<TOSS>\n"
4812 set indexLocation [tell stdout]
4814 set snbLocation [tell stdout]
4818 # done - write the index and close the document
4819 proc CloseDocument {} {
4820 global inVirpage errorCount warningCount
4821 global snbLocation savedSNB currentSNB
4823 # close any open block and the current VIRPAGE
4825 Emit $inVirpage; set inVirpage ""
4827 # if the last VIRPAGE in the document had any system notation
4828 # block references, we need to add them to the saved snb array
4829 # before writing it out
4830 set names [array names currentSNB]
4831 if {[llength $names] != 0} {
4832 foreach name $names {
4833 # split the name into the GI and xid of the SNB entry
4834 set colonLoc [string first "::" $name]
4835 set type [string range $name 0 [incr colonLoc -1]]
4836 set data [string range $name [incr colonLoc 3] end]
4839 append tempSNB "<$type ID=\"$currentSNB($name)\" "
4847 TEXTFILE { set command "XID" }
4848 SYS-CMD { set command "COMMAND" }
4849 CALLBACK { set command "DATA" }
4851 append tempSNB "$command=\"$data\">\n"
4853 set savedSNB($snbLocation) $tempSNB
4857 # close the document and write out the stored index and system
4863 if {$errorCount || $warningCount} {
4864 puts stderr "DtDocBook total user errors: $errorCount"
4865 puts stderr "DtDocBook total user warnings: $warningCount"
4868 if {$errorCount > 0} {
4872 if {$warningCount > 0} {