#!/usr/bin/scsh \
-e main -o srfi-13 -o srfi-14 -s
!#
;;; docfish --- Extract documentation as Texinfo macros

;; Copyright (C) 2005 Jorgen Schaefer

;; Author: Jorgen Schaefer <forcer@forcix.cx>

;; 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
;; of the License, 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 program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Commentary:

;; The problem of documentation is that it's either too small to
;; warrant a separate manual, so it fits within the source
;; file (like this), or that it's big enough to warrant a mostly
;; separate file documenting the design. The only information that's
;; shared between the source files and the documentation are the
;; documentations of functions. This small tool extracts those as
;; texinfo macros.

;; All continuous comments with three semicolons just before a
;; definition line is taken as the documentation for the defined
;; value. A Texinfo macro is emitted whose name is
;; DOC<thedefinname> (with many special chars removed, due to
;; Texinfo limitations). The output can be redirected into a file
;; which can serve as an include file for the Texinfo manual.

;; Comment lines with two semicolons are completely ignored -
;; contrary to other lines, they don't make docfish forget the
;; comment read so far, for example.

;;; Code:

(define (println . lines)
  (for-each display lines)
  (newline))

(define (main args)
  (if (null? (cdr args))
      (begin
        (println "Usage: docfish FILES ...")
        (exit 1)))
  (println "@c docfish generated documentation")
  (newline)
  (for-each (lambda (file)
              (println "@c file: " file)
              (newline)
              (docfish (open-input-file file)))
            (cdr args)))

(define r5rs-identifier
  (char-set-complement
   (char-set-union
    char-set:whitespace
    (char-set #\( #\) #\" #\;))))

(define (docfish port)
  (awk (read-line port) (line) ((doc '()))
    ((: bos ";;;" (? " ") (submatch (* any)))
     => (lambda (match)
          (cons (match:substring match 1)
                doc)))
    ((: bos "(define" (* ,r5rs-identifier) " " (? "(") (submatch (+ ,r5rs-identifier)))
     => (lambda (match)
          (if (not (null? doc))
              (emit-documentation (match:substring match 1)
                                  (reverse doc)))
          '()))
    ((: bos ";;")
     doc)
    (else
     '())))

(define (emit-documentation identifier documentation)
  (println "@c identifier: " identifier)
  (println "@macro DOC" (normalize-identifier identifier))
  (for-each println documentation)
  (println "@end macro")
  (newline))

(define (normalize-identifier identifier)
  (apply string-append
         (string-tokenize identifier char-set:letter)))