#!/usr/bin/guile \
-e "(scripts h2doc)" -s
!#
;;; h2doc --- Extract documentation from .h files

;;	Copyright (C) 2003,2004 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.
;;
;; As a special exception, the Free Software Foundation gives permission
;; for additional uses of the text contained in its release of GUILE.
;;
;; The exception is that, if you link the GUILE library with other files
;; to produce an executable, this does not by itself cause the
;; resulting executable to be covered by the GNU General Public License.
;; Your use of that executable is in no way restricted on account of
;; linking the GUILE library code into it.
;;
;; This exception does not however invalidate any other reasons why
;; the executable file might be covered by the GNU General Public License.
;;
;; This exception applies only to the code released by the
;; Free Software Foundation under the name GUILE.  If you copy
;; code from other Free Software Foundation releases into a copy of
;; GUILE, as the General Public License permits, the exception does
;; not apply to the code that you add in this way.  To avoid misleading
;; anyone as to the status of such modified files, you must delete
;; this exception notice from them.
;;
;; If you write modifications of your own for GUILE, it is your choice
;; whether to permit this exception to apply to your modifications.
;; If you do not wish that, delete this exception notice.

;;; Author: Thien-Thi Nguyen <ttn@gnu.org>

;;; Commentary:

;; Usage: h2doc [-o OUTFILE] HEADER
;;
;; Scan file HEADER for docstrings and display them to stdout in GDFv1 format.
;; Optional arg --output OUTFILE means write output to OUTFILE instead of to
;; stdout.
;;
;; Currently only C macros are recognized.  They must be in the form:
;;
;; /*:DOCSTRING-1
;;    ...
;;    DOCSTRING-N
;; */
;; #define MACRO(ARGS,...) ...
;;
;; Specifically, the "/*:", the closing "*/" and the "#define" must begin in
;; column zero (flush left).  The macro's arguments must be on the same line.
;; The docstring comprises lines DOCSTRING-1 through DOCSTRING-N, with the
;; first three characters deleted.
;;
;;
;; TODO: Handle other elements besides macros.
;;       Parameterize input format recognition.

;;; Code:

;; (debug-enable 'debug 'backtrace)

(define-module (scripts h2doc)
  #:autoload (scripts PROGRAM) (HVQC-MAIN)
  #:autoload (ice-9 rdelim) (read-line)
  #:export ())

(define (format-doc-proc outp file)
  (lambda (doc)
    (let ((thing (car doc))
          (line-number (cadr doc)))
      (simple-format outp "\f\n")
      (simple-format
       outp "~A\n"
       (cond ((and (< 9 (string-length thing))
                   (string=? (substring thing 0 8) "#define "))
              (let ((new (substring thing 8)))
                (cond ((string-index new #\()
                       => (lambda (pos)
                            (string-set! new pos #\space))))
                (let loop ((pos (string-index new #\,)))
                  (and pos (begin
                             (string-set! new pos #\space)
                             (loop (string-index new #\, pos)))))
                (cond ((string-index new #\))
                       => (lambda (pos)
                            (set! new (substring new 0 (1+ pos))))))
                (string-append "(" new)))
             (else (simple-format #f "(UNKNOWN-THING ~S)" thing))))
      (for-each (lambda (x)
                  (display x outp)
                  (newline outp))
                (cddr doc))
      (display #\soh outp)
      (simple-format outp "[~A:~A]\n" file line-number))))

(define (h2doc/qop qop)
  ;;(simple-format #t "(qop #:full-args) => ~S\n" (qop #:full-args))
  ;;(simple-format #t "(qop #:parsed-full) => ~S\n" (qop #:parsed-full))
  ;;(simple-format #t "(qop #:parsed-opts) => ~S\n" (qop #:parsed-opts))
  (let* ((inp (if (pair? (qop '()))
                  (open-input-file (car (qop '())))
                  (error "no input file specified")))
         (count 0)
         (next (lambda () (set! count (1+ count)) (read-line inp)))
         (docs '()))
    (let loop ((line (next)) (acc #f))
      (cond ((eof-object? line))
            ((and (not acc)
                  (< 3 (string-length line))
                  (char=? #\/ (string-ref line 0))
                  (char=? #\* (string-ref line 1))
                  (char=? #\: (string-ref line 2)))
             (loop (next) (list (substring line 3))))
            ((and acc (string=? "*/" line))
             (let ((thing (next)))
               (set! docs (acons thing (cons count (reverse acc)) docs)))
             (loop (next) #f))
            (acc
             (loop (next) (cons (if (< 3 (string-length line))
                                    (substring line 3)
                                    line)
                                acc)))
            (else
             (loop (next) acc))))
    (for-each (format-doc-proc (or (qop 'output open-output-file)
                                   (current-output-port))
                               (port-filename inp))
              docs)
    (close-port inp)))

(define (main args)
  (HVQC-MAIN args h2doc/qop
             '(usage . commentary)
             '(package . "Guile")
             '(option-spec (output (single-char #\o) (value #t)))))

;;; h2doc ends here
