1 # mashdoc.tcl --
2 #
3 # Reads mashdoc documentation block from Tcl and C/C++ files and output
4 # to an intermediate structured file (as both XML and Tcl List).
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 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/mashdoc/mashdoc.tcl,v 1.5 2002/03/04 22:27:13 weitsang Exp $
33
34 # TODO:
35 # - Handle more tags, such as "Procedure:" "Application:"
36 # - Clean up code.
37
38 #-------------------------------------------------------------------------
39 # Class:
40 # Syntax
41 # Description:
42 # This is the base class for syntax checking.
43 # Members:
44 # keyword_list_ -- a list of keywords we recorgnize as headers in
45 # a documentation block.
46 #-------------------------------------------------------------------------
47 Class Syntax
48
49
50 #-------------------------------------------------------------------------
51 # Method:
52 # Syntax init
53 # Description:
54 # Initialize the keyword list.
55 #-------------------------------------------------------------------------
56 Syntax instproc init { } {
57 $self instvar keyword_list_
58 set keyword_list_ {
59 {Application}
60 {OTcl Class}
61 {C++ Class}
62 {Shadow Class}
63 {Class}
64 {Procedure}
65 {Function}
66 {Members}
67 {Method}
68 {Arguments}
69 {Procedure}
70 {Description}
71 {Static Method}
72 {Static Members}
73 {See Also}
74 {Precond}
75 {Postcond}
76 {Side Effects}
77 {Results}
78 {Superclass}
79 }
80 $self set state_ "normal"
81 }
82
83
84 #-------------------------------------------------------------------------
85 # Method:
86 # Syntax is_heading
87 # Arguments:
88 # item -- a word to check
89 # Description:
90 # Return 1 if $item is a keyword, 0 otherwise
91 #-------------------------------------------------------------------------
92 Syntax instproc is_heading { item } {
93 $self instvar keyword_list_
94 if {[lsearch $keyword_list_ $item] != -1} {
95 return 1
96 } else {
97 return 0
98 }
99 }
100
101 #-------------------------------------------------------------------------
102 # Class:
103 # OTclSyntax
104 # Description:
105 # This class is responsible for defining syntax for documentation
106 # blocks in Tcl/OTcl files. (Actually, any language that takes
107 # "#" as comments character.)
108 #
109 # This is the syntax of the documentation :-
110 #
111 # A documentation block must begin with, and should end with
112 # a "separator". Possible separators are #----... and ######...
113 #
114 # Each line between the separator must begin with a #, and can
115 # be one of these items
116 # - heading
117 # A heading is a line that contains one or more words, all caps.
118 # (_ and - are OK)
119 # - subheading
120 # A subheading is a line that contains a "-" followed by a single
121 # word.
122 # - free text
123 # lines that is not heading and subheading. (can be all spaces)
124 #
125 # One of the heading must contains either "Class:", "Method:",
126 # "Static Method:", "Procedure:" (not supported yet) for it to be useful.
127 #-------------------------------------------------------------------------
128 Class OTclSyntax -superclass Syntax
129
130 #-------------------------------------------------------------------------
131 # Static Method:
132 # OTclSyntax get_line_type
133 # Description:
134 # Given a line, do some regular expression matching to see what kind
135 # of line is this.
136 #-------------------------------------------------------------------------
137 OTclSyntax instproc get_line_type { line } {
138 $self instvar state_
139
140 if {$state_ == "normal"} {
141 if {[regexp "^#-+$" $line] || [regexp "^##+$" $line]} {
142 set state_ "doc"
143 return "SEPARATOR"
144 } elseif {[regexp {^[ \t]*#.*$} $line]} {
145 return "COMMENT"
146 } else {
147 return "NOTCOMMENT"
148 }
149 } else {
150 if {[regexp "^#-+$" $line] || [regexp "^##+$" $line]} {
151 set state_ "normal"
152 return "SEPARATOR"
153 } elseif {[regexp {^#[ \t]*([A-Za-z+ ]+):[ \t]*$} $line wholeline item]} {
154 if {[$self is_heading "$item"]} {
155 return "HEADING [list $item]"
156 } else {
157 return "TEXT [list $item]"
158 }
159 } elseif {[regexp {^#[ \t]*([^ ]+)[ \t]*--(.*)$} $line wholeline item text]} {
160 return "SUBHEADING [list $item $text]"
161 } elseif {[regexp {^[ \t]*#(.*)$} $line wholeline item]} {
162 return "TEXT [list $item]"
163 } else {
164 set state_ "normal"
165 return "NOTCOMMENT"
166 }
167 }
168 }
169
170
171 OTclSyntax instproc init { } {
172 $self next
173
174 $self instvar normalize_table_
175 set normalize_table_(CLASS) "OTCL_CLASS"
176 }
177
178
179 #-------------------------------------------------------------------------
180 # Method:
181 # Syntax normalize_keyword
182 # Description:
183 # If different language requires different syntax for docblock, we
184 # normalize them here. The subclass must define the normalize_table_.
185 #-------------------------------------------------------------------------
186 Syntax instproc normalize_keyword { keyword } {
187 $self instvar normalize_table_
188 regsub -all " " $keyword "_" keyword
189 set keyword [string toupper $keyword]
190 if ![info exists normalize_table_($keyword)] {
191 return $keyword
192 } else {
193 return $normalize_table_($keyword)
194 }
195 }
196
197
198 #-------------------------------------------------------------------------
199 # Class:
200 # CppSyntax
201 # Description:
202 # This class is similar to OtclSyntax, except that we are looking for
203 # lines matching C++ syntax.
204 #-------------------------------------------------------------------------
205 Class CppSyntax -superclass Syntax
206
207 CppSyntax instproc init { } {
208 $self next
209
210 $self instvar normalize_table_
211 set normalize_table_(CLASS) "CPP_CLASS"
212 set normalize_table_(C++_CLASS) "CPP_CLASS"
213 }
214
215 #-------------------------------------------------------------------------
216 # Static Method:
217 # CppSyntax get_line_type
218 #
219 # Description:
220 # Given a line, do some regular expression matching to see what kind
221 # of line is this.
222 #-------------------------------------------------------------------------
223 CppSyntax instproc get_line_type { line } {
224 $self instvar state_
225 if {$state_ == "normal"} {
226 if {[regexp {^//-+$} $line] || [regexp {^[ \t]*/\*[\*-]+$} $line]} {
227 set state_ "doc"
228 return "SEPARATOR"
229 } else {
230 return "NOTCOMMENT"
231 }
232 } else {
233 if {[regexp {^//-+$} $line] || [regexp {^[ \t]*[\*-]*\*/[ \t]*$} $line]} {
234 set state_ "normal"
235 return "SEPARATOR"
236 } elseif {[regexp {^//[ \t]*([A-Za-z+ ]+):[ \t]*$} $line wholeline item] ||
237 [regexp {^[ \t]*\*[ \t]*([A-Za-z+ ]+):[ \t]*$} $line wholeline item]} {
238 if {[$self is_heading "$item"]} {
239 return "HEADING [list $item]"
240 } else {
241 return "TEXT [list $item]"
242 }
243 } elseif {[regexp {^//[ \t]*([^ ]+)[ \t]*--(.*)$} $line wholeline item text] ||
244 [regexp {^[ \t]*\*[ \t]*([^ ]+)[ \t]*--(.*)$} $line wholeline item text]} {
245 return "SUBHEADING [list $item $text]"
246 } elseif {([regexp {^[\t]*//(.*)$} $line wholeline item] ||
247 [regexp {^[ \t]*\*(.*)$} $line wholeline item])} {
248 return "TEXT [list $item]"
249 } else {
250 set state_ "normal"
251 return "NOTCOMMENT"
252 }
253 }
254 }
255
256
257 #-------------------------------------------------------------------------
258 # Class:
259 # MashDocInfo
260 # Description:
261 # This is where information parsed from documentation blocks and
262 # code are stored.
263 # Members:
264 # a -- The array for storing general class/methods information
265 # sup -- sup($class) is a list of superclass of $class
266 # sub -- sub($class) is a list of subclass of $class
267 #-------------------------------------------------------------------------
268 Class MashDocInfo
269
270 MashDocInfo instproc init {} {
271 $self instvar id_
272 set id_ 1
273 }
274 MashDocInfo instproc next_id {} {
275 $self instvar id_
276 return [incr id_]
277 }
278
279
280
281 #-------------------------------------------------------------------------
282 # Method:
283 # MashDocInfo get_all_class_ids
284 # Description:
285 # Return a list of docblock ids of type classes.
286 # Arguments:
287 # type -- By default, all type of classes will be returned.
288 # However, you can pass a list of class type which you are
289 # interested in.
290 #-------------------------------------------------------------------------
291 MashDocInfo instproc get_all_class_ids {{type ""}} {
292 if {$type == ""} {
293 set type {OTCL_CLASS CPP_CLASS}
294 }
295 set ids ""
296 foreach class_type $type {
297 foreach key [$self names *,$class_type,*] {
298 set id [lindex [split $key ","] 0]
299 lappend ids $id
300 }
301 }
302 return $ids
303 }
304
305
306 #-------------------------------------------------------------------------
307 # Method:
308 # MashDocInfo get_class_name
309 # Description:
310 # Return the class name that corresponds to the ID.
311 #-------------------------------------------------------------------------
312 MashDocInfo instproc get_class_name {id} {
313 $self instvar a_
314 if [info exists a_($id,OTCL_CLASS,)] {
315 return [string trim $a_($id,OTCL_CLASS,)]
316 } elseif [info exists a_($id,CPP_CLASS,)] {
317 return [string trim $a_($id,CPP_CLASS,)]
318 } else {
319 return ""
320 }
321 }
322 MashDocInfo instproc get_headings {id} {
323 $self instvar a_
324 set result [array names a_ $id,*,*]
325 set headings ""
326 foreach r $result {
327 lappend headings [lindex [split $r ","] 1]
328 }
329 set headings [lsort -unique $headings]
330 set p1 [lsearch $headings OTCL_CLASS]
331 set p2 [lsearch $headings CPP_CLASS]
332 if {$p1 != -1} {
333 set headings [lreplace $headings $p1 $p1]
334 }
335 if {$p2 != -1} {
336 set headings [lreplace $headings $p2 $p2]
337 }
338 return $headings
339 }
340
341
342 MashDocInfo instproc get_subheadings {id head} {
343 $self instvar a_
344 set result [array names a_ $id,$head,*]
345 set subheadings ""
346 foreach r $result {
347 lappend subheadings [lindex [split $r ","] 2]
348 }
349 return $subheadings
350 }
351
352
353 #-------------------------------------------------------------------------
354 # Method:
355 # MashDocInfo add_superclass
356 # MashDocInfo get_superclass
357 # Description:
358 # add_superclass adds $superclass to the list of superclasses for $subclass,
359 # while get_superclass retreives the list of superclasses given $subclass.
360 #-------------------------------------------------------------------------
361 MashDocInfo instproc add_superclass {subclass superclass} {
362 $self instvar sup_
363 if ![info exists sup_($subclass)] {
364 set sup_($subclass) "$superclass"
365 } else {
366 if {[lsearch $sup_($subclass) $superclass] == -1} {
367 append sup_($subclass) " $superclass"
368 }
369 }
370 }
371 MashDocInfo instproc get_superclass {subclass} {
372 $self instvar sup_
373 if ![info exists sup_($subclass)] {
374 return ""
375 } else {
376 return $sup_($subclass)
377 }
378 }
379
380
381 #-------------------------------------------------------------------------
382 # Method:
383 # MashDocInfo add_subclass
384 # MashDocInfo get_subclass
385 #
386 # Description:
387 # add_subclass adds $subclass to the list of subclasses of $superclass,
388 # and get_subclass retrieves a list of subclasses for $superclass.
389 #-------------------------------------------------------------------------
390 MashDocInfo instproc add_subclass {superclass subclass} {
391 $self instvar sub_
392 if ![info exists sub_($superclass)] {
393 set sub_($superclass) "$subclass"
394 } else {
395 if {[lsearch $sub_($superclass) $subclass] == -1} {
396 append sub_($superclass) " $subclass"
397 }
398 }
399 }
400 MashDocInfo instproc get_subclass {superclass} {
401 $self instvar sub_
402 if ![info exists sub_($superclass)] {
403 return ""
404 } else {
405 return $sub_($superclass)
406 }
407 }
408
409
410 #-------------------------------------------------------------------------
411 # Method:
412 # MashDocInfo set_filename
413 # MashDocInfo get_filename
414 # Description:
415 # set_filename remembers the name of file where item $name is found,
416 # and get_filename retrieves the filename given item $name
417 #-------------------------------------------------------------------------
418 MashDocInfo instproc set_filename {name filename} {
419 $self instvar filename_
420 if ![info exists filename_($name)] {
421 set filename_($name) "$filename"
422 } else {
423 if {[lsearch $filename_($name) $filename] == -1} {
424 append filename_($name) " $filename"
425 }
426 }
427 }
428 MashDocInfo instproc get_filename {name} {
429 $self instvar filename_
430 if ![info exists filename_($name)] {
431 return ""
432 }
433 return $filename_($name)
434 }
435
436
437 #-------------------------------------------------------------------------
438 # Method:
439 # MashDocInfo set_signature
440 # MashDocInfo get_signature
441 # Description:
442 # set_signature remembers the signature of method $name, and
443 # get_signature retrieves the signature of method $name.
444 #-------------------------------------------------------------------------
445 MashDocInfo instproc set_signature {name signature} {
446 $self instvar signature_
447 if ![info exists signature_($name)] {
448 set signature_($name) ""
449 }
450 lappend signature_($name) $signature
451 }
452 MashDocInfo instproc get_signature {name} {
453 $self instvar signature_
454 if ![info exists signature_($name)] {
455 return ""
456 }
457 return $signature_($name)
458 }
459
460
461 #-------------------------------------------------------------------------
462 # Method:
463 # MashDocInfo set_item_found
464 # MashDocInfo found_item
465 # Description:
466 # set_item_found and found_item sets and checks if a item (class or
467 # method) called $name have been found.
468 #-------------------------------------------------------------------------
469 MashDocInfo instproc set_item_found {name} {
470 $self instvar found_
471 if {[string trim $name] != ""} {
472 set found_($name) 1
473 }
474 }
475 MashDocInfo instproc found_item {name} {
476 $self instvar found_
477 return [info exists found_($name)]
478 }
479
480
481 #-------------------------------------------------------------------------
482 # Method:
483 # MashDocInfo set
484 # MashDocInfo unset
485 # Description:
486 # This sets and unsets the location of the array indexed by $key.
487 #-------------------------------------------------------------------------
488 MashDocInfo instproc set {key value} {
489 $self instvar a_
490 set a_($key) $value
491 }
492 MashDocInfo instproc unset {key} {
493 $self instvar a_
494 unset a_($key)
495 }
496
497
498
499 #-------------------------------------------------------------------------
500 # Method:
501 # MashDocInfo get
502 # Description:
503 # This returns the value of the array indexed by $key.
504 #-------------------------------------------------------------------------
505 MashDocInfo instproc get {key} {
506 $self instvar a_
507 if [info exists a_($key)] {
508 return $a_($key)
509 } else {
510 return ""
511 }
512 }
513
514
515 #-------------------------------------------------------------------------
516 # Method:
517 # MashDocInfo names
518 #
519 # Description:
520 # This returns keys in the array that matches $args. If $args is
521 # empty, returns all keys.
522 #-------------------------------------------------------------------------
523 MashDocInfo instproc names {args} {
524 $self instvar a_
525 if [info exists a_] {
526 return [array names a_ $args]
527 } else {
528 return ""
529 }
530 }
531
532
533 #-------------------------------------------------------------------------
534 # Class:
535 # DocGenerator
536 # Description:
537 # This is an abstract class that generates documentations based on
538 # information parsed from an input file. To generate a specific type
539 # of documents, you must overload the generate method.
540 #-------------------------------------------------------------------------
541 Class DocGenerator
542
543 #-------------------------------------------------------------------------
544 # Method:
545 # DocGenerator generate
546 # Description:
547 # This method is called after all input files have been parsed.
548 # It generates the documents. The format of the documents
549 # depends on various virtual method defined -- mashdoc_begin,
550 # mashdoc_end, class_begin, class_end, method_begin, method_end etc.
551 # See DocGenerator/XML and DocGenerator/TclList for an example.
552 # Arguments:
553 # doc --
554 # The array of documents parsed from a single file. Here is what it
555 # looks like. The array index consists of three elements. The first
556 # is always an integer id. This identifies different documentation
557 # blocks. The second is the heading, such as MEMBERS, METHOD, etc.
558 # The third is optional. For heading MEMBERS and ARGUMENTS, the third
559 # element refers to the name of the individual members and arguments.
560 #
561 # Here is an example:
562 # doc(1,CLASS,) TV
563 # doc(1,MEMBERS,ch) "Current channel showing on TV"
564 # doc(1,MEMBERS,vol) "Current volume level"
565 # doc(2,METHOD,) TV on
566 # doc(3,METHOD,) TV of
567 # doc(4,METHOD,) TV change_vol
568 # doc(4,ARGUMENTS,vol) "new volumns"
569 #-------------------------------------------------------------------------
570 DocGenerator instproc generate {doc} {
571
572 # Retrieve information about superclasses. This is need for
573 # C++ program, where superclass information is not parsed from
574 # source code, but is written as part of a documentation block.
575 # This need to be done before we start generating anything.
576
577 foreach id [$doc get_all_class_ids "CPP_CLASS"] {
578 set class_name [$doc get_class_name $id]
579 set superclasses [$doc get "$id,SUPERCLASS,"]
580 foreach superclass $superclasses {
581 $doc add_superclass $class_name $superclass
582 $doc add_subclass $superclass $class_name
583 }
584 if {$superclasses != ""} {
585 $doc unset "$id,SUPERCLASS,"
586 }
587 }
588
589 # I keep different output strings for different classes.
590 # For each class, I just append to appropriate strings.
591
592 foreach class_type {"OTCL_CLASS" "CPP_CLASS"} {
593 foreach id [$doc get_all_class_ids $class_type] {
594
595 set class_name [$doc get_class_name $id]
596
597 # if we haven't seen this class before,
598 if {![info exists out($class_name)]} {
599 set out($class_name) [$self gen_class_basic $doc $class_type $class_name]
600 }
601
602 foreach head [$doc get_headings $id] {
603 # Since we sort the list, we can compare current
604 # header and previous one, to remove duplicates.
605 append out($class_name) [$self general_begin $head]
606
607 foreach subhead [$doc get_subheadings $id $head] {
608 if {$subhead != ""} {
609 append out($class_name) [$self item $subhead]
610 append out($class_name) [$self desc [$doc get "$id,$head,$subhead"]]
611 } else {
612 append out($class_name) [string trim [$doc get "$id,$head,"]]
613 }
614 }
615
616 append out($class_name) [$self general_end $head]
617 }
618 }
619 }
620 # Foreach method, find out which class it belongs to (first word
621 # in method's name). Then append the name to the appropriate
622 # class.
623 foreach key "[lsort [$doc names *,METHOD,*]] [lsort [$doc names *,STATIC_METHOD,*]]" {
624 set id [lindex [split $key ","] 0]
625 set name [string trim [$doc get $key]]
626
627 # Multiple methods can be collapse into one documentation block.
628 # Here, we loop through each of the method.
629 set signatures ""
630 foreach {class_name methodname} $name {
631 if {![info exists out($class_name)]} {
632 set out($class_name) [$self gen_class_basic $doc OTCL_CLASS $class_name]
633 }
634 set filename [$doc get_filename "$class_name $methodname"]
635 lappend signatures [$doc get_signature "$class_name $methodname"]
636 }
637 # $signatures now contains a list of signatures
638 append out($class_name) [$self method_begin $signatures]
639 set prev ""
640 foreach l [lsort [$doc names $id,*,*]] {
641 set splitted_key [split $l ","]
642 set head [lindex $splitted_key 1]
643 if {$head != "METHOD" && $head != "STATIC_METHOD" &&
644 $head != $prev} {
645 append out($class_name) [$self general_begin $head]
646 foreach ll [$doc names $id,$head,*] {
647 set splitted_key [split $ll ","]
648 set subhead [lindex $splitted_key 2]
649 if {$subhead != ""} {
650 append out($class_name) [$self item $subhead]
651 append out($class_name) [$self desc [$doc get $ll]]
652 } else {
653 append out($class_name) "[string trim [$doc get $ll]]"
654 }
655 }
656 append out($class_name) [$self general_end $head]
657 }
658 set prev $head
659 }
660 append out($class_name) [$self method_end]
661 }
662 set result [$self mashdoc_begin]
663 foreach class_name [lsort [array names out]] {
664 append result $out($class_name) [$self class_end]
665 }
666 append result [$self mashdoc_end]
667 return "$result\n"
668 }
669
670 DocGenerator private gen_class_basic {doc class_type class_name} {
671 set str [$self class_begin $class_type $class_name]
672 set superclasses [$doc get_superclass $class_name]
673 append str [$self superclass $superclasses]
674 set subclasses [$doc get_subclass $class_name]
675 append str [$self subclass $subclasses]
676 set filename [$doc get_filename $class_name]
677 append str [$self filename $filename]
678 return $str
679 }
680
681 #-------------------------------------------------------------------------
682 # Class:
683 # DocGenerator/XML
684 # Description:
685 # This class generates XML output from the array $doc.
686 #-------------------------------------------------------------------------
687 Class DocGenerator/XML -superclass DocGenerator
688 DocGenerator/XML instproc class_begin {type name} {
689 return "<CLASS NAME='$name' TYPE='$type'>\n"
690 }
691 DocGenerator/XML instproc class_end {} {
692 return "</CLASS>\n"
693 }
694 DocGenerator/XML instproc superclass {name} {
695 return "<SUPERCLASS>$name</SUPERCLASS>\n"
696 }
697 DocGenerator/XML instproc filename {name} {
698 return "<FILENAME>$name</FILENAME>\n"
699 }
700 DocGenerator/XML instproc subclass {name} {
701 return "<SUBCLASS>$name</SUBCLASS>\n"
702 }
703 DocGenerator/XML instproc method_begin {signature} {
704 return "<METHOD NAME='$signature'>\n"
705 }
706 DocGenerator/XML instproc method_end {} {
707 return "</METHOD>\n"
708 }
709 DocGenerator/XML instproc general_begin {name} {
710 return "<$name>\n"
711 }
712 DocGenerator/XML instproc general_end {name} {
713 return "</$name>\n"
714 }
715 DocGenerator/XML instproc mashdoc_begin {} {
716 return "<MASHDOC>\n"
717 }
718 DocGenerator/XML instproc mashdoc_end {} {
719 return "</MASHDOC>\n"
720 }
721 DocGenerator/XML instproc item {name} {
722 return "<ITEM>$name</ITEM>\n"
723 }
724 DocGenerator/XML instproc desc {name} {
725 return "<DESC>$name</DESC>\n"
726 }
727 DocGenerator/XML instproc get_extension {} {
728 return ".xml"
729 }
730
731
732 Class DocGenerator/TclList -superclass DocGenerator
733 DocGenerator/TclList instproc class_begin {type name} {
734 return "CLASS {NAME {$name} TYPE {$type}} \{\n"
735 }
736 DocGenerator/TclList instproc class_end {} {
737 return "\}\n"
738 }
739 DocGenerator/TclList instproc superclass {name} {
740 return "SUPERCLASS {} {[string trim $name]}\n"
741 }
742 DocGenerator/TclList instproc filename {name} {
743 return "FILENAME {} {[string trim $name]}\n"
744 }
745 DocGenerator/TclList instproc subclass {name} {
746 return "SUBCLASS {} {[string trim $name]}\n"
747 }
748 DocGenerator/TclList instproc method_begin {signature} {
749 return "METHOD { NAME {[string trim $signature]} } \{\n"
750 }
751 DocGenerator/TclList instproc method_end {} {
752 return "\}\n"
753 }
754 DocGenerator/TclList instproc general_begin {name} {
755 return "$name {} \{\n"
756 }
757 DocGenerator/TclList instproc general_end {name} {
758 return "\}\n"
759 }
760 DocGenerator/TclList instproc mashdoc_begin {} {
761 return "MASHDOC {} \{\n"
762 }
763 DocGenerator/TclList instproc mashdoc_end {} {
764 return "\}\n"
765 }
766 DocGenerator/TclList instproc item {name} {
767 return "ITEM {} {[string trim $name]}\n"
768 }
769 DocGenerator/TclList instproc desc {name} {
770 return "DESC {} {[string trim $name]}\n"
771 }
772 DocGenerator/TclList instproc get_extension {} {
773 return ".list"
774 }
775
776
777 #-------------------------------------------------------------------------
778 # Class:
779 # MashDoc
780 #
781 # Description:
782 # This is the main class of this application. It reads, parses and
783 # generates documents given an input list of file.
784 #-------------------------------------------------------------------------
785 Class MashDoc
786
787 #-------------------------------------------------------------------------
788 # Class:
789 # MashDoc
790 #
791 # Static Members:
792 # syntax_ -- This global array defines the syntax class to use based
793 # on extension of a filename.
794 #-------------------------------------------------------------------------
795 MashDoc set syntax_(.tcl) OTclSyntax
796 MashDoc set syntax_(.cc) CppSyntax
797 MashDoc set syntax_(.c) CppSyntax
798 MashDoc set syntax_(.h) CppSyntax
799
800 #-------------------------------------------------------------------------
801 # Method:
802 # MashDoc init
803 #
804 # Description:
805 # This is the main method. It takes in a list of files, create a
806 # bunch of document generators, parses all the files, and call the
807 # document generators to generate the documents.
808 #-------------------------------------------------------------------------
809 MashDoc instproc init {argv} {
810
811 set rootdir [lindex $argv 0]
812 if {$rootdir == ""} {
813 set rootdir "."
814 }
815 set outdir [lindex $argv 1]
816 if {$outdir == ""} {
817 set outdir "."
818 }
819
820 set doc [new MashDocInfo]
821
822 set filelist [glob $rootdir/*.tcl \
823 $rootdir/*/*.tcl \
824 $rootdir/*/*/*.tcl \
825 $rootdir/*/*/*/*.tcl \
826 $rootdir/*.cc \
827 $rootdir/*/*.cc \
828 $rootdir/*/*/*.cc \
829 $rootdir/*/*/*/*.cc \
830 $rootdir/*.\[ch\] \
831 $rootdir/*/*.\[ch\] \
832 $rootdir/*/*/*.\[ch\] \
833 $rootdir/*/*/*/*.\[ch\] \
834 ]
835 foreach f $filelist {
836 $self parse_a_file $doc $f
837 }
838
839 set doc_generators ""
840 lappend doc_generators [new DocGenerator/TclList]
841 lappend doc_generators [new DocGenerator/XML]
842
843 foreach docgen $doc_generators {
844 set f [open "$outdir/mashdoc[$docgen get_extension]" "w"]
845 puts $f [$docgen generate $doc]
846 close $f
847 }
848 }
849
850
851 #-------------------------------------------------------------------------
852 # Method:
853 # MashDoc parse_a_file
854 #
855 # Description:
856 # This methods reads from a file given its filename. It then update
857 # the array $doc with headings, subheadings and text in documentation
858 # block from the file.
859 #-------------------------------------------------------------------------
860 MashDoc instproc parse_a_file {doc filename} {
861
862 MashDoc instvar syntax_
863 set ext [file extension $filename]
864 if [info exists syntax_($ext)] {
865 set syntax [new $syntax_($ext)]
866 } else {
867 puts stderr "ERROR: $filename has an unrecorgnized extension '$ext'"
868 return
869 }
870
871 if {[catch {open $filename r} f]} {
872 puts stderr "ERROR: unable to open $filename"
873 close $f
874 return
875 }
876 puts "Parsing $filename.."
877
878 set heading ""
879 set subheading ""
880 set state "normal"
881 set prog ""
882
883 while {![eof $f]} {
884
885 # Now checks for comments
886 set line [gets $f]
887 set line_type [$syntax get_line_type $line]
888 switch -exact [lindex $line_type 0] {
889 "SEPARATOR" {
890 if {$state == "normal"} {
891 set state "doc"
892 set id [$doc next_id]
893 } else {
894 set state "normal"
895 }
896 }
897 "HEADING" {
898 if {$state == "doc"} {
899 set heading [string trim [lindex $line_type 1]]
900 set subheading ""
901 set text [lindex $line_type 2]
902 if {$heading != ""} {
903 # subheading can be null, but heading cannot.
904 set heading [$syntax normalize_keyword $heading]
905 set curr_text [$doc get "$id,$heading,$subheading"]
906 append curr_text "[concat $text]\n"
907 $doc set "$id,$heading,$subheading" "$curr_text"
908 }
909 } else {
910 append prog "$line "
911 }
912 }
913 "SUBHEADING" {
914 if {$state == "doc"} {
915 set subheading [string trim [lindex $line_type 1]]
916 set text [lindex $line_type 2]
917 if {$heading != ""} {
918 # subheading can be null, but heading cannot.
919 set curr_text [$doc get "$id,$heading,$subheading"]
920 append curr_text "[concat $text]\n"
921 $doc set "$id,$heading,$subheading" "$curr_text"
922 }
923 } else {
924 append prog "$line "
925 }
926 }
927 "TEXT" {
928 if {$state == "doc"} {
929 set text [lindex $line_type 1]
930 if {$heading != ""} {
931 # subheading can be null, but heading cannot.
932 set curr_text [$doc get "$id,$heading,$subheading"]
933 append curr_text "[concat $text]\n"
934 $doc set "$id,$heading,$subheading" "$curr_text"
935
936 switch $heading {
937 "OTCL_CLASS" -
938 "CPP_CLASS" -
939 "METHOD" -
940 "STATIC_METHOD" {
941 $doc set_item_found [string trim $text]
942 }
943 }
944 }
945 } else {
946 append prog "$line "
947 }
948 }
949 "NOTCOMMENT" {
950 set state "normal"
951 append prog "$line "
952 }
953 "COMMENT" {
954 }
955 }
956 }
957
958 close $f
959
960 $syntax parse_program $filename $prog $doc
961 delete $syntax
962
963 return $doc
964 }
965
966 OTclSyntax instproc parse_program {filename prog doc} {
967
968 # Parse for program for documentation. Here, we can generate a list
969 # of all methods and classes (not only those which are documented),
970 # And generate class hierarchy.
971
972 set index 0
973
974 # HACK ALERT. Make sure $prog is a well-form list by inserting a
975 # space after every quote.
976 regsub -all {\"} $prog {\" } prog
977 regsub -all "\}" $prog "\} " prog
978
979 set curr_item [lindex $prog $index]
980 while {$curr_item != ""} {
981 if {$curr_item == "Class"} {
982 incr index
983 set class_name [lindex $prog $index]
984 # What we found is actually an instproc for a class called "Class". Go back.
985 if {$class_name == "instproc"} {
986 incr index
987 set curr_item [lindex $prog $index]
988 continue
989 }
990 # Tcl allow statements to end with ;.
991 if {[string index $class_name end] == ";"} {
992 set length [string length $class_name]
993 set class_name [string range $class_name 0 [expr $length -2]]
994 }
995 # We haven't seen this class before, since it is not
996 # documented.
997 if {![$doc found_item $class_name]} {
998 $doc set_item_found $class_name
999 set id [$doc next_id]
1000 $doc set "$id,OTCL_CLASS," $class_name
1001 }
1002 $doc set_filename $class_name $filename
1003 incr index
1004 # FIXME: when -superclass and the class name are on diff
1005 # line, the list element after this is empty.
1006 if {[string trim [lindex $prog $index]] == ""} {
1007 incr index
1008 }
1009 if {[lindex $prog $index] == "-superclass"} {
1010 incr index
1011 set superclasses [lindex $prog $index]
1012 # FIXME: when -superclass and the class name are on diff
1013 # line, the list element after this is empty.
1014 if {[string trim $superclasses] == ""} {
1015 incr index
1016 set superclasses [lindex $prog $index]
1017 }
1018 foreach superclass $superclasses {
1019 $doc add_superclass $class_name $superclass
1020 $doc add_subclass $superclass $class_name
1021 }
1022 incr index
1023 }
1024 } elseif {$curr_item == "instproc" || $curr_item == "private"
1025 || $curr_item == "public" || $curr_item == "proc"} {
1026 set class_name [lindex $prog [expr $index - 1]]
1027
1028 # Classes must be declared before methods. So we verify that
1029 # that we have found a method signature by making sure that
1030 # the previous word is a class_name, and is the first word
1031 # of a line.
1032 if {[$doc found_item $class_name]} {
1033 incr index
1034 set methodname [lindex $prog $index]
1035 incr index
1036 set arguments [lindex $prog $index]
1037 $doc set_filename "$class_name $methodname" $filename
1038 $doc set_signature "$class_name $methodname" \
1039 "$class_name $curr_item $methodname { $arguments }"
1040 if {![$doc found_item "$class_name $methodname"]} {
1041 $doc set_item_found "$class_name $methodname"
1042 set id [$doc next_id]
1043 if {$curr_item == "proc"} {
1044 $doc set "$id,STATIC_METHOD," "$class_name $methodname"
1045 } else {
1046 $doc set "$id,METHOD," "$class_name $methodname"
1047 }
1048 }
1049 }
1050 incr index
1051 } else {
1052 incr index
1053 }
1054 set curr_item [lindex $prog $index]
1055 }
1056 }
1057
1058
1059 CppSyntax instproc parse_program {filename prog doc} {
1060
1061 # Return for now. Parsing C++ in Tcl is pretty scary, even if
1062 # we just want to extract class declarations!
1063 return
1064
1065 # Remove remaining comments from $prog, from comp.lang.tcl
1066 regsub -all {(?x)
1067 # First, we'll list things we want to match, but not throw away
1068 (
1069 [^"'/]+ # other stuff
1070 | # -or-
1071 (?: " [^"\\]*(?: \\ .[^"\\]*)* " [^"'/]*)+ # double quoted string
1072 | # -or-
1073 (?: ' [^'\\]*(?: \\ .[^'\\]*)* ' [^"'/]*)+ # single quoted string
1074 )
1075 | # OR ...
1076 # ...we'll match a comment. Since it's not in the parentheses above,
1077 # the comments will disappear when we use \1 as the replacement text.
1078 # \* [^*]*\*+(?:[^/*][^*]*\*+)* / # traditional C comments.
1079 / (?: # all comments start with a slash
1080 \* [^*]*\*+(?:[^/*][^*]*\*+)* / # traditional C comments.
1081 | # -or-
1082 / [^\n]* # C++ //-style comments
1083 )
1084 } $prog {\1} prog
1085 }
1086
1087 new MashDoc $argv
1088
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.