blob: 5ea3ecd848a78dd47e68448a2ca36cc5b4e87dd8 (
plain)
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
|
;;;; 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)
:use-module (ice-9 rdelim)
: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 (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)))
(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) len)
;; matching name?
(string=? (substring entry 0 len) name)
;; terminated?
(memq (string-ref entry len) '(#\newline)))
;; cut away name tag and extra surrounding newlines
(substring entry (+ len 2) (- (string-length entry) 2)))
(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))))
|
