1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
#!/usr/bin/env perl
#
# David Bateman Feb 02 2003
#
# Extracts the help in texinfo format from *.cc and *.m files for use
# in documentation. Based on make_index script from octave_forge.
use strict;
use File::Find;
use File::Basename;
use FileHandle;
my $docdir = ".";
if (@ARGV) {
$docdir = @ARGV[0];
}
# locate all C++ and m-files in current directory
my @m_files = ();
my @C_files = ();
find(\&cc_and_m_files, $docdir);
sub cc_and_m_files { # {{{1 populates global array @files
return unless -f and /\.(m|cc)$/; # .m and .cc files
my $path = "$File::Find::dir/$_";
$path =~ s|^[.]/||;
if (/\.m$/) {
push @m_files, $path;
} else {
push @C_files, $path;
}
} # 1}}}
# grab help from C++ files
foreach my $f ( @C_files ) {
# XXX FIXME XXX. Should run the preprocessor over the file first, since
# the help might include defines that are compile dependent.
if ( open(IN,$f) ) {
while (<IN>) {
# skip to the next function
next unless /^DEFUN_DLD/;
# extract function name to pattern space
/\((\w*)\s*,/;
# remember function name
my $function = $1;
# skip to next line if comment doesn't start on this line
# XXX FIXME XXX maybe we want a loop here?
$_ = <IN> unless /\"/;
# skip to the beginning of the comment string by
# chopping everything up to opening "
my $desc = $_;
$desc =~ s/^[^\"]*\"//;
# join lines until you get the end of the comment string
# plus a bit more. You need the "plus a bit more" because
# C compilers allow implicitly concatenated string constants
# "A" "B" ==> "AB".
while ($desc !~ /[^\\]\"\s*\S/ && $desc !~ /^\"/) {
# if line ends in '\', chop it and the following '\n'
$desc =~ s/\\\s*\n//;
# join with the next line
$desc .= <IN>;
# eliminate consecutive quotes, being careful to ignore
# preceding slashes. XXX FIXME XXX what about \\" ?
$desc =~ s/([^\\])\"\s*\"/$1/;
}
$desc = "" if $desc =~ /^\"/; # chop everything if it was ""
$desc =~ s/\\n/\n/g; # insert fake line ends
$desc =~ s/([^\"])\".*$/$1/; # chop everything after final '"'
$desc =~ s/\\\"/\"/; # convert \"; XXX FIXME XXX \\"
$desc =~ s/$//g; # chop trailing ...
if (!($desc =~ /^\s*-[*]- texinfo -[*]-/)) {
my $err = sprintf("Function %s, does not contain texinfo help\n",
$function);
print STDERR "$err";
}
my $entry = sprintf("\037%s\n%s", $function, $desc);
print "$entry", "\n";
}
close (IN);
} else {
print STDERR "Could not open file ($f): $!\n";
}
}
# grab help from m-files
foreach my $f ( @m_files ) {
my $desc = extract_description($f);
my $function = basename($f, ('.m'));
die "Null function?? [$f]\n" unless $function;
if (!($desc =~ /^\s*-[*]- texinfo -[*]-/)) {
my $err = sprintf("Function %s, does not contain texinfo help\n",
$function);
print STDERR "$err";
}
my $entry = sprintf("\037%s\n%s", $function, $desc);
print "$entry", "\n";
}
sub extract_description { # {{{1
# grab the entire documentation comment from an m-file
my ($file) = @_;
my $retval = '';
if( open( IN, "$file")) {
# skip leading blank lines
while (<IN>) {
last if /\S/;
}
if( m/\s*[%\#][\s\#%]* Copyright/) {
# next block is copyright statement, skip it
while (<IN>) {
last unless /^\s*[%\#]/;
}
}
# Skip everything until the next comment block
while ( !/^\s*[\#%]/ ) {
$_ = <IN>;
last if not defined $_;
}
# Return the next comment block as the documentation
while (/^\s*[\#%]/) {
s/^[\s%\#]*//; # strip leading comment characters
s/[\cM\s]*$//; # strip trailing spaces.
s/[\.*]$//;
$retval .= "$_\n";
$_ = <IN>;
last if not defined $_;
}
close(IN);
return $retval;
}
else {
print STDERR "Could not open file ($file): $!\n";
}
} # 1}}}
|
