libs/neuronet: Implemented the new function NNet_GetMaster.
[neuro.git] / docs / neuroman.tcl
blob46d44806b2bc429da14c618e588286fa442a44bc
1 # copyright neuroponic 2006
2 # author : Nicholas Niro
3 # by using this piece of software, you accept that it
4 # has no warranty at all, use it at your own risk.
6 # permission is hereby granted to modify and distribute
7 # this script as long as the original authoring is kept.
14 # documentation section, the syntax of the configuration file
15 # and the syntax of the comments in the header files.
17 # configuration file syntax
19 # the configuration file requires 5 lines
20 # the first line is the name of the program/library
21 # the first line is the section number
22 # here are all the sections with a description but the most common
23 # is generally the section 3.
24 # Section
25 # 1 User commands
26 # 2 System calls, that is, functions provided by the kernel.
27 # 3 Subroutines, that is, library functions.
28 # 4 Devices, that is, special files in the /dev directory.
29 # 5 File format descriptions, e.g. /etc/passwd.
30 # 6 Games, self-explanatory.
31 # 7 Miscellaneous, e.g. macro packages, conventions.
32 # 8 System administration tools that only root can execute.
33 # 9 Another
34 # n New documentation, that may be moved to a more appropriate section.
35 # l Local documentation referring to this particular system.
36 # the second line is the center footer text
37 # the third line is the left footer text
38 # and the last line is the center header
40 # here is an example configuration file
41 # 3
42 # 02 Sep 2006
43 # v0.44.0
44 # Libneuro Functions
48 # the syntax inside the header files
50 # In order for this script to correctly parse comment blocks,
51 # a special comment block has to be used. Any comments starting
52 # by /* are ignored, only those starting by /** are parsed
53 # by this script. Terminating a comment block can be done using
54 # two methods, either with the normal comment block end */
55 # or the double comment block end **/. The normal comment block
56 # is meant to precede a function prototype like this example :
57 #/**
58 # *
59 # *
60 # */
61 #extern void somefunc(int foo, int bar);
63 # The double ending comment block simply parses the comment and nothing
64 # else, here is an example :
65 # /**
66 # *
67 # *
68 # **/
69 # using this method, a near infinite amount of man pages can be created
70 # without the need to have a function. The only drawback is that the
71 # name macro (see @name below) _has_ to be set because there's no
72 # function prototype to gather the name of the man page file from.
74 # an ending comment block of type */ actually has a special parser
75 # which also parses the next line's function prototype.
76 # It gets the function name, return type, variable type and variable name.
78 # inside the /** (*)*/ comments, a special "language" has to be used which uses
79 # commands or variables. commands/variables always start with the character '@'
80 # for example : @description
82 # the script parses all the current data (the text) into the last "command"
83 # issued.
84 # here are the complete list of those commands/variables and what they do :
86 # take note that those commands can be entered in any order.
90 # @name -- Name of the man page file. (not required for */ ending comments
91 # but mandatory for **/ ending comments)
92 # If this variable is present for a function prototype then it will
93 # override the function name with this value.
94 # @sdescri -- A small description, a summary that should only be about 1 sentence.
95 # @description -- An exhaustive description, it can be of any length.
96 # @param[in] -- Input argument type is used to signify that the particular variable
97 # is meant as read only by the function. See @param for more details.
98 # @param[out] -- Output argument type, same as input but signifies that the variable
99 # is meant to be output of the function. See @param for more details.
100 # @param[io] -- Both way argument type is used as both input and output at once,
101 # see @param for more details.
102 # @param -- Can not be used as is, has to be used in the form shown right above
103 # like @param[in]. This argument has the particularity to be automatically
104 # matched with arguments of the prototype function at hand.
105 # Say theres 5 arguments in the function prototype, well a total amount of
106 # 5 @param[...] will need to be used to describe all the argument's meaning
107 # and behavior.
108 # @related -- text after this (which should be functions or such) will be put in the see also
109 # section.
110 # @examples -- text after this is put in the code examples section.
111 # @returnval -- text after this is put in the return value section.
112 # @errors -- text after this is put in the error codes section.
116 # -- constants --
117 # put the version here
118 set version "2.1.3"
120 # -- global variables --
122 set individual 0
123 set use_config 0
124 set files ""
125 set config ""
127 proc showHelp { } {
128 echo "Usage : neuroman \[OPTIONS\] ... \[FILES\]"
129 echo "A very simple tcl header file parser to the man format."
130 echo "The documentation on how to format the comments before"
131 echo "the functions is inside this script."
132 echo " -c file input the configuration file"
133 echo " -i,--individual saves each functions from FILES into their own man"
134 echo " pages instead of outputing to standard output."
135 echo " -v,--version output the version of neuroman"
136 echo " -h,--help output this help message"
137 echo
138 echo "report bugs to neuroman-bugs@neuroponic.com"
141 proc showVersion { } {
142 global version
143 echo "neuroman version $version"
146 proc handleArgs { } {
147 global argc
148 global argv
149 global individual
150 global files
151 global config
152 global use_config
153 set got_config 0
154 if {$argc == 0} {
155 showHelp
156 return 0
157 } else {
159 #we check and handle the arguments
160 foreach elem $argv {
161 if {$elem == "-h" || $elem == "--help"} {
162 showHelp
163 return 0
164 } elseif {$elem == "-v" || $elem == "--version"} {
165 showVersion
166 return 0
167 } elseif {$elem == "-i" || $elem == "--individual"} {
168 set individual 1
169 } elseif {$elem == "-c"} {
170 set got_config 1
171 } elseif {$got_config == 1} {
172 set got_config 0
173 set config $elem
174 set use_config 1
175 } else {
176 if {[string index $elem 0] == "-"} {
177 echo "Invalid argument $elem"
178 echo "use --help to see the list of valid arguments."
179 } else {
180 set files [linsert $files 1 "$elem"]
185 return 1
188 return 0
192 # this function parses a C function prototype to remove its leading
193 # and ending brackets.
194 # it will not touch brackets that are not leading and ending.
195 proc arrangeFunction {function} {
196 set t 0
197 set i 0
198 #set total [llength $function]
199 #set found_start 0
200 #set found_end 0
201 #set coord_end 0
203 # gets rid of all the commas
204 #while {$t < [string length $function]} {
205 # set t [string first "," $function $t]
207 # if {$t == -1} {
208 # break;
209 # } else {
210 #echo $t
211 # set function [string replace $function $t $t " "]
213 # incr t
216 # we find the first opening bracket
217 set t [string first "(" $function]
219 # if we found one, we remove it
220 if {$t > 0} {
221 set function [string replace $function $t $t " "]
224 # we find the last opening bracket
225 set t [string last ")" $function]
227 # if we found one, we remove it
228 if {$t > 0} {
229 set function [string replace $function $t $t " "]
233 # now we will kind of hack a way to assemble ()() function pointers
234 # into an whole
235 set t 0
236 set found_begin 0
237 set found_end 0
238 set coord_begin 0
239 set coord_end 0
240 while {$t < [string length $function]} {
241 set t [string first "(" $function $t]
243 if {$t == -1} {
244 break
245 } elseif {$found_begin == 0} {
246 #echo $t
247 #set function [string replace $function [expr $t - 1] [expr $t - 1] "\{"]
248 #set coord_begin $t
249 set found_begin 1
250 set found_end 0
254 set t [string first ")" $function $t]
256 if {$t == -1} {
257 break
258 } elseif {$found_end == 1} {
259 #echo $t
260 #set function [string replace $function [expr $t + 1] [expr $t + 1] "\}"]
261 set found_begin 0
262 } else {
263 incr found_end
268 #puts $function
270 # we get rid of the beginning extern if any
271 if {[lindex $function 0] == "extern"} {
272 set function [lrange $function 1 end]
275 return $function
278 proc pushData {storage toadd extra} {
279 upvar $storage buffer
280 upvar $extra xtra
282 if {$storage == ""} {
283 return
286 if {$xtra == ""} {
287 set buffer $toadd
288 } else {
289 set buffer "$buffer $xtra {$toadd}"
291 set xtra ""
295 proc parseComment {comment name sdescri ldescri options returnval example errors related} {
296 upvar $name cname
297 upvar $sdescri small_d
298 upvar $ldescri long_d
299 upvar $options opt
300 upvar $returnval retv
301 upvar $example exmp
302 upvar $errors err
303 upvar $related rela
305 set ctype ""
306 set buffer ""
307 set extra ""
309 foreach word $comment {
311 puts "Parse all words : $word"
313 #set word [string trim $word \"*\"]
315 if {$word == "@name"} {
316 pushData $ctype $buffer extra
317 set ctype cname
319 set buffer ""
320 } elseif {$word == "@sdescri"} {
321 pushData $ctype $buffer extra
322 set ctype small_d
324 set buffer ""
325 } elseif {$word == "@description"} {
326 pushData $ctype $buffer extra
327 set ctype long_d
329 set buffer ""
330 } elseif {$word == "@param\[in\]"} {
331 pushData $ctype $buffer extra
332 set ctype opt
333 set extra 0
335 set buffer ""
336 } elseif {$word == "@param\[out\]"} {
337 pushData $ctype $buffer extra
338 set ctype opt
339 set extra 1
341 set buffer ""
342 } elseif {$word == "@param\[io\]"} {
343 pushData $ctype $buffer extra
344 set ctype opt
345 set extra 2
347 set buffer ""
348 } elseif {$word == "@related"} {
349 pushData $ctype $buffer extra
350 set ctype rela
352 set buffer ""
353 } elseif {$word == "@examples"} {
354 pushData $ctype $buffer extra
355 set ctype exmp
357 set buffer ""
358 } elseif {$word == "@returnval"} {
359 pushData $ctype $buffer extra
360 set ctype retv
362 set buffer ""
363 } elseif {$word == "@errors"} {
364 pushData $ctype $buffer extra
365 set ctype err
367 set buffer ""
368 } else {
369 set buffer "$buffer $word"
373 pushData $ctype $buffer extra
375 # we clean the small buffers of any * characters
376 # from the comment syntax
377 Clean_String cname
378 Clean_String small_d
379 Clean_String long_d
380 Clean_String opt
381 Clean_String retv
382 Clean_String exmp
383 Clean_String err
384 Clean_String rela
387 proc GetStringWord { str current} {
388 #returns the word it fetched
389 #current needs to be the variable itself, not the data
390 upvar $current a
391 set slen [string length $str]
392 set sepchar " "
393 set outword ""
394 set initial $a
396 while {$a < $slen} {
397 set c [string index $str $a]
399 if {$c != " "} {
400 set outword "$outword$c"
401 #echo "outword : $outword initial $initial current $a char : $c"
402 } else {
403 break;
406 incr a
409 incr a
410 return $outword
413 proc Clean_String {str} {
414 upvar $str tochange
415 set new_string ""
416 set temp ""
418 set new_string $tochange
420 # \\052 == '*'
421 # \\\\175 == '\}' and \c\}
422 #regsub -all " \\052( |\n|$|)" $tochange {} new_string
423 regsub -all {(\*[[:blank:]]|[[:blank:]]\*)} $tochange {} new_string
424 regsub -all {( | | | |)\*( | | )} $tochange {} new_string
426 # this gets rid of any stars at the end of a line without
427 # getting rid of the carriage return
428 #regsub -all "\\052\n" $new_string "\n" new_string
430 set temp $new_string
432 # we get rid of any * right before a '\}'
433 regsub -all " \\052(\})" $temp "\}" new_string
435 #set temp $new_string
437 # we get rid of the very annoying space that gets
438 # added at the very beginning for every paragraphs.
439 # we replace by the full string and add a \b character
440 # at the end to get rid of the space.
441 #regsub -all "\(\\\\n \)*\\\\n " $temp "&\b" new_string
442 #regsub -all {$ \n[[:space:]]\n[[:space:]]} $temp "\n\n" new_string
443 #regsub -all -line {^[[:space:]]} $temp "coco" new_string
445 #set temp $new_string
447 # we also get rid of any beginning spaces
448 regsub -all -line "^ " $temp "" new_string
449 #regsub -all -nocase {\n[[:space:]][a,z]} $temp "coco" new_string
450 #regsub -all {} $temp "coco" new_string
452 set tochange $new_string
455 # parses strictly a comment block
456 proc genMan_Unique {comment} {
457 global individual
458 global config
459 set name ""
460 set msmall_description ""
461 set mdescription ""
462 set moptions ""
463 set mreturnv ""
464 set mexamples ""
465 set merrors ""
466 set mseealso ""
467 set config_i [parseConfig $config]
470 # by default we output to stdout (default screen)
471 set fp stdout
473 # we get rid of the /* character in the string
474 set comment [string trim $comment "/*"]
476 # populate our variables
477 parseComment $comment name msmall_description mdescription moptions mreturnv mexamples merrors mseealso
479 if {$name == ""} {
480 puts "Error : missing a @name element from a comment"
481 return
484 if {$individual == 1} {
485 # we get rid of any ending spaces
486 regsub "\( \)*$" $name "" name
487 # we trim the function's name of any leading * in case
488 # it returns a pointer -- example : char *somefunction()
489 set fp [open "[string trim $name \"*\"].[lindex $config_i 0]" w]
490 #set fp [open "$name.[lindex $config 0]" w]
493 puts $fp ".TH $name [lindex $config_i 0] \"[lindex $config_i 1]\" \"[lindex $config_i 2]\" \"[lindex $config_i 3]\""
494 puts $fp ".SH NAME"
496 if {[llength $msmall_description] > 0} {
497 puts $fp ".TP"
498 puts $fp "[string trim $name \"*\"]"
499 puts $fp "\- $msmall_description"
500 } else {
501 puts $fp "[string trim $name \"*\"]"
504 if {[llength $mdescription] > 0} {
505 puts $fp ".SH DESCRIPTION"
506 puts $fp [subst "$mdescription"]
509 if {[llength $mreturnv] > 0 && [lindex $function 0] != ""} {
510 puts $fp ".SH RETURN VALUES"
511 puts $fp "$mreturnv"
514 if {[string length $mexamples] > 0} {
515 puts $fp ".SH EXAMPLE(S)"
517 puts $fp [subst $mexamples]
520 if {[llength $merrors] > 0} {
521 puts $fp ".SH ERRORS"
522 puts $fp "$merrors"
525 if {[llength $mseealso] > 0} {
526 puts $fp ".SH SEE ALSO"
527 puts $fp "$mseealso"
531 if {$individual == 1} {
532 close $fp
538 # parses a comment block followed by a function prototype
539 proc genMan {comment function} {
540 global individual
541 global config
542 set name ""
543 set msmall_description ""
544 set mdescription ""
545 set moptions ""
546 set mreturnv ""
547 set mexamples ""
548 set merrors ""
549 set mseealso ""
550 set config_i [parseConfig $config]
552 # we get rid of any { or } characters
553 set function [eval "concat $function"]
555 # by default we output to stdout (default screen)
556 set fp stdout
558 # arranges the function data so its easy to handle
559 set function [arrangeFunction $function]
561 # we get rid of the /* character in the string
562 set comment [string trim $comment "/*"]
564 # populate our variables
565 parseComment $comment name msmall_description mdescription moptions mreturnv mexamples merrors mseealso
567 if {$name == ""} {
568 if {[lindex $function 1] == ""} {
569 # an error
570 return
572 set name [lindex $function 1]
576 if {$individual == 1} {
577 # we trim the function's name of any leading * in case
578 # it returns a pointer -- example : char *somefunction()
579 set fp [open "[string trimleft $name \"*\"].[lindex $config_i 0]" w]
582 puts $fp ".TH $name [lindex $config_i 0] \"[lindex $config_i 1]\" \"[lindex $config_i 2]\" \"[lindex $config_i 3]\""
583 puts $fp ".SH NAME"
585 if {[llength $msmall_description] > 0} {
586 puts $fp ".TP"
587 puts $fp "[string trim $name \"*\"]"
588 puts $fp "\- [subst $msmall_description]"
589 } else {
590 puts $fp "[string trim $name \"*\"]"
594 #echo $function
595 if {[lindex $function 0] != ""} {
596 puts $fp ".SH SYNOPSIS"
597 puts $fp "[lindex $function 0] $name\([lrange $function 2 [expr [llength $function] - 2]]\)"
600 if {[string length $mdescription] > 0} {
601 puts $fp ".SH DESCRIPTION"
602 puts $fp [subst $mdescription]
605 # The arguments... beats me why I initially called that
606 # options...
607 if {[llength $moptions] > 0 && [lindex $function 0] != ""} {
608 set ototal [llength $moptions]
609 set i 1
610 set cfunc 3
612 puts $fp ".SH ARGUMENTS"
614 while {$i < $ototal} {
615 set ctype [lindex $moptions [expr "$i - 1"]]
616 set t 0
617 set is_funcptr 0
619 if {$ctype == 0} {
620 set type "(input)"
621 } elseif {$ctype == 1} {
622 set type "(output)"
623 } else {
624 set type "(input and output)"
627 #set nfunc [string trim [lindex $function $cfunc] "*"]
628 set nfunc [lindex $function $cfunc]
630 # we check to see if the current argument is a pointer to
631 # a function and if yes, we do something special to include
632 # all its arguments
633 if {[string index $nfunc 0] == "("} {
634 set is_funcptr 1
637 if {$is_funcptr == 1} {
638 set go_on 1
639 set found_one 0
641 set str $nfunc
642 while { $go_on == 1 } {
643 set cur [string last ")" $str]
645 # this is a special case where the function pointer
646 # has no arguments at all.
647 # like : void (*callback)()
648 if {$cur > 0} {
649 if {[lindex $function [expr $cur - 1]] == "("} {
650 break;
651 } elseif {$found_one == 1} {
652 break;
653 } else {
654 incr found_one
658 incr cfunc
659 set str [lindex $function $cfunc]
661 set nfunc [linsert $nfunc [llength $nfunc] $str]
662 #echo "SPECIAL $nfunc -> $str"
667 # we remove the last comma if we find one
668 set t [string last "," $nfunc]
670 #echo "cur $cfunc last [llength $function]"
671 if {$t > 0 && [expr [llength $function] - 1] > $cfunc} {
672 set nfunc [string replace $nfunc $t $t " "]
675 puts $fp ".TP"
676 puts $fp ".BI \"$nfunc \" $type"
677 puts $fp "[lindex $moptions $i]\n"
679 incr cfunc 2
681 incr i 2
685 if {[llength $mreturnv] > 0 && [lindex $function 0] != ""} {
686 puts $fp ".SH RETURN VALUES"
687 puts $fp "$mreturnv"
690 if {[string length $mexamples] > 0} {
691 puts $fp ".SH EXAMPLE(S)"
692 puts $fp [subst $mexamples]
695 if {[llength $merrors] > 0} {
696 puts $fp ".SH ERRORS"
697 puts $fp "$merrors"
700 if {[llength $mseealso] > 0} {
701 puts $fp ".SH SEE ALSO"
702 puts $fp "$mseealso"
709 if {$individual == 1} {
710 close $fp
716 # "/**" gather -> "**/" stop gather
717 # OR "*/" stop gather and look for anything except "/**"
718 # after a "/**" "*/" combination (next line)
719 # look for "extern" gather2 -> ";" stop gather2 dump in function ...
721 # the part action can include :
722 # none : none yet (put that when nothing is needed anymore)
723 # gather : starts buffering inside the buffer part. And starts matching in the
724 # end_string_list list.
725 # childonly : we got a match in the end_string_list so we process only in it
726 # process_data : tells the algo that the current branch got a complete set of
727 # matching patterns so it can now be processed. If this action
728 # is choosen, the extra part is used to know which function to
729 # call with what arguments.
730 # gather_line : exactly like gather but it doesn't match anything, it stops after
731 # a line change. It uses the extra part for the function to call.
732 # it also uses the current_action element to the current line number.
734 # the end_string part is a list with a list of strings that can be matched.
735 # and the next element is the child elements exactly like the MATCH list.
737 # buffer is the current buffer which is filled only when the begin_string is
738 # matched. Filling it only ends when a match is found inside end_string_list
740 # begin_string_list action buffer current_action extra end_string_list
742 # take note that the general order is important for correct dependencies
743 # the more dependencies a match has, the more it is to the end.
744 proc MATCH_format {} {
746 set MATCH_Handled_Test "{\"houba\" gather_line \"\" none \"genMan_Test\" {} }"
748 set MATCH_Handled_Comment_End_Unique "{\"**/\" process_data \"\" none \"genMan_Unique\" {} }"
750 set MATCH_Function_Prototype_End "{\";\" process_data \"\" none \"genMan\" {}}"
752 set MATCH_Function_Prototype "{\"extern\" gather \"\" none \"\" {\
753 $MATCH_Function_Prototype_End} }"
755 set MATCH_Handled_Comment_End "{\"*/\" childonly \"\" none \"\" {\
756 $MATCH_Function_Prototype} }"
759 set MATCH_Handled_Comment_Start "{\"/**\" gather \"\" none \"\" {\
760 $MATCH_Handled_Comment_End_Unique \
761 $MATCH_Handled_Comment_End} }"
764 set MATCH_list "$MATCH_Handled_Comment_Start $MATCH_Handled_Test"
766 #set i 0
767 #foreach parent $MATCH_list {
768 # MATCH_process "/**" MATCH_list "" $parent $i
770 #puts "$parent"
772 # incr i
775 #MATCH_process "/**" MATCH_list
776 #MATCH_process "hello" MATCH_list
777 #MATCH_process "*/" MATCH_list
778 #MATCH_process "extern" MATCH_list
779 #MATCH_process ";" MATCH_list
781 #puts "---> $MATCH_list"
783 #MATCH_resetProcess MATCH_list 0 0
785 return $MATCH_list
788 proc MATCH_process {stringtm thelist} {
789 upvar $thelist tlist
790 set i 0
791 set depth 0
792 set num 0
794 #puts "$tlist\n"
795 #puts "fetched whole \"[Fetch_Cascade_Whole $tlist 5 {0} 0 1]\""
796 #puts "fetched data \"[Fetch_Cascade_Data $tlist 5 0 {0 1} 1]\""
798 #puts "\nChanging data"
799 #set tlist [Set_Cascade_Data $tlist 5 3 "childonly" {0 1 0 0} 3]
800 #puts "fetched modified data \"[Fetch_Cascade_Data $tlist 5 3 {0 1 0 0} 3]\""
802 #puts "STRING -> $stringtm"
804 MATCH_loopProcess $stringtm tlist 0 0
807 proc MATCH_resetProcess {thelist num depth} {
808 upvar $thelist tlist
810 #puts "will process num $num depth $depth"
812 while {1 != 2} {
813 set cData [Fetch_Cascade_Whole $tlist 5 $num $depth 1]
815 #puts $cData
817 if {$cData == -1 || $cData == ""} {
818 break;
821 foreach elem $cData {
822 set child_num 0
824 # we reset the buffer elemenet
825 set tlist [Set_Cascade_Data $tlist 5 2 "" $num $depth]
827 # we reset the current_action element
828 set tlist [Set_Cascade_Data $tlist 5 3 "none" $num $depth]
832 set child_num $num
834 lappend child_num 0
837 #puts "child num : $child_num -- depth [expr $depth + 1]"
839 MATCH_resetProcess tlist $child_num [expr $depth + 1]
841 lset num $depth [expr [lindex $num $depth] + 1]
846 proc MATCH_loopProcess {stringtm thelist num depth} {
847 upvar $thelist tlist
849 #puts "will process num $num depth $depth string $stringtm"
851 while {1 != 2} {
852 set cData [Fetch_Cascade_Whole $tlist 5 $num $depth 1]
854 #puts $cData
856 if {$cData == -1 || $cData == ""} {
857 break;
860 foreach elem $cData {
861 set child_num 0
863 #puts [Fetch_Cascade_Data $tlist 5 0 $num $depth]
864 set _err [MATCH_subprocess $stringtm tlist $num $depth]
866 if {$_err == 0} {
867 # we call a subsequent child
869 #lset num $depth [expr [lindex $num $depth] + 1]
871 set child_num $num
873 lappend child_num 0
876 #puts "child num : $child_num -- depth [expr $depth + 1]"
878 if {[MATCH_loopProcess $stringtm tlist $child_num [expr $depth + 1]] == 1} {
879 return 1
882 #puts "finished child run"
884 # we don't need to run on the next nodes
885 return 0
886 } elseif {$_err == 2} {
887 return 1
888 } else {
889 lset num $depth [expr [lindex $num $depth] + 1]
893 break
897 # this function calls itself
898 # if the current node needs to call subsequent childs, it will return 0
899 # if not, it will return 1
900 proc MATCH_subprocess {stringtm thelist num depth} {
901 upvar $thelist tlist
902 set node [Fetch_Cascade_Whole $tlist 5 $num $depth]
904 #puts "node [lindex $node 0] string $stringtm"
906 switch [lindex $node 3] {
907 none {
908 foreach string_match [lindex $node 0] {
909 #puts -nonewline "trying to see if $stringtm is $string_match "
911 if {[ParseString $string_match $stringtm] == 1} {
912 set output $tlist
914 #puts " <- MATCH \n"
916 switch [lindex $node 1] {
918 none {
919 return 1
922 gather {
923 set tlist [Set_Cascade_Data $tlist 5 3 "gather" $num $depth]
927 childonly {
928 set tlist [Set_Cascade_Data $tlist 5 3 "childonly" $num $depth]
930 set tlist [Set_Cascade_Data $tlist 5 3 "childonly" [lrange $num 0 [expr $depth - 1]] [expr $depth - 1]]
932 return 2
935 process_data {
936 set i 0
937 set buf ""
938 # this is the "last" command set for a list of matches, thats why we reset the list
939 # need to call the extra element with the necessary arguments
941 while {$i < $depth} {
943 if {[Fetch_Cascade_Data $tlist 5 1 [lrange $num 0 $i] $i] == "gather"} {
944 lappend buf [Fetch_Cascade_Data $tlist 5 2 [lrange $num 0 $i] $i]
947 incr i
949 #puts $tlist
950 #puts $buf
952 eval "[lindex $node 4] $buf"
954 #puts "we reset the process"
956 MATCH_resetProcess tlist 0 0
958 return 2
961 gather_line {
962 # don't know yet how to handle this one
964 return 1
970 #puts "initial gathering action [lindex $node 0] -> $stringtm"
972 set buf [lindex $node 2]
974 lappend buf $stringtm
976 set tlist [Set_Cascade_Data $tlist 5 2 $buf $num $depth]
978 # we only need one match
979 return 2
980 } else {
981 #puts "\n"
985 return 1
988 gather {
989 #puts "gathering action [lindex $node 0] -> $stringtm"
991 set buf [lindex $node 2]
993 lappend buf $stringtm
995 set tlist [Set_Cascade_Data $tlist 5 2 $buf $num $depth]
998 return 0
1001 childonly {
1002 #puts "child only state [lindex $node 0]"
1004 return 0
1007 process_data {
1008 puts "process data state? this is an error buddy!"
1011 gather_line {
1012 puts "gather line state? this is an error buddy!"
1016 return 1
1019 # sets a single data in a list/sublist corresponding to depth
1020 # and number pattern
1021 proc Set_Cascade_Data {alist sublist_num elem data num_in depth} {
1022 set i 0
1023 set num $num_in
1024 set child ""
1026 set i [expr $depth + 1]
1028 while {$i > 0} {
1029 set i [expr $i - 1]
1031 set current [Fetch_Cascade_Whole $alist $sublist_num $num $i]
1032 set whole [Fetch_Cascade_Whole $alist $sublist_num $num $i 1]
1034 if {$i == $depth} {
1035 lset current $elem $data
1036 } elseif {$child != ""} {
1037 #puts "$sublist_num --> $current -- $child"
1038 set current [lreplace $current $sublist_num $sublist_num $child]
1041 lset whole [lindex $num_in $i] $current
1044 #puts "$i -- $current"
1045 #puts "$whole"
1047 set child $whole
1049 #set tempo [lreplace [Fetch_Cascade_Whole $alist $sublist_num $num $i 1] [lindex $num 0] [lindex $num 0] $current]
1050 #puts "$whole TEST --_-_->> [lindex $whole [lindex $num_in $i]]"
1052 set num [lrange $num 0 end-1]
1053 #puts "DEBUG -- $num"
1055 return $whole
1058 # in a cascading list/sublist variable, output a full list corresponding
1059 # to a certain depth and a number pattern.
1060 proc Fetch_Cascade_Whole {alist sublist_num num_in depth {relative 0}} {
1061 set i 0
1062 set num ""
1064 # we first reverse the num variable
1065 set i [llength $num_in]
1067 foreach item $num_in {
1068 set num [linsert $num 0 $item]
1071 set i 0
1073 #puts "Whole output : number -- [lindex $num $depth]"
1075 foreach item $alist {
1076 #puts "THERES #[llength $alist] elements total! ?$relative?"
1077 #puts "$i - [lindex $num $depth]"
1079 if {$i == [lindex $num $depth]} {
1081 #puts "PROCESSING -- $item"
1084 if {$depth == 0} {
1085 if {$relative == 0} {
1086 return $item
1087 } else {
1088 return $alist
1090 } else {
1091 return [Fetch_Cascade_Whole [lindex $item $sublist_num] $sublist_num $num_in [expr $depth - 1] $relative]
1095 incr i
1098 return -1
1101 # in a cascading list/sublist variable, output a single element
1102 # corresponding to a certain depth and a number pattern.
1103 proc Fetch_Cascade_Data {alist sublist_num elem num_in depth} {
1106 set output [Fetch_Cascade_Whole $alist $sublist_num $num_in $depth]
1108 if {$output != -1} {
1109 if {$elem >= 0 && $elem < [llength $output]} {
1110 return [lindex $output $elem]
1114 return -1
1117 proc parseFile {file config} {
1118 # gather 1 is used to gather the comment
1119 # data
1120 set gather1 ""
1121 # gather 2 is used to gather principally
1122 # function prototypes and in the future,
1123 # more.
1124 set gather2 ""
1125 # contains the current line number for use
1126 # by the code to know when a line changed
1127 set current_line 0
1128 #global MATCH_list
1130 #puts [subst $MATCH_list]
1132 set matchform [MATCH_format]
1135 # we loop line by line, string by string and character by character
1137 # we continue until eof to loop line by line
1138 while {[eof $file] == 0} {
1139 set line [gets $file]
1140 set a 0
1142 # count the number of characters in the line
1143 set line_len [string length $line]
1145 # loop string by string in the current line
1146 while {$a < $line_len} {
1147 set str [GetStringWord $line a]
1149 MATCH_process $str matchform
1152 # we increment the current number of lines
1153 incr current_line
1157 # returns 0 if theres no matching strings
1158 # and 1 if there is
1159 proc ParseString {string_indep string_depen} {
1160 # current matching characters
1161 set match 0
1162 set i 0
1163 set len [string length $string_depen]
1165 #puts "Checking String \"$string_indep\" over \"$string_depen\""
1167 # loop character by character in the current string
1168 while {$i < $len} {
1169 set char [string index $string_depen $i]
1170 set indep [string index $string_indep $match]
1172 #puts "depen $char indep $indep"
1174 if {$char == $indep} {
1175 incr match
1176 } else {
1178 # special case where we check the former character with this one to see
1179 # if it matches... if it matches, it means we might have a redundant
1180 # character which was primarily matched.
1182 # example : our indep string is */ and our input string is **/
1183 # without this code, the first * is matched then it checks the
1184 # second * over with / but it won't match and it restarts the check.
1185 # | |
1186 # */ **/ 1
1187 # | |
1188 # */ **/ 0 (so the algo restarts)
1189 # | |
1190 # */ **/ 0 (see, this is a bit false because it was
1191 # reset and thus the string wasn't matched.)
1193 if {$match > 0 && $char == [string index $string_indep [expr $match - 1]]} {
1194 set match 1
1195 } else {
1196 set match 0
1200 if {$match == [string length $string_indep]} {
1201 return 1
1204 incr i
1207 return 0
1210 proc parseConfig {file} {
1211 global use_config
1213 if { $use_config == 0} {
1214 # we output a default stock config
1215 set conf {{3} {"center footer"} {"left footer"} {"center header"}}
1216 return $conf
1217 } else {
1218 # we parse the configuration from the file
1219 set conf ""
1221 set fp [open $file r]
1223 while {[eof $fp] == 0} {
1224 set conf "$conf {[gets $fp]}"
1227 close $fp
1229 return $conf
1233 proc handleFiles {} {
1234 global files
1235 global individual
1236 global use_config
1237 global config
1239 if {$use_config == 1} {
1240 # we first check if the configuration file exists
1241 set fp [open $config r]
1242 close $fp
1245 # we check to see if the files exist or not
1246 foreach elem $files {
1247 set fp [open $elem r]
1249 close $fp
1252 # now we need to open each of them and parse their content
1253 foreach elem $files {
1254 set fp [open $elem r]
1256 parseFile $fp [parseConfig $config]
1258 close $fp
1262 proc main { } {
1263 set err [handleArgs]
1266 if {$err == 0} {
1267 exit
1270 handleFiles
1273 main