1 # tcllist2html.tcl --
2 #
3 # Read the intermedia file created by mashdoc.tcl and output a set
4 # of HTML documents.
5 #
6 # Copyright (c) 1996-2002 The Regents of the University of California.
7 # All rights reserved.
8 #
9 # Redistribution and use in source and binary forms, with or without
10 # modification, are permitted provided that the following conditions are met:
11 #
12 # A. Redistributions of source code must retain the above copyright notice,
13 # this list of conditions and the following disclaimer.
14 # B. Redistributions in binary form must reproduce the above copyright notice,
15 # this list of conditions and the following disclaimer in the documentation
16 # and/or other materials provided with the distribution.
17 # C. Neither the names of the copyright holders nor the names of its
18 # contributors may be used to endorse or promote products derived from this
19 # software without specific prior written permission.
20 #
21 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
22 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
25 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
27 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
29 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 #
32 # @(#)
33 #
34 # TODO
35 # Add comments!
36 #
37
38 # An implementation of queue using Tcl List
39 Class Queue
40 Queue instproc init {} {
41 $self set list_ {}
42 }
43 Queue instproc enq {item} {
44 $self instvar list_
45 lappend list_ $item
46 }
47 Queue instproc deq {} {
48 $self instvar list_
49 set begin [lindex $list_ 0]
50 set list_ [lreplace $list_ 0 0]
51 return $begin
52 }
53 Queue instproc is_empty {} {
54 $self instvar list_
55 if {$list_ == {}} {
56 return 1
57 } else {
58 return 0
59 }
60 }
61
62 # An implementation of stack using Tcl List
63 Class Stack
64 Stack instproc init {} {
65 $self set list_ {}
66 }
67 Stack instproc push {item} {
68 $self instvar list_
69 lappend list_ $item
70 }
71 Stack instproc pop {} {
72 $self instvar list_
73 set tail [lindex $list_ end]
74 set list_ [lreplace $list_ end end]
75 return $tail
76 }
77 Stack instproc is_empty {} {
78 $self instvar list_
79 if {$list_ == {}} {
80 return 1
81 } else {
82 return 0
83 }
84 }
85
86
87 #-------------------------------------------------------------------
88 # Class:
89 # HTMLGenerator
90 # Description:
91 # Responsible for HTML formatting. Its methods returns HTML
92 # strings.
93 #-------------------------------------------------------------------
94 Class HTMLGenerator
95
96
97 HTMLGenerator instproc page::begin {title} {
98 return "
99 <HTML><HEAD><TITLE>MashDoc: $title</TITLE>
100 <LINK REL='stylesheet' TYPE='text/css' HREF='mashdoc.css'>
101 </HEAD>
102 <BODY TOPMARGIN='' MARGINHEIGHT=''>
103 "
104 }
105 HTMLGenerator instproc page::end {} {
106 set curr_time [clock format [clock seconds]]
107 return "
108 <HR NOSHADE SIZE='1' COLOR='#000000' WIDTH='100%'>
109 <P><I>Generated on $curr_time</I></P>
110 </BODY>
111 </HTML>
112 "
113 }
114 HTMLGenerator instproc page::toc {} {
115 return "
116 <P>
117 <TABLE CELLSPACING='2' CELLPADDING='5'>
118 <TR>
119 <TD ROWSPAN='2'><A HREF='http://www.openmash.org'><IMG SRC='logo.gif' BORDER='' ALT='home'></A></TD>
120 <TD COLSPAN='3' BGCOLOR='#CCCCFF'><B>OpenMash Documentations</B></TD>
121 </TR>
122 <TD BGCOLOR='#CCCCFF'>
123 <SMALL><A HREF='cindex.html'> Class Index </A></SMALL>
124 </TD>
125 <TD BGCOLOR='#CCCCFF'>
126 <SMALL><A HREF='mindex.html'> Method Index </A></SMALL>
127 </TD>
128 <TD BGCOLOR='#CCCCFF'>
129 <SMALL><A HREF='chierarchy.html'> Class Hierarchy </A></SMALL>
130 </TD>
131 </TR>
132 </TABLE>"
133 }
134
135
136 HTMLGenerator instproc class::name {name type} {
137 if {$type == "CPP_CLASS"} {
138 return "
139 <P CLASS=\"CPPCTYPE\"> C++ CLASS </P>
140 <P CLASS=\"CPPCNAME\">$name </P>"
141 } elseif {$type == "OTCL_CLASS"} {
142 return "
143 <P CLASS=\"OTCLCTYPE\"> TCL CLASS </P>
144 <P CLASS=\"OTCLCNAME\">$name </P>"
145 }
146 }
147 HTMLGenerator instproc class::description {body} {
148 # regsub -all {\n} [string trim $body] <br> body
149 return "<P CLASS=\"CDESC\">$body</P>"
150 }
151
152
153 HTMLGenerator instproc member::begin {{type ""}} {
154 if {$type == "static"} {
155 return "<H2>STATIC MEMBERS</H2>"
156 } else {
157 return "<H2>MEMBERS</H2>"
158 }
159 }
160 HTMLGenerator instproc member::toc::begin {} {
161 return "<P CLASS='MEMBER_TOC'>"
162 }
163 HTMLGenerator instproc member::toc::name {name count} {
164 if {$count == 0} {
165 return "<A HREF='#$name'>$name</A>"
166 } else {
167 return ", <A HREF='#$name'>$name</A>"
168 }
169 }
170 HTMLGenerator instproc member::toc::end {} {
171 return "</P>"
172 }
173 HTMLGenerator instproc member::name {name} {
174 return "<P CLASS=\"MEMBER\"><A NAME='$name'>$name</A></P>"
175 }
176 HTMLGenerator instproc member::description {body} {
177 # regsub -all {\n} [string trim $body] <br> body
178 if {[string trim $body] == ""} {
179 return
180 }
181 return "<P CLASS=\"MDESC\">$body</P>"
182 }
183
184
185 HTMLGenerator instproc method::begin {} {
186 return "<H2>METHODS</H2>"
187 }
188 HTMLGenerator instproc method::name {n} {
189 return "<P CLASS=\"METHOD\"><A NAME='$n'>$n</A></P>"
190 }
191 HTMLGenerator instproc method::sig {n} {
192 return "
193 <P CLASS=\"SIGNATURE\">$n</P>"
194 }
195 HTMLGenerator instproc method::end {} {
196 }
197
198
199 HTMLGenerator instproc method::toc::begin {} {
200 return "<P CLASS='METHOD_TOC'>"
201 }
202 HTMLGenerator instproc method::toc::name {n} {
203 return "<A HREF='#$n'>$n</A>, "
204 }
205 HTMLGenerator instproc method::toc::end {} {
206 return "</P>"
207 }
208 HTMLGenerator instproc inherited_methods::begin {} {
209 return "<H2>INHERITED METHODS</H2><P CLASS='METHOD_LIST'>"
210 }
211 HTMLGenerator instproc inherited_methods::end {} {
212 return "</P>"
213 }
214 HTMLGenerator instproc inherited_members::begin {} {
215 return "<H2>INHERITED MEMBERS</H2><P CLASS='MEMBER_LIST'>"
216 }
217 HTMLGenerator instproc inherited_members::end {} {
218 return "</P>"
219 }
220
221
222 HTMLGenerator instproc argument {name desc} {
223 # regsub -all {\n} [string trim $desc] <br> desc
224 if {[string trim $desc] == ""} {
225 return "<P CLASS=\"ANAME\">$name</P>"
226 } else {
227 return "<P CLASS=\"ANAME\">$name</P><P CLASS=\"ADESC\">$desc</P>"
228 }
229 }
230
231
232 HTMLGenerator instproc class_link {c} {
233 set filename $c.html
234 regsub -all "/" $filename "-" filename
235 return "<A HREF=\"$filename\">$c</A>"
236 }
237
238
239 HTMLGenerator instproc hierarchy_class_link {level c} {
240 $self instvar curr_level_
241
242 if ![info exists curr_level_] {
243 set curr_level_ $level
244 }
245
246 set filename $c.html
247 regsub -all "/" $filename "-" filename
248
249 set str ""
250 if {$level > $curr_level_} {
251 # assert level == $curr_level + 1
252 append str "<UL CLASS='CLASS_HIERARCHY_LIST'>"
253 } elseif {$level < $curr_level_} {
254 for {set i 0} {$i < [expr $curr_level_ - $level]} {incr i} {
255 append str "</UL>"
256 }
257 }
258 set curr_level_ $level
259 return "
260 $str<P CLASS='CLASS_HIERARCHY_LIST'><A HREF=\"$filename\">$c</A></P>"
261 }
262
263
264 HTMLGenerator instproc method_link_by_class {classname methodname} {
265 set filename $classname.html
266 regsub -all "/" $filename "-" filename
267 return "
268 <A HREF=\"${filename}#${methodname}\">$classname</A>"
269 }
270
271
272 HTMLGenerator instproc method_link_by_method {classname methodname} {
273 set filename $classname.html
274 regsub -all "/" $filename "-" filename
275 return "
276 <A HREF=\"${filename}#${methodname}\">$methodname</A>"
277 }
278
279
280 HTMLGenerator instproc member_link_by_member {classname membername} {
281 set filename $classname.html
282 regsub -all "/" $filename "-" filename
283 return "
284 <A HREF=\"${filename}#${membername}\">$membername</A>"
285 }
286
287
288 HTMLGenerator instproc subclass {data} {
289 if {[string trim $data] == ""} {
290 return ""
291 }
292 set str "<H2>SUBCLASSES</H2><P CLASS=\"CLASS_LIST\">"
293 set first [lindex $data 0]
294 set rest [lrange $data 1 end]
295 append str "[$self class_link $first]"
296 foreach c $rest {
297 append str ", [$self class_link $c]"
298 }
299 append str "</P>"
300 return $str
301 }
302
303
304 HTMLGenerator instproc superclass {data} {
305 if {[string trim $data] == ""} {
306 return ""
307 }
308 set str "<H2>SUPERCLASSES</H2><P CLASS=\"CLASS_LIST\">"
309 set first [lindex $data 0]
310 set rest [lrange $data 1 end]
311 append str "[$self class_link $first]"
312 foreach c $rest {
313 append str ", [$self class_link $c]"
314 }
315 append str "</P>"
316 return $str
317 }
318
319
320 HTMLGenerator instproc filename {data} {
321 if {[string trim $data] == ""} {
322 return ""
323 }
324 if {[string match /vid0/www/openmash/* $data]} {
325 # HACK: We are generating this from BMRC web site.
326 # Replace filename with a link to LXR source.
327 # 012345678901234567890123456789012345678901234
328 # /vid0/www/openmash/lxr/source/mash-code/mash/
329 set url [string replace $data 0 44 http://www.openmash.org/lxr/source/]
330 set name [string replace $data 0 44 ""]
331 return "<H2>FILENAME</H2><P CLASS=\"FILENAME\"><A HREF=\"$url\">$name</A></P>"
332 } else {
333 return "<H2>FILENAME</H2><P CLASS=\"FILENAME\">$data</P>"
334 }
335 }
336
337
338 HTMLGenerator instproc shadow {data} {
339 if {[string trim $data] == ""} {
340 return ""
341 }
342 set str "<H2>SHADOW CLASS</H2><P CLASS=\"CLASS_LIST\">"
343 foreach c $data {
344 append str [$self class_link $c]
345 }
346 append str "</P>"
347 return $str
348 }
349
350
351 HTMLGenerator instproc seealso {data} {
352 if {[string trim $data] == ""} {
353 return ""
354 }
355 set str "<H2>SEE ALSO</H2><P CLASS=\"CLASS_LIST\">"
356 set data [split $data ", "]
357 set first [lindex $data 0]
358 append str $first
359 set rest [lrange $data 1 end]
360 foreach c $rest {
361 if {$c != ""} {
362 append str ", [$self class_link $c]"
363 }
364 }
365 append str "</P>"
366 return $str
367 }
368
369
370 HTMLGenerator instproc mindex::begin {} {
371 return "<H1>Mash Method Index</H1>"
372 }
373
374
375 HTMLGenerator instproc mindex::toc {letterlist} {
376 set str ""
377 foreach l $letterlist {
378 if [string is upper $l] {
379 append str " <A HREF=\"#u$l\">$l</A> |"
380 } else {
381 append str " <A HREF=\"#l$l\">$l</A> |"
382 }
383 }
384 return $str
385 }
386
387
388 HTMLGenerator instproc mindex::section::begin {letter} {
389 $self instvar count_
390 set count_ 0
391 if {[string is upper $letter]} {
392 return "
393 <H2><A NAME=\"u$letter\">$letter</A></H2>
394 <TABLE WIDTH=\"100%\"><TR>
395 "
396 } else {
397 return "
398 <H2><A NAME=\"l$letter\">$letter</A></H2>
399 <TABLE WIDTH=\"100%\"><TR>
400 "
401 }
402 }
403 HTMLGenerator instproc mindex::section::body {methodname classlist} {
404 $self instvar count_ num_of_column_
405 set str ""
406 # Change NUMBER OF COLUMN here.
407 set num_of_column_ 1
408 if {$count_ % $num_of_column_ == 0} {
409 set str "</TR><TR>"
410 }
411 incr count_
412 append str "<TD WIDTH=\"80%\">"
413 append str "<P>$methodname</P><P class='CLASS_LIST'>"
414 foreach classname $classlist {
415 append str "[$self method_link_by_class $classname $methodname]"
416 }
417 append str "</P>"
418 return $str
419 }
420 HTMLGenerator instproc mindex::section::end {} {
421 $self instvar count_ num_of_column_
422
423 # Pad with empty columns to make sure it is multiple of
424 # number of column
425 set str ""
426 while {$count_ % $num_of_column_ != 0} {
427 incr count_
428 append str "<TD></TD>"
429 }
430 append str "</TR></TABLE>"
431 return $str
432 }
433
434
435 HTMLGenerator instproc cindex::begin {} {
436 return "<H1>Mash Class Index</H1>"
437 }
438 HTMLGenerator instproc chierarchy_title {} {
439 return "<H1>Mash Class Hierarchy</H1>"
440 }
441 HTMLGenerator instproc cindex::toc {letterlist} {
442 set str ""
443 foreach l $letterlist {
444 if [string is upper $l] {
445 append str " <A HREF=\"#u$l\">$l</A> |"
446 } else {
447 append str " <A HREF=\"#l$l\">$l</A> |"
448 }
449 }
450 return $str
451 }
452 HTMLGenerator instproc cindex::section::begin {letter} {
453 $self instvar count_
454 set count_ 0
455 if {[string is upper $letter]} {
456 return "
457 <H2><A NAME=\"u$letter\">$letter</A></H2>
458 <TABLE WIDTH=\"100%\"><TR>
459 "
460 } else {
461 return "
462 <H2><A NAME=\"l$letter\">$letter</A></H2>
463 <TABLE WIDTH=\"100%\"><TR>
464 "
465 }
466 }
467 HTMLGenerator instproc cindex::section::body {classname} {
468 $self instvar count_ num_of_column_
469 set str ""
470 # Change NUMBER OF COLUMN here.
471 set num_of_column_ 3
472 if {$count_ % $num_of_column_ == 0} {
473 set str "</TR><TR>"
474 }
475 incr count_
476 append str "<TD WIDTH=\"33%\">[$self class_link $classname]</TD>"
477 return $str
478 }
479 HTMLGenerator instproc cindex::section::end {} {
480 $self instvar count_ num_of_column_
481
482 # Pad with empty columns to make sure it is multiple of
483 # number of column
484 set str ""
485 while {$count_ % $num_of_column_ != 0} {
486 incr count_
487 append str "<TD></TD>"
488 }
489 append str "</TR></TABLE>"
490 return $str
491 }
492
493
494 Class DocGenerator
495 DocGenerator instproc find_name {attrlist} {
496 # find name from attrlist
497 foreach {key value} $attrlist {
498 if {$key == "NAME"} {
499 return $value
500 }
501 }
502 }
503
504 DocGenerator instproc find_type {attrlist} {
505 # find name from attrlist
506 foreach {key value} $attrlist {
507 if {$key == "TYPE"} {
508 return $value
509 }
510 }
511 }
512
513 DocGenerator instproc build_index {attrlist content} {
514 $self instvar master_class_list_
515 $self instvar class_by_method_
516 $self instvar method_by_class_
517 $self instvar member_by_class_
518 $self instvar superclass_by_class_
519 $self instvar subclass_by_class_
520 $self instvar class_by_first_char_
521 $self instvar method_by_first_char_
522
523 # find name from attrlist
524 set classname [$self find_name $attrlist]
525
526 # remember classname so that we can generate index later
527 set c [string index $classname 0]
528 if [info exists class_by_first_char_($c)] {
529 lappend class_by_first_char_($c) $classname
530 } else {
531 set class_by_first_char_($c) $classname
532 }
533 lappend master_class_list_ $classname
534
535 # just in case some class has no method/member
536 set method_by_class_($classname) {}
537 set member_by_class_($classname) {}
538
539 foreach {element attrlist body} $content {
540 switch $element {
541 MEMBERS -
542 STATIC_MEMBERS {
543 foreach {member_element member_attrlist member_body} $body {
544 if {$member_element == "ITEM"} {
545 lappend member_by_class_($classname) $member_body
546 }
547 }
548 }
549 METHOD -
550 STATIC_METHOD {
551 set signatures [$self find_name $attrlist]
552 # signatures is a list of signature.
553 foreach signature $signatures {
554 set signature [lindex $signature 0]
555 set classname [lindex $signature 0]
556 set methodname [lindex $signature 2]
557 lappend class_by_method_($methodname) $classname
558 lappend method_by_class_($classname) $methodname
559 set c [string index $methodname 0]
560 if [info exists method_by_first_char_($c)] {
561 if {[lsearch $method_by_first_char_($c) $methodname] == -1} {
562 lappend method_by_first_char_($c) $methodname
563 }
564 } else {
565 set method_by_first_char_($c) $methodname
566 }
567 }
568 }
569 SUPERCLASS {
570 set superclass_by_class_($classname) $body
571 }
572 SUBCLASS {
573 set subclass_by_class_($classname) $body
574 }
575 }
576 }
577 }
578
579 Class DocGenerator/HTML -superclass DocGenerator
580
581 DocGenerator/HTML instproc init {dir} {
582 $self instvar html_gen output_dir
583 set html_gen [new HTMLGenerator]
584 set output_dir $dir
585
586 # Make sure $output_dir exists and is really a directory.
587 # If $output_dir is not a dir, error. If it does not exists,
588 # create it.
589 if {[catch {file mkdir $output_dir} err]} {
590 error "unable to create directory $output_dir"
591 }
592 }
593
594 DocGenerator/HTML instproc gen_member_toc {attrlist content {type ""}} {
595 $self instvar html_gen
596 if {[string trim $content] == ""} {
597 return ""
598 }
599 set str [$html_gen member::toc::begin]
600 set count 0
601 foreach {item alist name desc alist body } $content {
602 append str [$html_gen member::toc::name $name $count]
603 incr count
604 }
605 append str [$html_gen member::toc::end]
606 return $str
607 }
608
609 DocGenerator/HTML instproc gen_members {attrlist content {type ""}} {
610 $self instvar html_gen
611 set str ""
612 foreach {item alist name desc alist body } $content {
613 append str [$html_gen member::name $name]
614 append str [$html_gen member::description $body]
615 }
616 return $str
617 }
618
619 # Return an entry in the method TOC
620 DocGenerator/HTML instproc gen_method_toc {attrlist content} {
621 $self instvar html_gen
622
623 set signatures [$self find_name $attrlist]
624
625 # signatures is a list of signature.
626 set str ""
627 foreach signature $signatures {
628 set signature [lindex $signature 0]
629 set methodname [lindex $signature 2]
630 append str [$html_gen method::toc::name $methodname]
631 }
632 return $str
633 }
634
635 DocGenerator/HTML instproc gen_method {attrlist content} {
636 $self instvar html_gen
637
638 set signatures [$self find_name $attrlist]
639
640 # signatures is a list of signature.
641 set mnamestr ""
642 set msigstr ""
643 foreach signature $signatures {
644 set signature [lindex $signature 0]
645 set classname [lindex $signature 0]
646 set methodtype [lindex $signature 1]
647 set methodname [lindex $signature 2]
648 append mnamestr [$html_gen method::name $methodname]
649 append msigstr [$html_gen method::sig $signature]
650 }
651 append str "$mnamestr $msigstr"
652 set arg ""
653 set desc ""
654 foreach {element alist body} $content {
655 if {$element == "DESCRIPTION"} {
656 set desc $body
657 } elseif {$element == "ARGUMENTS"} {
658 set arg $body
659 }
660 }
661 append str [$html_gen member::description $desc]
662 foreach {item alist iname desc alist dbody} $arg {
663 append str [$html_gen argument $iname $dbody]
664 }
665 append str [$html_gen method::end]
666
667 return $str
668 }
669
670 DocGenerator/HTML instproc write_class_hierarchy {} {
671 $self instvar html_gen output_dir
672 $self instvar class_by_first_char_
673 $self instvar subclass_by_class_
674 $self instvar superclass_by_class_
675 $self instvar master_class_list_
676
677 # Open index file
678 if {[catch {open "$output_dir/chierarchy.html" w} f]} {
679 puts "WARNING: Unable to open chierarchy.html for writing"
680 return
681 }
682 puts $f [$html_gen page::begin "Class Hierarchy"]
683 puts $f [$html_gen page::toc]
684 puts $f [$html_gen chierarchy_title]
685
686 set class_stack [new Stack]
687 set level_stack [new Stack]
688
689 # Iterate through all classes
690 set letters [array names class_by_first_char_]
691 set level 0
692 foreach c [lsort -decreasing $master_class_list_] {
693 if {![info exists superclass_by_class_($c)] ||
694 $superclass_by_class_($c) == ""} {
695 # No superclass
696 $class_stack push $c
697 $level_stack push 1
698 continue
699 }
700
701 # if the class has some superclasses, that has not been commented
702 # and not found in the tcl files (maybe they are defined in C++),
703 # add them as well.
704 set found 0
705 foreach supc $superclass_by_class_($c) {
706 if {[lsearch $master_class_list_ $supc] != -1} {
707 # found in class list, move on to next c.
708 set found 1
709 break
710 }
711 }
712 if {$found == 0} {
713 # Every superclass is "undiscovered"
714 $class_stack push $c
715 $level_stack push 1
716 }
717 }
718
719 while {![$class_stack is_empty]} {
720 set c [$class_stack pop]
721 set level [$level_stack pop]
722 puts $f [$html_gen hierarchy_class_link $level $c]
723 if {[info exists subclass_by_class_($c)] &&
724 $subclass_by_class_($c) != ""} {
725 incr level
726 foreach subc [lsort -decreasing $subclass_by_class_($c)] {
727 $class_stack push $subc
728 $level_stack push $level
729 }
730 }
731 }
732
733 puts $f [$html_gen page::end]
734 }
735
736 DocGenerator/HTML instproc write_class_index {} {
737 $self instvar html_gen output_dir
738
739 # Open index file
740 if {[catch {open "$output_dir/cindex.html" w} f]} {
741 puts "WARNING: Unable to open cindex.html for writing"
742 return
743 }
744 puts $f [$html_gen page::begin "Index to Classes"]
745 puts $f [$html_gen page::toc]
746 puts $f [$html_gen cindex::begin]
747
748 $self instvar class_by_first_char_
749 set letters [lsort [array names class_by_first_char_]]
750 puts $f [$html_gen cindex::toc $letters]
751
752 foreach l $letters {
753 puts $f [$html_gen cindex::section::begin $l]
754 foreach n $class_by_first_char_($l) {
755 puts $f [$html_gen cindex::section::body $n]
756 }
757 puts $f [$html_gen cindex::section::end]
758 }
759 puts $f [$html_gen page::end]
760 }
761
762 DocGenerator/HTML instproc write_method_index {} {
763 $self instvar html_gen output_dir
764
765 # Open index file
766 if {[catch {open "$output_dir/mindex.html" w} f]} {
767 puts "WARNING: Unable to open mindex.html for writing"
768 return
769 }
770 puts $f [$html_gen page::begin "Index to Methods"]
771 puts $f [$html_gen page::toc]
772 puts $f [$html_gen mindex::begin]
773
774 $self instvar method_by_first_char_
775 $self instvar class_by_method_
776
777 set letters [lsort [array names method_by_first_char_]]
778 puts $f [$html_gen mindex::toc $letters]
779
780 foreach l $letters {
781 puts $f [$html_gen mindex::section::begin $l]
782 foreach n [lsort $method_by_first_char_($l)] {
783 # don't output constructor and destructor
784 if {$n != "init" && $n != "destroy"} {
785 puts $f [$html_gen mindex::section::body $n $class_by_method_($n)]
786 }
787 }
788 puts $f [$html_gen mindex::section::end]
789 }
790 puts $f [$html_gen page::end]
791 }
792
793 DocGenerator/HTML instproc gen_inherited_members {classname} {
794 $self instvar html_gen
795 $self instvar superclass_by_class_ member_by_class_
796
797 set str ""
798
799 # The code below is just classic BFS on tree
800 set q [new Queue]
801 foreach superclass $superclass_by_class_($classname) {
802 $q enq $superclass
803 }
804
805 # Set all defined member in current class as found
806 foreach member $member_by_class_($classname) {
807 set found_member($member) 1
808 }
809 while {![$q is_empty]} {
810 set superclass [$q deq]
811
812 # make sure we visit a class exactly one. Just in case we have
813 # A inherit from B and C, B and C both inherit from D.
814 if [info exists found_class($superclass)] {
815 continue
816 }
817
818 # some classes are not found while parsing tcl file.
819 if ![info exists member_by_class_($superclass)] {
820 continue
821 }
822
823 set found_class($superclass) 1
824
825 # foreach member in the superclass, if we haven't seen it before,
826 # generate a link.
827 foreach member $member_by_class_($superclass) {
828 if {![info exists found_member($member)]} {
829 set found_member($member) 1
830 append str "[$html_gen member_link_by_member $superclass $member], "
831 }
832 }
833 foreach supersuperclass $superclass_by_class_($superclass) {
834 $q enq $supersuperclass
835 }
836 }
837
838 # Add a beginer and properly format the string only if it is not empty
839 set str [string trim $str]
840 if {$str != ""} {
841 set len [string length $str]
842 set str [string range $str 0 [expr {$len - 2}]]
843 set str "[$html_gen inherited_members::begin] $str
844 [$html_gen inherited_members::end]"
845 }
846 delete $q
847 return $str
848 }
849
850 DocGenerator/HTML instproc gen_inherited_methods {classname} {
851 $self instvar html_gen
852 $self instvar superclass_by_class_ method_by_class_
853
854 set str ""
855
856 # The code below is just classic BFS on tree
857 set q [new Queue]
858 foreach superclass $superclass_by_class_($classname) {
859 $q enq $superclass
860 }
861
862 # Set all defined method in current class as found
863 foreach method $method_by_class_($classname) {
864 set found_method($method) 1
865 }
866 while {![$q is_empty]} {
867 set superclass [$q deq]
868
869 # make sure we visit a class exactly one. Just in case we have
870 # A inherit from B and C, B and C both inherit from D.
871 if [info exists found_class($superclass)] {
872 continue
873 }
874
875 # some classes are not found while parsing tcl file.
876 if ![info exists method_by_class_($superclass)] {
877 continue
878 }
879
880 set found_class($superclass) 1
881
882 # foreach method in the superclass, if we haven't seen it before,
883 # generate a link.
884 foreach method $method_by_class_($superclass) {
885 if {![info exists found_method($method)]} {
886 set found_method($method) 1
887 append str "[$html_gen method_link_by_method $superclass $method], "
888 }
889 }
890 foreach supersuperclass $superclass_by_class_($superclass) {
891 $q enq $supersuperclass
892 }
893 }
894
895 # Add a beginer and properly format the string only if it is not empty
896 set str [string trim $str]
897 if {$str != ""} {
898 set len [expr {[string length $str] - 2}]
899 set str [string range $str 0 $len]
900 set str "
901 [$html_gen inherited_methods::begin] $str
902 [$html_gen inherited_methods::end]"
903 }
904 delete $q
905 return $str
906 }
907
908 DocGenerator/HTML instproc write_class_doc {attrlist content} {
909 $self instvar html_gen output_dir
910
911 # Find name from attrlist
912 set classname [$self find_name $attrlist]
913 set classtype [$self find_type $attrlist]
914
915 puts "Generating $classname"
916
917 # Open file for output
918 regsub -all "/" $classname "-" filename
919 if {[catch {open $output_dir/$filename.html w} f]} {
920 puts "WARNING: unable to open $filename.html for writing."
921 return
922 }
923
924 # Initialize output strings. We want to maintin some order in
925 # the output file, which is why we keep them in strings first.
926 set class_description ""
927 set static_members ""
928 set members ""
929 set member_toc ""
930 set methods ""
931 set method_toc ""
932 set sup ""
933 set sub ""
934 set oth ""
935 set filename ""
936 set seealso ""
937 set shadow ""
938
939 foreach {element attrlist body} $content {
940 switch $element {
941 DESCRIPTION {
942 append class_description [$html_gen class::description $body]
943 }
944 STATIC_MEMBERS {
945 append static_members [$self gen_members $attrlist $body "static"]
946 }
947 MEMBERS {
948 append member_toc [$self gen_member_toc $attrlist $body]
949 append members [$self gen_members $attrlist $body]
950 }
951 METHOD {
952 append method_toc [$self gen_method_toc $attrlist $body]
953 append methods [$self gen_method $attrlist $body]
954 }
955 SUPERCLASS {
956 append sup [$html_gen superclass $body]
957 }
958 SUBCLASS {
959 append sub [$html_gen subclass $body]
960 }
961 FILENAME {
962 append filename [$html_gen filename $body]
963 }
964 SHADOW_CLASS {
965 append shadow [$html_gen shadow $body]
966 }
967 SEE_ALSO {
968 append seealso [$html_gen seealso $body]
969 }
970 default {
971 if {[string trim $body] != ""} {
972 append oth {<FONT COLOR="RED"<H2>}
973 append oth $element
974 append oth {</H2>}
975 append oth {<P CLASS="DESC">}
976 append oth $body
977 append oth {</P></FONT>}
978 }
979 }
980 }
981 }
982
983 if {$members != ""} {
984 set members "[$html_gen member::begin] $member_toc $members"
985 }
986 if {$static_members != ""} {
987 set static_members "[$html_gen member::begin static] $static_members"
988 }
989 if {$methods != ""} {
990 set method_toc [string trim $method_toc]
991 if {$method_toc != ""} {
992 set m [string length $method_toc]
993 set n [expr {$m - 2}]
994 set method_toc [string range $method_toc 0 $n]
995 set method_toc "[$html_gen method::toc::begin] $method_toc [$html_gen method::toc::end]"
996 }
997 set methods "[$html_gen method::begin] $method_toc $methods"
998 }
999
1000 puts $f [$html_gen page::begin $classname]
1001 puts $f [$html_gen page::toc]
1002 puts $f [$html_gen class::name $classname $classtype]
1003 puts $f "$class_description $shadow $sup $sub"
1004 puts $f "$static_members $members $methods"
1005 puts $f [$self gen_inherited_methods $classname]
1006 puts $f [$self gen_inherited_members $classname]
1007 puts $f "$filename $seealso $oth"
1008 puts $f [$html_gen page::end]
1009 close $f
1010 }
1011
1012 Class TclListToHtml
1013 TclListToHtml instproc init { argv } {
1014
1015 set output_dir "."
1016 foreach {key value} $argv {
1017 if {$value == ""} {
1018 # No value specified. Assume end of list. $key must be
1019 # filename.
1020 set filename $key
1021 } else {
1022 switch -exact -- $key {
1023 -o {
1024 set output_dir $value
1025 }
1026 default {
1027 puts "unknown option $key. Supported option is -o"
1028 }
1029 }
1030 }
1031 }
1032
1033 set f [open $filename r]
1034 set list [read $f]
1035
1036 # check for format error
1037 if {[lindex $list 0] != "MASHDOC"} {
1038 puts "Keyword MASHDOC not found."
1039 }
1040
1041 # We make two pass through the list. First, we build indexes
1042 # to superclass, subclass, and methods. Second, we really
1043 # generate the HTML files.
1044
1045 set docgen [new DocGenerator/HTML $output_dir]
1046 foreach {class attrlist content} [lindex $list 2] {
1047 if {$class != "CLASS"} {
1048 puts "Expecting CLASS but found $class. Malformed input."
1049 } else {
1050 $docgen build_index $attrlist $content
1051 }
1052 }
1053 $docgen write_class_index
1054 $docgen write_class_hierarchy
1055 $docgen write_method_index
1056 foreach {class attrlist content} [lindex $list 2] {
1057 if {$class != "CLASS"} {
1058 puts "Expecting CLASS but found $class. Malformed input."
1059 } else {
1060 $docgen write_class_doc $attrlist $content
1061 }
1062 }
1063
1064 puts "Done"
1065 }
1066 new TclListToHtml $argv
1067
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.