;;; output.scm -- Output documentation "snarffed" from C files in Texi/GDF.
;;;
;;; Copyright 2006-2012 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 3 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (system documentation output)
:use-module (srfi srfi-1)
:use-module (srfi srfi-13)
:use-module (srfi srfi-39)
:autoload (system documentation c-snarf) (run-cpp-and-extract-snarfing)
:export (schemify-name scheme-procedure-texi-line
procedure-gdf-string procedure-texi-documentation
output-procedure-texi-documentation-from-c-file
*document-c-functions?*))
;;; Author: Ludovic Courtès
;;;
;;; Commentary:
;;;
;;; This module provides support function to issue Texinfo or GDF (Guile
;;; Documentation Format) documentation from "snarffed" C files.
;;;
;;; Code:
;;;
;;; Utility.
;;;
(define (schemify-name str)
"Turn @var{str}, a C variable or function name, into a more ``Schemey''
form, e.g., one with dashed instead of underscores, etc."
(string-map (lambda (chr)
(if (eq? chr #\_)
#\-
chr))
(if (string-suffix? "_p" str)
(string-append (substring str 0
(- (string-length str) 2))
"?")
str)))
;;;
;;; Issuing Texinfo and GDF-formatted doc (i.e., `guile-procedures.texi').
;;; GDF = Guile Documentation Format
;;;
(define *document-c-functions?*
;; Whether to mention C function names along with Scheme procedure names.
(make-parameter #t))
(define (scheme-procedure-texi-line proc-name args
required-args optional-args
rest-arg?)
"Return a Texinfo string describing the Scheme procedure named
@var{proc-name}, whose arguments are listed in @var{args} (a list of strings)
and whose signature is defined by @var{required-args}, @var{optional-args}
and @var{rest-arg?}."
(string-append "@deffn {Scheme Procedure} " proc-name " "
(string-join (take args required-args) " ")
(string-join (take (drop args required-args)
(+ optional-args
(if rest-arg? 1 0)))
" [" 'prefix)
(if rest-arg? "...]" "")
(make-string optional-args #\])))
(define (procedure-gdf-string proc-doc)
"Issue a Texinfo/GDF docstring corresponding to @var{proc-doc}, a
documentation alist as returned by @code{parse-snarfed-line}. To produce
actual GDF-formatted doc, the resulting string must be processed by
@code{makeinfo}."
(let* ((proc-name (assq-ref proc-doc 'scheme-name))
(args (assq-ref proc-doc 'arguments))
(signature (assq-ref proc-doc 'signature))
(required-args (assq-ref signature 'required))
(optional-args (assq-ref signature 'optional))
(rest-arg? (assq-ref signature 'rest?))
(location (assq-ref proc-doc 'location))
(file-name (car location))
(line (cadr location))
(documentation (assq-ref proc-doc 'documentation)))
(string-append " " ;; form feed
proc-name (string #\newline)
(format #f "@c snarfed from ~a:~a~%"
file-name line)
(scheme-procedure-texi-line proc-name
(map schemify-name args)
required-args optional-args
rest-arg?)
(string #\newline)
documentation (string #\newline)
"@end deffn" (string #\newline))))
(define (procedure-texi-documentation proc-doc)
"Issue a Texinfo docstring corresponding to @var{proc-doc}, a documentation
alist as returned by @var{parse-snarfed-line}. The resulting Texinfo string
is meant for use in a manual since it also documents the corresponding C
function."
(let* ((proc-name (assq-ref proc-doc 'scheme-name))
(c-name (assq-ref proc-doc 'c-name))
(args (assq-ref proc-doc 'arguments))
(signature (assq-ref proc-doc 'signature))
(required-args (assq-ref signature 'required))
(optional-args (assq-ref signature 'optional))
(rest-arg? (assq-ref signature 'rest?))
(location (assq-ref proc-doc 'location))
(file-name (car location))
(line (cadr location))
(documentation (assq-ref proc-doc 'documentation)))
(string-append (string #\newline)
(format #f "@c snarfed from ~a:~a~%"
file-name line)
;; document the Scheme procedure
(scheme-procedure-texi-line proc-name
(map schemify-name args)
required-args optional-args
rest-arg?)
(string #\newline)
(if (*document-c-functions?*)
(string-append
;; document the C function
"@deffnx {C Function} " c-name " ("
(if (null? args)
"void"
(string-join (map (lambda (arg)
(string-append "SCM " arg))
args)
", "))
")" (string #\newline))
"")
documentation (string #\newline)
"@end deffn" (string #\newline))))
;;;
;;; Very high-level interface.
;;;
(define (output-procedure-texi-documentation-from-c-file c-file cpp cflags
port)
(for-each (lambda (texi-string)
(display texi-string port))
(map procedure-texi-documentation
(run-cpp-and-extract-snarfing c-file cpp cflags))))
;;; output.scm ends here
;;; Local Variables:
;;; mode: scheme
;;; coding: latin-1
;;; End:
;;; arch-tag: 20ca493a-6f1a-4d7f-9d24-ccce0d32df49