#! /bin/sh
exec ../src/sizzle -s $0 $*
!#
;; scripts/extract-docstrings -- extract docstrings from C source files.
;;
;; Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;
;; This 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 software 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 package; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.  

;; Invoke this script with all files from which docstrings should be
;; extracted on the command line.
;;
;; The docstrings currently recognized must begin with `/*:doc' on one
;; line (without the quotes of course) and end with `doc:*/' on a line
;; of its own.  The strings are written to standard out, separated
;; with form the feed character ^L.
;;
;; The docstrings read from source files are expected to be in texinfo
;; format.  Some simple format conversions will be done: Strings of
;; the form @var{foo} will be converted to `foo', and @@ will be
;; converted to a single @.

(use-modules (core string-lib))

(define start-rx (make-regexp ":doc"))
(define end-rx (make-regexp "doc:"))


;; Display usage information for the script.

(define (help)
  (display "Usage: extract-docstrings.scm INFILE...\n"))


;; Read all docstrings from the input port `in-port' and return them
;; in a list.

(define (read-docstrings in-port)
  (let skip-loop ((strings '()) (lno 0))
    (let ((line (read-line in-port)))
      (cond ((eof-object? line)
             (reverse strings))
            ((regexp-exec start-rx line)
             (let collect-loop ((strings strings) (string "") (lno (+ lno 1)))
               (let ((line (read-line in-port)))
		 (cond ((eof-object? line)
			(reverse strings))
		       ((regexp-exec end-rx line)
			(skip-loop (cons 
				    (cons (string-append
					   (trim-whitespace string) "\n")
					  (+ lno 3))
					  strings)
				   (+ lno 1)))
		       (else (collect-loop
			      strings
			      (string-append string 
					     (trim-whitespace line) "\n")
			      (+ lno 1)))))))
            (else
             (skip-loop strings (+ lno 1)))))))
                     

;;; Convert the given docstring `orig' from texinfo format to
;;; something more suitable for displaying on a terminal.

(define (format-docstring orig)
  (let loop ((source (string->list orig)) (dest '()))
    (if (null? source)
	(list->string (reverse! dest))
	(let ((cur-char (car source)))
	  (if (char=? cur-char #\@)
	      (if (and (pair? source) (char=? (cadr source) #\@))
		  (loop (cddr source) (cons #\@ dest))
		  (let lp ((source (cdr source)) (dest dest))
		    (cond ((null? source)
			   (loop source dest))
			  ((char=? (car source) #\{)
			   (let lp0 ((source (cdr source))
				     (dest (cons #\` dest)))
			     (cond ((null? source)
				    (loop source dest))
				   ((char=? (car source) #\})
				    (loop (cdr source) (cons #\' dest)))
				   (else
				    (lp0 (cdr source) 
					 (cons (car source) dest))))))
			  (else
			   (lp (cdr source) dest)))))
	      (loop (cdr source) (cons cur-char dest)))))))


;; Write all docstrings in `strings', which are annotated with source
;; line numbers, to the output port `out-port'.  `filename' is the
;; name of the source file and will be printed along with the
;; extraction line number.

(define (write-docstrings out-port filename strings)
  (let ((fname (basename filename)))
    (for-each (lambda (pair)
		(display (format-docstring (car pair)) out-port)
		(display "[" out-port)
		(display fname out-port)
		(display ":" out-port)
		(display (cdr pair) out-port)
		(display "]\n" out-port)
		(display "\f\n" out-port))
	      strings))
  (display (length strings) (current-error-port))
  (display " docstrings extracted\n" (current-error-port)))

(define (handle-docstrings infile)
  (let ((docstrings (call-with-input-file infile read-docstrings)))
    (write-docstrings (current-output-port) infile docstrings)))

(define (handle-command-line command-line)
  (cond ((> (length command-line) 1)
         (for-each handle-docstrings (cdr command-line)))
        (else
         (help))))

(handle-command-line (command-line))
