File: documentation.scm

package info (click to toggle)
guile-core 1%3A1.4-24
  • links: PTS
  • area: main
  • in suites: woody
  • size: 6,280 kB
  • ctags: 6,664
  • sloc: ansic: 49,704; lisp: 9,376; sh: 9,209; asm: 1,580; makefile: 696; awk: 198; csh: 50
file content (86 lines) | stat: -rw-r--r-- 2,986 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
;;;; 	Copyright (C) 2000 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
;;;; 

(define-module (ice-9 documentation)
  :no-backtrace)



;;
;; documentation-files is the list of places to look for documentation
;;
(define-public documentation-files
  (map (lambda (vicinity)
	 (in-vicinity (vicinity) "guile-procedures.txt"))
       (list %library-dir
	     %package-data-dir
	     %site-dir
	     (lambda () "."))))

(define (find-documentation name)
  (or-map (lambda (file)
	    (find-documentation-in-file name file))
	  documentation-files))

(define entry-delimiter "\f")
(define entry-start 2)

(define (find-documentation-in-file name file)
  (and (file-exists? file)
       (let ((port (open-input-file file))
	     (name (symbol->string name)))
	 (let* ((len (string-length name))
		(min-size (+ entry-start len))
		(end (+ entry-start len)))
	   (read-delimited entry-delimiter port) ;skip to first entry
	   (let loop ((entry (read-delimited entry-delimiter port)))
	     (cond ((eof-object? entry) #f)
		   ;; match?
		   ((and ;; large enough?
		         (>= (string-length entry) min-size)
			 ;; matching name?
			 (string=? (substring entry entry-start end)
				   name)
			 ;; terminated?
			 (memq (string-ref entry end) '(#\space #\))))
		    ;; cut away starting and ending newline
		    (substring entry 1 (- (string-length entry) 1)))
		   (else (loop (read-delimited entry-delimiter port)))))))))

;; helper until the procedure documentation property is cleaned up
(define (proc-doc proc)
  (or (procedure-documentation proc)
      (procedure-property proc 'documentation)))

(define-public (object-documentation object)
  "Return the docstring for OBJECT."
  (or (and (procedure? object)
	   (proc-doc object))
      (and (macro? object)
	   (let ((transformer (macro-transformer object)))
	     (and transformer
		  (proc-doc transformer))))
      (object-property object 'documentation)
      ;; find-documentation currently only works for builtin primitives
      (and (procedure? object)
	   (not (closure? object))
	   (procedure-name object)
	   (let ((docstring (find-documentation (procedure-name object))))
	     (if docstring
		 (set-procedure-property! object 'documentation docstring))
	     docstring))))