1 # Copyright (C) 1999, 2000 Free Software Foundation, Inc.
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 2, or (at your option)
8 # This program is distributed in the hope that it will be useful,
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 # GNU General Public License for more details.
13 # You should have received a copy of the GNU General Public License
14 # along with this software; see the file COPYING. If not, write to
15 # the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 # Boston, MA 02111-1307 USA
18 # Written by Greg J. Badros, <gjb@cs.washington.edu>
22 dot_doc_file =
ARGV[1]; ARGV[1] =
"-";
23 std_err =
"/dev/stderr";
24 # be sure to put something in the files to help make out
26 printf "" > dot_doc_file
;
29 /^
[ \t]*SCM_SNARF_INIT_START
/ { copy = $
0;
30 gsub(/[ \t]*SCM_SNARF_INIT_START
/, "", copy
);
31 gsub(/SCM_SNARF_DOC_START.
*$
/, "", copy
);
34 /SCM_SNARF_DOC_START
/,/SCM_SNARF_DOCSTRING_START
/ { copy = $
0;
35 if (match(copy
,/SCM_SNARF_DOC_STARTR
/)) { registering =
1; }
36 else {registering =
0; }
37 gsub(/.
*SCM_SNARF_DOC_START.
/,"", copy
);
38 gsub(/SCM_SNARF_DOCSTRING_START.
*/,"",copy
);
39 gsub(/[ \t]+/," ", copy
);
40 sub(/^
[ \t]*/,"(", copy
);
42 sub(/\
([ \t]*void
[ \t]*\
)/,"()", copy
);
44 numargs =
gsub(/SCM
/,"", copy
);
45 numcommas =
gsub(/,/,"", copy
);
46 numactuals = $
2 + $
3 + $
4;
48 gsub(/\"/,"",location
);
49 sub(/^
[ \t]*/,"",location
);
50 sub(/[ \t]*$
/,"",location
);
51 sub(/: /,":",location
);
52 sub(/^\.\
//,"",location
);
53 # Now whittle copy down to just the $1 field
54 # (but do not use $1, since it hasn't been
55 # altered by the above regexps)
56 gsub(/[ \t]*\
|.
*$
/,"",copy
);
58 # Now `copy' contains the nice scheme proc "prototype", e.g.
59 # (set-car! pair value)
60 # Since this is destined to become Texinfo source,
61 # quote any `@'s that occur in the prototype.
63 # print copy > "/dev/stderr"; # for debugging
65 sub(/\
)[ \t]*$
/,"",copy
);
67 curr_function_proto = copy
;
69 sub(/ .
*$
/,"",proc_name
);
70 sub(/[^
\n]* /,"",proc_and_args
);
71 split(proc_and_args
,args
," ");
72 # now args is an array of the arguments
73 # args[1] is the formal name of the first argument, etc.
74 if (numargs
!= numactuals
&& !registering
)
75 { print location
":*** `" curr_function_proto
"' is improperly registered as having " numactuals
" arguments" > std_err
; }
76 # Build a nicer function prototype than curr_function_proto
77 # that shows optional and rest arguments.
78 nicer_function_proto = proc_name
;
80 optional_args_tail =
"";
81 for (i =
1; i
<= $
2; i
++) {
82 nicer_function_proto = nicer_function_proto
" " args
[i
];
84 for (; i
<= $
2 + $
3; i
++) {
85 nicer_function_proto = nicer_function_proto
" [" args
[i
];
86 optional_args_tail = optional_args_tail
"]";
88 nicer_function_proto = nicer_function_proto optional_args_tail
;
90 nicer_function_proto = nicer_function_proto
" . " args
[i
];
93 # Now produce Texinfo format output.
94 print "\n\f" proc_name
> dot_doc_file
;
95 print "@c snarfed from " location
> dot_doc_file
;
96 print "@deffn primitive " nicer_function_proto
> dot_doc_file
;
99 /SCM_SNARF_DOCSTRING_START
/,/SCM_SNARF_DOCSTRING_END.
*$
/ { copy = $
0;
101 # Trim everything up to and including
102 # SCM_SNARF_DOCSTRING_START marker.
103 gsub(/.
*SCM_SNARF_DOCSTRING_START
/,"",copy
);
105 # Trim leading whitespace and opening quote.
106 sub(/^
[ \t]*\"?
/,"", copy
);
108 # Trim closing quote and trailing whitespace, or
109 # closing quote and whitespace followed by the
110 # SCM_SNARF_DOCSTRING_END marker.
111 sub(/[ \t]*\"?
[ \t]*$
/,"", copy
);
112 sub(/[ \t]*\"?
[ \t]*SCM_SNARF_DOCSTRING_END.
*$
/,"", copy
);
114 # Replace escaped characters.
115 gsub(/\\n
/,"\n",copy
);
116 gsub(/\\\"/,"\"",copy
);
117 gsub(/\\\\/,"\\",copy
);
119 # Some docstrings end each line with "\n", while
120 # others don't. Therefore we always strip off one "\n"
121 # if present at the end of the line. Docstrings must
122 # therefore always use "\n\n" to indicate a blank line.
125 sub(/[ \t]*\n$
/, "", copy
);
126 print copy
> dot_doc_file
;
130 /SCM_SNARF_DOCSTRING_END
[ \t]*/ { print "@end deffn" >> dot_doc_file
; }
132 /\
*&\
*&\
*&\
*SCM_ARG_BETTER_BE_IN_POSITION
/ { copy = $
0;
133 sub(/.
*\
*&\
*&\
*&\
*SCM_ARG_BETTER_BE_IN_POSITION\
([ \t]*/,"",copy
);
134 if (copy ~
/\"/) { next }
135 gsub(/[ \t]*,[ \t]*/,":",copy
);
136 sub(/[ \t]*\
).
*/,"",copy
);
137 split(copy
,argpos
,":");
140 if (pos ~
/[A
-Za
-z
]/) { next }
141 if (pos ~
/^
[ \t]*$
/) { next }
142 if (argname ~
/ /) { next }
144 # print pos " " args[pos] " vs. " argname > "/dev/stderr";
145 if (args
[pos
] != argname
) { print filename ":" line
":*** Argument name/number mismatch in `" curr_function_proto
"' -- " argname
" is not formal #" pos
> "/dev/stderr"; }