guile/guile-core/ice-9 documentation.scm

[Thien-Thi Nguyen]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Thien-Thi Nguyen <>     01/04/27 17:28:58

Modified files:
        guile-core/ice-9: documentation.scm 

Log message:
        Update copyright.
        Add commentary.
        Use `define-module' `:export' clause instead of `define-public'.
        Autoload (ice-9 regex) on `match:suffix'.
        
        (default-in-line-re, default-after-line-re): New vars.
        (default-scrub): New proc.
        (file-commentary): New proc, exported.
        (object-documentation): Expand docstring; nfc.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/documentation.scm.diff?cvsroot=OldCVS&tr1=1.3&tr2=1.4&r1=text&r2=text

Patches:
Index: guile/guile-core/ice-9/documentation.scm
diff -u guile/guile-core/ice-9/documentation.scm:1.3 
guile/guile-core/ice-9/documentation.scm:1.4
--- guile/guile-core/ice-9/documentation.scm:1.3        Wed Jan 24 13:45:09 2001
+++ guile/guile-core/ice-9/documentation.scm    Fri Apr 27 17:28:58 2001
@@ -1,31 +1,135 @@
-;;;;   Copyright (C) 2000 Free Software Foundation, Inc.
-;;;; 
+;;;;   Copyright (C) 2000,2001 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., 59 Temple Place, Suite 330,
 ;;;; Boston, MA 02111-1307 USA
-;;;; 
+;;;;
 
+;;; Commentary:
+
+;; * This module exports:
+;;
+;; file-commentary      -- a procedure that returns a file's "commentary"
+;;
+;; documentation-files  -- a search-list of files using the Guile
+;;                         Documentation Format Version 2.
+;;
+;; object-documentation -- a procedure that returns its arg's docstring
+;;
+;; * Guile Documentation Format
+;;
+;; Here is the complete and authoritative documentation for the Guile
+;; Documentation Format Version 2:
+;;
+;; HEADER
+;; ^LPROC1
+;; DOCUMENTATION1
+;; ^LPROC2
+;; DOCUMENTATION2
+;; ...
+;;
+;; The HEADER is completely ignored.  The "^L" are formfeeds.  PROC1, PROC2
+;; and so on are symbols that name the element documented.  DOCUMENTATION1,
+;; DOCUMENTATION2 and so on are the related documentation, w/o any further
+;; formatting.
+;;
+;; (Version 1, corresponding to guile-1.4 and prior, is documented as being
+;; not documented anywhere except by this embarrassingly circular comment.)
+;;
+;; * File Commentary
+;;
+;; A file's commentary is the body of text found between comments
+;;     ;;; Commentary:
+;; and
+;;     ;;; Code:
+;; both of which must be at the beginning of the line.  In the result string,
+;; semicolons at the beginning of each line are discarded.
+;;
+;; You can specify to `file-commentary' alternate begin and end strings, and
+;; scrub procedure.  Use #t to get default values.  For example:
+;;
+;; (file-commentary "documentation.scm")
+;; You should see this text!
+;;
+;; (file-commentary "documentation.scm" "^;;; Code:" "ends here$")
+;; You should see the rest of this file.
+;;
+;; (file-commentary "documentation.scm" #t #t string-upcase)
+;; You should see this text very loudly (note semicolons untouched).
+
+;;; Code:
+
 (define-module (ice-9 documentation)
   :use-module (ice-9 rdelim)
+  :export (file-commentary documentation-files object-documentation)
+  :autoload (ice-9 regex) (match:suffix)
   :no-backtrace)
 
 
+;;
+;; commentary extraction
+;;
+(define default-in-line-re (make-regexp "^;;; Commentary:"))
+(define default-after-line-re (make-regexp "^;;; Code:"))
+(define default-scrub (let ((dirt (make-regexp "^;+")))
+                        (lambda (line)
+                          (let ((m (regexp-exec dirt line)))
+                            (if m (match:suffix m) line)))))
+
+(define (file-commentary filename . cust) ; (IN-LINE-RE AFTER-LINE-RE SCRUB)
+  ;; fixme: might be cleaner to use optargs here...
+  (let ((in-line-re (if (> 1 (length cust))
+                        default-in-line-re
+                        (let ((v (car cust)))
+                          (cond ((regexp? v) v)
+                                ((string? v) (make-regexp v))
+                                (else default-in-line-re)))))
+        (after-line-re (if (> 2 (length cust))
+                           default-after-line-re
+                           (let ((v (cadr cust)))
+                             (cond ((regexp? v) v)
+                                   ((string? v) (make-regexp v))
+                                   (else default-after-line-re)))))
+        (scrub (if (> 3 (length cust))
+                   default-scrub
+                   (let ((v (caddr cust)))
+                     (cond ((procedure? v) v)
+                           (else default-scrub)))))
+        (port (open-input-file filename)))
+    (let loop ((line (read-delimited "\n" port))
+               (doc "")
+               (parse-state 'before))
+      (if (or (eof-object? line) (eq? 'after parse-state))
+          doc
+          (let ((new-state
+                 (cond ((regexp-exec in-line-re line) 'in)
+                       ((regexp-exec after-line-re line) 'after)
+                       (else parse-state))))
+            (if (eq? 'after new-state)
+                doc
+                (loop (read-delimited "\n" port)
+                      (if (and (eq? 'in new-state) (eq? 'in parse-state))
+                          (string-append doc (scrub line) "\n")
+                          doc)
+                      new-state)))))))
 
+
+
 ;;
 ;; documentation-files is the list of places to look for documentation
 ;;
-(define-public documentation-files
+(define documentation-files
   (map (lambda (vicinity)
         (in-vicinity (vicinity) "guile-procedures.txt"))
        (list %library-dir
@@ -36,7 +140,7 @@
 (define (find-documentation name)
   (or-map (lambda (file)
            (find-documentation-in-file name file))
-         documentation-files))
+          documentation-files))
 
 (define entry-delimiter "\f")
 
@@ -64,8 +168,10 @@
   (or (procedure-documentation proc)
       (procedure-property proc 'documentation)))
 
-(define-public (object-documentation object)
-  "Return the docstring for OBJECT."
+(define (object-documentation object)
+  "Return the docstring for OBJECT.
+OBJECT can be a procedure, macro or any object that has its
+`documentation' property set."
   (or (and (procedure? object)
           (proc-doc object))
       (and (macro? object)
@@ -81,3 +187,5 @@
             (if docstring
                 (set-procedure-property! object 'documentation docstring))
             docstring))))
+
+;;; documentation.scm ends here