;;;; -*- Scheme -*-
;;;; $Header: /home/panda/pg/bevan/progs/elk/scm/RCS/scm2doc.scm,v 1.2 91/04/02 19:52:10 bevan Exp $
;;;+c
;;; Generate a documentation file from Scheme source.
;;; Requires the Scheme file to be formatted in a particular way.
;;;
;;; All functions to be included in the documentation should have a comment
;;; preceeding them containing a +f/-f around the section to appear in
;;; the output.
;;;
;;; All misc. section to appear in the output should be contained within
;;; +c/-c pairs.
;;;
;;; System : ELK
;;; System Specific Features :-
;;;   (error name string args ...)  ;; report an error
;;;   (require name)                ;; as in CommonLisp
;;;   (read-string port)            ;; read a line from a given port
;;;                                 ;; and return it
;;;-c 

(require 'ieee)
(require 'string-extensions)

;;;+f
;;; Set this to a string containing the comment style you prefer.
;;;-f
(define scm2doc:comment-prefix
  ";;;")

;;;+f
;;; Define this to be the width of the output text.
;;; Note currently that all this is used for is generating the title.
;;;-f
(define scm2doc:format-width
  79)

(define scm2doc:comment-prefix-len (string-length scm2doc:comment-prefix))
(define scm2doc:generic-comment-end (string-append scm2doc:comment-prefix "-"))
(define scm2doc:comment-start (string-append scm2doc:comment-prefix "+c"))
(define scm2doc:comment-end (string-append scm2doc:comment-prefix "-c"))
(define scm2doc:function-start (string-append scm2doc:comment-prefix "+f"))
(define scm2doc:function-end (string-append scm2doc:comment-prefix "-f"))

;;;+f
;;; Produce a documentation file `outfile' for the scheme file `infile'.
;;;-f
(define (scm2doc:main infile outfile)
  (let ((in-port (open-input-file infile))
	(out-port (open-output-file outfile)))
    (display (string-center infile scm2doc:format-width) out-port)
    (newline out-port)
    (scm2doc:extract-documentation in-port out-port)
    (close-input-port in-port)
    (close-output-port out-port)))

;;; Extract the documentation for the Scheme program on the input port
;;; `in-port' and write it to the output port `out-port'
;;; Returns : unspecified
;;;
(define (scm2doc:extract-documentation in-port out-port)
  (let loop ((line (read-string in-port)))
    (if (eof-object? line)
	#t
	(begin
	  (cond ((string-prefix? line scm2doc:comment-start)
		 (newline out-port)
		 (scm2doc:extract-commentary in-port out-port))
		((string-prefix? line scm2doc:function-start)
		 (newline out-port)
		 (scm2doc:extract-function in-port out-port)))
	  (loop (read-string in-port))))))

;;; Extract a comment section from the input port `in-port' and write
;;; it out to the output port `out-port'.  Initially the input should be on the
;;; first line of the comment section start.  After the comment has been read,
;;; the input will be such that the next line to be read will be the next
;;; line after the end of the comment.
;;; Returns : unspecified
;;;
(define (scm2doc:extract-commentary in-port out-port)
  (let loop ((line (read-string in-port)))
    (if (eof-object? line)
	(error 'scm2doc:extract-commentary "unexpected end of file"))
    (cond ((string-prefix? line scm2doc:comment-end) #t)
	  ((string-prefix? line scm2doc:comment-prefix)
	   (display (substring line scm2doc:comment-prefix-len (string-length line)) out-port)
	   (newline out-port)
	   (loop (read-string in-port)))
	  (else (error 'scm2doc:extract-commentary "invalid chars in commentary")))))

;;; Extract a function + comment from the input port `in-port' and output
;;; it on the output port `out-port'.  Initially the input should be on the
;;; first line of the functions comment.  After the comment and function 
;;; header have been read, the input will be such that the next line to be
;;; read will be the one after the function header.
;;; Returns : unspecified
;;;
(define (scm2doc:extract-function in-port out-port)
  (let ((comment (scm2doc:extract-comment in-port)))
    (newline out-port)
    (scm2doc:extract-function-header in-port out-port)
    (scm2doc:output-comment comment out-port)))

;;; Read a function header from the input port `in-port' and output it 
;;; to the output port `out-port'.  It expects the input to be somewhere
;;; before the line with the function name on it (all these lines will be 
;;; skipped).  It leaves the input such that the next line to be read would
;;; be the one after the function header.
;;; Returns : unspecified
;;; 
;;; This functions is currently quite primitive in the way it spots
;;; a function header.  It needs to be made much more general!
;;;
(define (scm2doc:extract-function-header in-port out-port)
  (let ((header (scm2doc:extract-skip-to "(define" in-port)))
    (let* ((brace (string-find-char header #\( 7))
	   (start (if brace (+ 1 brace) 8))
	   (end (if brace
		    (string-find-char header #\) brace)
		    (string-length header))))
      (display (substring header start end) out-port))))
	
;;; Assumes that the input is such that the next line to be read will
;;; be a comment line.  (The usuall place from which to call this is
;;; directly after you have found one of the comment prefix characters
;;; on the current line).  Successive lines are read until the end
;;; of the comment section is detected.  This line is discarded and
;;; all the comments read so far are returned as a list of strings (in 
;;; reverse order).  For example given the following :-
;;;
;;; ;;;+f
;;; ;;; first line of comment
;;; ;;; second line of comment
;;; ;;;-f
;;; ;;; misc line.
;;;
;;; and assuming that the line containg +f has already been read, this
;;; will return ((" second line of comment") (" first line of comment"))
;;; and the input will be such that the next line read will be the one
;;; containing "misc line."
;;; Returns : unspecified
;;;
(define (scm2doc:extract-comment in-port)
  (let loop ((line (read-string in-port)) (comment '()))
    (if (eof-object? line)
	(error 'scm2doc:extract-comment "unexpected end of file"))
    (if (< (string-length line) scm2doc:comment-prefix-len)
	(error 'scm2doc:extract-comment "malformed line"))
    (cond ((string-prefix? line scm2doc:generic-comment-end) comment)
	  ((string-prefix? line scm2doc:comment-prefix)
	   (loop
	    (read-string in-port)
	    (cons (substring line
			     scm2doc:comment-prefix-len
			     (string-length line))
		  comment)))
	   (else (error 'scm2doc:extract-comment "malformed line")))))

;;; Output the list of strings in `comment' on the output port `out-port'
;;; Note it expects the list to be in reverse order!
;;; Returns : unspecified
;;;
(define (scm2doc:output-comment comment out-port)
  (if (not (null? comment))
      (begin
	(scm2doc:output-comment (cdr comment) out-port)
	(newline out-port)
	(display (car comment) out-port))))

;;; Keeps reading and discarding lines, until the start of `line' matches
;;; `str'.  At which point it returns the line.
;;; Returns : string
;;;
(define (scm2doc:extract-skip-to str in-port)
  (let loop ((line (read-string in-port)))
    (if (eof-object? line)
	(error 'extract-skip-to "unexpected-end-of-file"))
    (if (string-prefix? line str)
	line
	(loop (read-string in-port)))))
