--- /dev/null
+# Copyright (C) 1999, 2000, 2001, 2006 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this software; see the file COPYING. If not, write to
+# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+# Boston, MA 02110-1301 USA
+#
+# Written by Greg J. Badros, <gjb@cs.washington.edu>
+# 12-Dec-1999
+
+BEGIN { FS="|";
+ dot_doc_file = ARGV[1]; ARGV[1] = "-";
+ std_err = "/dev/stderr";
+ # be sure to put something in the files to help make out
+ print "";
+ printf "" > dot_doc_file;
+}
+
+/^[ \t]*SCM_SNARF_INIT_START/ { copy = $0;
+ gsub(/[ \t]*SCM_SNARF_INIT_START/, "", copy);
+ gsub(/SCM_SNARF_DOC_START.*$/, "", copy);
+ print copy; }
+
+/SCM_SNARF_DOC_START/,/SCM_SNARF_DOCSTRING_START/ { copy = $0;
+ if (match(copy,/SCM_SNARF_DOC_STARTR/)) { registering = 1; }
+ else {registering = 0; }
+ gsub(/.*SCM_SNARF_DOC_START./,"", copy);
+ gsub(/SCM_SNARF_DOCSTRING_START.*/,"",copy);
+ gsub(/[ \t]+/," ", copy);
+ sub(/^[ \t]*/,"(", copy);
+ gsub(/\"/,"",copy);
+ sub(/\([ \t]*void[ \t]*\)/,"()", copy);
+ sub(/ \(/," ",copy);
+ numargs = gsub(/SCM /,"", copy);
+ numcommas = gsub(/,/,"", copy);
+ numactuals = $2 + $3 + $4;
+ location = $5;
+ gsub(/\"/,"",location);
+ sub(/^[ \t]*/,"",location);
+ sub(/[ \t]*$/,"",location);
+ sub(/: /,":",location);
+ sub(/^\.\//,"",location);
+ # Now whittle copy down to just the $1 field
+ # (but do not use $1, since it hasn't been
+ # altered by the above regexps)
+ gsub(/[ \t]*\|.*$/,"",copy);
+ sub(/ \)/,")",copy);
+ # Now `copy' contains the nice scheme proc "prototype", e.g.
+ # (set-car! pair value)
+ # Since this is destined to become Texinfo source,
+ # quote any `@'s that occur in the prototype.
+ gsub(/\@/,"@@",copy);
+ # print copy > "/dev/stderr"; # for debugging
+ sub(/^\(/,"",copy);
+ sub(/\)[ \t]*$/,"",copy);
+ proc_and_args = copy;
+ curr_function_proto = copy;
+ proc_name = copy;
+ sub(/ .*$/,"",proc_name);
+ sub(/[^ \n]* /,"",proc_and_args);
+ split(proc_and_args,args," ");
+ # now args is an array of the arguments
+ # args[1] is the formal name of the first argument, etc.
+ if (numargs != numactuals && !registering)
+ { print location ":*** `" curr_function_proto "' is improperly registered as having " numactuals " arguments" > std_err; }
+ # Build a nicer function prototype than curr_function_proto
+ # that shows optional and rest arguments.
+ nicer_function_proto = proc_name;
+ if (!registering) {
+ optional_args_tail = "";
+ for (i = 1; i <= $2; i++) {
+ nicer_function_proto = nicer_function_proto " " args[i];
+ }
+ for (; i <= $2 + $3; i++) {
+ nicer_function_proto = nicer_function_proto " [" args[i];
+ optional_args_tail = optional_args_tail "]";
+ }
+ nicer_function_proto = nicer_function_proto optional_args_tail;
+ if ($4 != 0) {
+ nicer_function_proto = nicer_function_proto " . " args[i];
+ }
+ }
+ # Now produce Texinfo format output.
+ print "\n\f" proc_name > dot_doc_file;
+ print "@c snarfed from " location > dot_doc_file;
+ print "@deffn primitive " nicer_function_proto > dot_doc_file;
+}
+
+/SCM_SNARF_DOCSTRING_START/,/SCM_SNARF_DOCSTRING_END.*$/ { copy = $0;
+
+ # Trim everything up to and including
+ # SCM_SNARF_DOCSTRING_START marker.
+ gsub(/.*SCM_SNARF_DOCSTRING_START/,"",copy);
+
+ # Trim leading whitespace and opening quote.
+ sub(/^[ \t]*\"?/,"", copy);
+
+ # Trim closing quote and trailing whitespace, or
+ # closing quote and whitespace followed by the
+ # SCM_SNARF_DOCSTRING_END marker.
+ sub(/[ \t]*\"?[ \t]*$/,"", copy);
+ sub(/[ \t]*\"?[ \t]*SCM_SNARF_DOCSTRING_END.*$/,"", copy);
+
+ # Replace escaped characters.
+ gsub(/\\n/,"\n",copy);
+ gsub(/\\\"/,"\"",copy);
+ gsub(/\\\\/,"\\",copy);
+
+ # Some docstrings end each line with "\n", while
+ # others don't. Therefore we always strip off one "\n"
+ # if present at the end of the line. Docstrings must
+ # therefore always use "\n\n" to indicate a blank line.
+ if (copy != "")
+ {
+ sub(/[ \t]*\n$/, "", copy);
+ print copy > dot_doc_file;
+ }
+ }
+
+/SCM_SNARF_DOCSTRING_END[ \t]*/ { print "@end deffn" >> dot_doc_file; }
+
+/\*&\*&\*&\*SCM_ARG_BETTER_BE_IN_POSITION/ { copy = $0;
+ sub(/.*\*&\*&\*&\*SCM_ARG_BETTER_BE_IN_POSITION\([ \t]*/,"",copy);
+ if (copy ~ /\"/) { next }
+ gsub(/[ \t]*,[ \t]*/,":",copy);
+ sub(/[ \t]*\).*/,"",copy);
+ split(copy,argpos,":");
+ argname = argpos[1];
+ pos = argpos[2];
+ if (pos ~ /[A-Za-z]/) { next }
+ if (pos ~ /^[ \t]*$/) { next }
+ if (argname ~ / /) { next }
+ line = argpos[3];
+# print pos " " args[pos] " vs. " argname > "/dev/stderr";
+ if (args[pos] != argname) { print filename ":" line ":*** Argument name/number mismatch in `" curr_function_proto "' -- " argname " is not formal #" pos > "/dev/stderr"; }
+ }