;;; Guile bindings for Mutt
;;; Copyright (C) 2003  Ludovic Courtès

;;; 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., 675 Mass Ave, Cambridge, MA 02139, USA.


;;; Automatic GNU Texinfo documentation generation.
;;; Depending on what Mutt modules are loaded, output a Texinfo file.

(mutt-module (mutt make-doc)
	     #:documentation
"The @code{(mutt make-doc)} module provides commands to automatically
generate GNU Texinfo documentation files for the modules loaded at
the time the command is invoked.  The @code{makeinfo} program (from
the GNU Texinfo package) may then be used to produce documentation in
various formats including Info, HTML, and DocBook.")


(define-public makeinfo-command "makeinfo")

(register-option! "makeinfo-command" #f #f
		  "Command to run `makeinfo' (from GNU Texinfo).")

(define-command (make-texi-doc argstring)
  "Output to the given file a Texinfo documentation of available commands,
functions and options."
  (let ((args (split-argument-string argstring)))
    (if (= 1 (length args))
	(let ((filename (expand-path (car args))))
	  (output-documentation filename))
	(if (= 0 (length args))
	    (ui-message "Usage: make-texi-doc <filename>")
	    (ui-message "Too many arguments.")))))

(define-command (make-html-doc argstring)
  "Output to the given file a HTML documentation of available commands,
functions and options."
  (let ((args (split-argument-string argstring)))
    (if (= 1 (length args))
	(let* ((filename (expand-path (car args)))
	       (texi-filename (string-append filename ".texi")))
	  (if (output-documentation texi-filename)
	      (system (string-append makeinfo-command
				     " --html --no-split -o "
				     filename " " texi-filename))
	      #f))
	(if (= 0 (length args))
	    (ui-message "Usage: make-html-doc <filename>")
	    (ui-message "Too many arguments.")))))

(define-command (make-info-doc argstring)
  "Output to the given file an info documentation of available commands,
functions and options."
  (let ((args (split-argument-string argstring)))
    (if (= 1 (length args))
	(let* ((filename (expand-path (car args)))
	       (texi-filename (string-append filename ".texi")))
	  (if (output-documentation texi-filename)
	      (system (string-append makeinfo-command
				     " -o " filename " " texi-filename))
	      #f))
	(if (= 0 (length args))
	    (ui-message "Usage: make-info-doc <filename>")
	    (ui-message "Too many arguments.")))))

(define-command (make-doc argstring)
  "Output to the given file a Texinfo documentation of available commands,
functions and options."
  (make-texi-doc argstring))



(define-public (commands-documentation)
  "Return a list of module-name/command-list pairs.  Each command
list is itself a list of command-name/doc-string pairs."
  (hash-fold (lambda (name proc command-alist)
	       (let* ((doc (object-documentation proc))
		      (modname (format #f "~a"
				       (module-name
					(environment-module
					 (procedure-environment
					  proc)))))
		      (modcmds (assoc-ref command-alist modname)))
		 (if (not modcmds) (set! modcmds '()))
		 (if modname
		     (acons modname
			    (acons name
				   (if doc doc
				       "No documentation available.")
				   modcmds)
			    command-alist)
		     command-alist)))
	     '()
	     mutt-scheme-commands))

(define-public (functions-documentation)
  "Return a list of module-name/function-list pairs.  Each function
list is itself a list of function-name/doc-string pairs."
  (hash-fold (lambda (name proc function-alist)
	       (let* ((doc (object-documentation proc))
		      (modname (format #f "~a"
				       (module-name
					(environment-module
					 (procedure-environment
					  proc)))))
		      (modcmds (assoc-ref function-alist modname)))
		 (if (not modcmds) (set! modcmds '()))
		 (if modname
		     (acons modname
			    (acons name
				   (if doc doc
				       "No documentation available.")
				   modcmds)
			    function-alist)
		     function-alist)))
	     '()
	     mutt-scheme-functions))


(define-public (options-documentation)
  "Return a list of module-name/option-list pairs.  Each option list
is itself a list of option-name/doc-string pairs."
  (hash-fold (lambda (name description option-alist)
	       (let* ((doc (option-documentation description))
		      (modname (format #f "~a"
				       (module-name (option-module
						     description))))
		      (modopts (assoc-ref option-alist modname)))
		 (if (not modopts) (set! modopts '()))
;		 (if (not (null? modopts))
;		     (format #t "modopts =  ~a\n\n\n" modopts))
;		 (format #t "opt-alist: ~a\n\n" option-alist)
		 (if modname
		     (acons modname
			    (acons name doc modopts)
			    option-alist)
		     option-alist)))
	     '()
	     mutt-scheme-options))

(define-public (module-documentation modname
				     command-list function-list option-list)
  "Based on the system-wide documentation lists @var{command-list},
etc., return a list of three alist containing resp. the command alist,
the function alist, and the options alist for module
@var{modname}."
  (if modname
      (let ((commands  (assoc-ref command-list  modname))
	    (functions (assoc-ref function-list modname))
	    (options   (assoc-ref option-list   modname)))
	(append '()
		(list (if commands commands '()))
		(list (if functions functions '()))
		(list (if options options '()))))
      #f))

(define-public (output-category-documentation file texi-tag option-list)
  "Write to port @var{file} documentation for the items in alist
@var{option-list}. The string @var{texi-tag} refers to the GNU Texinfo
tag that should be used to introduce these items."
  (map (lambda (option-pair)
	 (format file "~a{~a}\n~a\n\n"
		 texi-tag (car option-pair) (cdr option-pair)))
       option-list))

(define-public (remove-doubles lst)
  "Return a list where any element that appears more than once in list
@var{lst} only appears one."
  (define (do-remove-doubles new-lst lst)
    (if (null? lst)
	new-lst
	(if (member (car lst) new-lst)
	    (do-remove-doubles new-lst (cdr lst))
	    (do-remove-doubles (append new-lst (list (car lst)))
			       (cdr lst)))))
  (do-remove-doubles '() lst))

(define-public (output-module-menu file modname commands functions options)
  "Output to port @var{file} the menu for module @var{modname}."
  (display "@menu\n" file)
  (if (not (null? commands))
      (begin
	(format file "* Commands for @code{~a}::         " modname)
	(format file "Commands defined by @code{~a}\n" modname)))
  (if (not (null? functions))
      (begin
	(format file "* Functions for @code{~a}::        " modname)
	(format file "Functions defined by @code{~a}\n" modname)))
  (if (not (null? options))
      (begin
	(format file "* Options for @code{~a}::          " modname)
	(format file "Options relevant to @code{~a}\n" modname)))
  (display "@end menu\n\n" file))

(define-public (output-module-commands-documentation file modname cmd-doc)
  "Output commands documentation for module @var{modname}.
@var{cmd-doc} is a list of command-name/command-doc pairs."
  (if (not (null? cmd-doc))
      (begin
	(format file
		"@node Commands for @code{~a}\n"
		modname)
	(format file
		"@section Commands for @code{~a}\n\n"
		modname)
	(output-category-documentation file "@command" cmd-doc))))

(define-public (output-module-functions-documentation file modname func-doc)
  "Output functions documentation for module @var{modname}.
@var{func-doc} is a list of function-name/function-doc pairs."
  (if (not (null? func-doc))
      (begin
	(format file
		"@node Functions for @code{~a}\n"
		modname)
	(format file
		"@section Functions for @code{~a}\n\n"
		modname)
	(output-category-documentation file "@function" func-doc))))

(define-public (output-module-options-documentation file modname opt-doc)
  "Output options documentation for module @var{modname}.
@var{opt-doc} is a list of option-name/option-doc pairs."
  (if (not (null? opt-doc))
      (begin
	(format file
		"@node Options for @code{~a}\n"
		modname)
	(format file
		"@section Options for @code{~a}\n\n"
		modname)
	(output-category-documentation file "@option" opt-doc))))


(define-public (output-documentation filename)
  (let ((file (open-file filename "w+")))
    (if file
	(let* ((global-options   (options-documentation))
	       (global-commands  (commands-documentation))
	       (global-functions (functions-documentation))
	       (module-list (hash-fold (lambda (name doc lst)
					 (append lst (list name)))
				       '() mutt-scheme-modules)))
; 	       (module-list (map (lambda (module-pair)
; 				   (format #f "~a" (car module-pair)))
; 				 global-options)))
	  (set! module-list (remove-doubles module-list))

	  ;; Generate the Texinfo header
	  (output-texinfo-intro
	   file
	   (lambda ()
	     (map (lambda (modname)
		    (if modname
			(begin
			  (format file "* Module @code{~a}::           "
				  modname)
			  (format file "The @code{~a} module\n"
				  modname))))
		  module-list)))

	  ;; Generate a chapter for each module
;	  (format #t "Module list: ~a\n" module-list)
;	  (format #t "opt: ~a\n" global-options)
	  (map (lambda (modname)
		 (if modname
		     (let* ((module-doc (module-documentation modname
							      global-commands
							      global-functions
							      global-options))
			    (cmd-doc  (car module-doc))
			    (func-doc (cadr module-doc))
			    (opt-doc  (caddr module-doc)))
		       (ui-message (format #f "module ~a" modname))
;		       (format #t "Module doc = ~a\n" module-doc)
		       (format file"@node Module @code{~a}\n" modname)
		       (format file"@chapter Module @code{~a}\n\n"
			       modname)

		       ;; General module description.
		       (format file "~a\n\n"
			       (let ((moddoc (scheme-module-documentation
					      modname)))
				 (if (or (not moddoc)
					 (string-null? moddoc))
				     "Undocumented module."
				     moddoc)))
		       
		       (output-module-menu file modname
					   cmd-doc func-doc opt-doc)

		       (output-module-commands-documentation file
							     modname
							     cmd-doc)
		       (output-module-options-documentation  file
							     modname
							     opt-doc))))

	       module-list)

	  ;; Terminate
	  (output-texinfo-trailer file)
	  (close-port file)
	  (ui-message (string-append "Texinfo documentation written to "
				     filename)))

	(ui-error (format #f "Could not open ~a" filename)))))

(define-public (output-texinfo-intro file make-menu-proc)
  "Write to port @var{file} the GNU Texinfo header.  Procedure
@var{make-menu-proc} gets called when main menu entries are to be
written."
  (display "\input texinfo  @c -*-texinfo-*-
@c $Id: make-doc.scm 1.3 Mon, 03 Nov 2003 17:54:06 +0100 ludo $
@documentencoding ISO-8859-1
@documentlanguage en
@setfilename mutt-guile.info

@dircategory Development
@direntry
* Mutt: (mutt) Guile-enabled Mutt.
@end direntry

@setchapternewpage none
@settitle The Mutt-Guile Automatic Reference Manual
@titlepage
@finalout
@title The Mutt-Guile Automatic Reference Manual
@subtitle This is cool!
@author Ludovic Court@`es @email{ludovic.courtes@@laas.fr}
@page

@vskip 0pt plus 1filll
Copyright @copyright{} 2003 Ludovic Court@`es @email{ludovic.courtes@@laas.fr}

Permission is granted to make and distribute verbatim copies of
this manual provided the copyright notice and this permission notice
are preserved on all copies.

Permission is granted to copy and distribute modified versions of this
manual under the conditions for verbatim copying, provided also that
the entire resulting derived work is distributed under the terms of a
permission notice identical to this one.

Permission is granted to copy and distribute translations of this manual
into another language, under the above conditions for modified versions.
@end titlepage

@node Top
@top The Mutt-Guile Automatic Reference Manual

This file documents @emph{your} Guile-enabled version of Mutt.  It was
automatically generated by the @code{(mutt make-doc)} module
(@pxref{Module @code{(mutt make-doc)}}) based on the modules
that were loaded.

@menu
* Introduction::             What is this documentation about?\n" file)
  (make-menu-proc)
  (display "
* Index::                    Guide to commands, functions and options.
* Contents::		     Table of contents.
@end menu

@node Introduction
@chapter Introduction

This documentation was automatically generated by the @code{make-doc}
command of your Guile-enabled Mutt.  It lists all modules that were
loaded by Mutt at the time this command was called@footnote{Typically,
a module may be loaded by adding a line like @code{(use-modules (mutt
the-module))} to your @file{$HOME/.mutt.scm} file.}.  For each module,
it lists the related commands, functions and configuration options.
However, Scheme procedures and options do not appear in this
file.\n\n" file)
  (format file "This document was generated on ~a.\n\n"
          (strftime "%c" (localtime (current-time)))))

(define-public (output-texinfo-trailer file)
  "Write to @var{file} the GNU Texinfo trailer, i.e. terminate the document."
  (display "\n\n" file)
  (display "@node Index
@unnumbered Index
@printindex vr
@printindex fn

@node Contents
@unnumbered Contents
@contents

@bye" file))
