4944
|
1 #!/usr/bin/env perl |
|
2 # |
|
3 # David Bateman Feb 02 2003 |
|
4 # |
|
5 # Extracts the help in texinfo format from *.cc and *.m files for use |
|
6 # in documentation. Based on make_index script from octave_forge. |
|
7 |
|
8 use strict; |
|
9 use File::Find; |
|
10 use File::Basename; |
|
11 use FileHandle; |
|
12 |
|
13 my $docdir = "."; |
|
14 if (@ARGV) { |
|
15 $docdir = @ARGV[0]; |
|
16 } |
|
17 |
|
18 # locate all C++ and m-files in current directory |
|
19 my @m_files = (); |
|
20 my @C_files = (); |
|
21 find(\&cc_and_m_files, $docdir); |
|
22 |
|
23 sub cc_and_m_files { # {{{1 populates global array @files |
|
24 return unless -f and /\.(m|cc)$/; # .m and .cc files |
|
25 my $path = "$File::Find::dir/$_"; |
|
26 $path =~ s|^[.]/||; |
|
27 if (/\.m$/) { |
|
28 push @m_files, $path; |
|
29 } else { |
|
30 push @C_files, $path; |
|
31 } |
|
32 } # 1}}} |
|
33 |
|
34 # grab help from C++ files |
|
35 foreach my $f ( @C_files ) { |
|
36 # XXX FIXME XXX. Should run the preprocessor over the file first, since |
|
37 # the help might include defines that are compile dependent. |
|
38 if ( open(IN,$f) ) { |
|
39 while (<IN>) { |
|
40 # skip to the next function |
|
41 next unless /^DEFUN_DLD/; |
|
42 |
|
43 # extract function name to pattern space |
|
44 /\((\w*)\s*,/; |
|
45 # remember function name |
|
46 my $function = $1; |
|
47 # skip to next line if comment doesn't start on this line |
|
48 # XXX FIXME XXX maybe we want a loop here? |
|
49 $_ = <IN> unless /\"/; |
|
50 # skip to the beginning of the comment string by |
|
51 # chopping everything up to opening " |
|
52 my $desc = $_; |
|
53 $desc =~ s/^[^\"]*\"//; |
|
54 # join lines until you get the end of the comment string |
|
55 # plus a bit more. You need the "plus a bit more" because |
|
56 # C compilers allow implicitly concatenated string constants |
|
57 # "A" "B" ==> "AB". |
|
58 while ($desc !~ /[^\\]\"\s*\S/ && $desc !~ /^\"/) { |
|
59 # if line ends in '\', chop it and the following '\n' |
|
60 $desc =~ s/\\\s*\n//; |
|
61 # join with the next line |
|
62 $desc .= <IN>; |
|
63 # eliminate consecutive quotes, being careful to ignore |
|
64 # preceding slashes. XXX FIXME XXX what about \\" ? |
|
65 $desc =~ s/([^\\])\"\s*\"/$1/; |
|
66 } |
|
67 $desc = "" if $desc =~ /^\"/; # chop everything if it was "" |
|
68 $desc =~ s/\\n/\n/g; # insert fake line ends |
|
69 $desc =~ s/([^\"])\".*$/$1/; # chop everything after final '"' |
|
70 $desc =~ s/\\\"/\"/; # convert \"; XXX FIXME XXX \\" |
|
71 $desc =~ s/$//g; # chop trailing ... |
|
72 |
|
73 if (!($desc =~ /^\s*-[*]- texinfo -[*]-/)) { |
|
74 my $err = sprintf("Function %s, does not contain texinfo help\n", |
|
75 $function); |
|
76 print STDERR "$err"; |
|
77 } |
|
78 my $entry = sprintf("\037%s\n%s", $function, $desc); |
|
79 print "$entry", "\n"; |
|
80 } |
|
81 close (IN); |
|
82 } else { |
|
83 print STDERR "Could not open file ($f): $!\n"; |
|
84 } |
|
85 } |
|
86 |
|
87 # grab help from m-files |
|
88 foreach my $f ( @m_files ) { |
|
89 my $desc = extract_description($f); |
|
90 my $function = basename($f, ('.m')); |
|
91 die "Null function?? [$f]\n" unless $function; |
|
92 if (!($desc =~ /^\s*-[*]- texinfo -[*]-/)) { |
|
93 my $err = sprintf("Function %s, does not contain texinfo help\n", |
|
94 $function); |
|
95 print STDERR "$err"; |
|
96 } |
|
97 my $entry = sprintf("\037%s\n%s", $function, $desc); |
|
98 print "$entry", "\n"; |
|
99 } |
|
100 |
|
101 sub extract_description { # {{{1 |
|
102 # grab the entire documentation comment from an m-file |
|
103 my ($file) = @_; |
|
104 my $retval = ''; |
|
105 |
|
106 if( open( IN, "$file")) { |
|
107 # skip leading blank lines |
|
108 while (<IN>) { |
|
109 last if /\S/; |
|
110 } |
|
111 if( m/\s*[%\#][\s\#%]* Copyright/) { |
|
112 # next block is copyright statement, skip it |
|
113 while (<IN>) { |
|
114 last unless /^\s*[%\#]/; |
|
115 } |
|
116 } |
|
117 # Skip everything until the next comment block |
|
118 while ( !/^\s*[\#%]/ ) { |
|
119 $_ = <IN>; |
|
120 last if not defined $_; |
|
121 } |
|
122 # Return the next comment block as the documentation |
|
123 while (/^\s*[\#%]/) { |
|
124 s/^[\s%\#]*//; # strip leading comment characters |
|
125 s/[\cM\s]*$//; # strip trailing spaces. |
|
126 s/[\.*]$//; |
|
127 $retval .= "$_\n"; |
|
128 $_ = <IN>; |
|
129 last if not defined $_; |
|
130 } |
|
131 close(IN); |
|
132 return $retval; |
|
133 } |
|
134 else { |
|
135 print STDERR "Could not open file ($file): $!\n"; |
|
136 } |
|
137 } # 1}}} |
|
138 __END__ |
|
139 This program is free software; you can redistribute it and/or modify |
|
140 it under the terms of the GNU General Public License as published by |
|
141 the Free Software Foundation; either version 2 of the License, or |
|
142 (at your option) any later version. |
|
143 This program is distributed in the hope that it will be useful, |
|
144 but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
145 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
146 GNU General Public License for more details. |
|
147 You should have received a copy of the GNU General Public License |
|
148 along with this program; if not, see <http://www.gnu.org/licenses/>. |
|
149 This program is granted to the public domain. |
|
150 THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND |
|
151 ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
|
152 IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
|
153 ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE |
|
154 FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
|
155 DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS |
|
156 OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) |
|
157 HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
|
158 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
|
159 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
|
160 SUCH DAMAGE. |