← Back to branch summary

~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to ice-9/session.scm

  • Committer: Bazaar Package Importer
  • Author(s): أحمد المحمودي (Ahmed El-Mahmoudy)
  • Date: 2009-07-20 19:39:17 UTC
  • mfrom: (1.2.6 upstream)
  • Revision ID: james.westby@ubuntu.com-20090720193917-s0985l9wxihwoscl
Tags: 1.8.7+1-1ubuntu1
https://launchpad.net/bugs/401816
* Merge from Debian unstable, remaining changes: (LP: #401816)
  - Build with -Wno-error.
  - Build with thread support. Some guile-using programs like autogen need it.
  - Add debian/guile-1.8-libs.shlibs: Thread support breaks ABI, bump the soname.

Show diffs side-by-side

added added

removed removed

Lines of Context:
ice-9/session.scm
20
20
  :use-module (ice-9 documentation)
21
21
  :use-module (ice-9 regex)
22
22
  :use-module (ice-9 rdelim)
23
 
  :export (help apropos apropos-internal apropos-fold
24
 
           apropos-fold-accessible apropos-fold-exported apropos-fold-all
25
 
           source arity system-module))
 
23
  :export (help
 
24
           add-value-help-handler! remove-value-help-handler!
 
25
           add-name-help-handler! remove-name-help-handler!
 
26
           apropos apropos-internal apropos-fold apropos-fold-accessible
 
27
           apropos-fold-exported apropos-fold-all source arity
 
28
           system-module module-commentary))
26
29
 
27
30
 
28
31
 
 
32
(define *value-help-handlers*
 
33
  `(,(lambda (name value)
 
34
       (object-documentation value))))
 
35
 
 
36
(define (add-value-help-handler! proc)
 
37
  "Adds a handler for performing `help' on a value.
 
38
 
 
39
`proc' will be called as (PROC NAME VALUE). `proc' should return #t to
 
40
indicate that it has performed help, a string to override the default
 
41
object documentation, or #f to try the other handlers, potentially
 
42
falling back on the normal behavior for `help'."
 
43
  (set! *value-help-handlers* (cons proc *value-help-handlers*)))
 
44
 
 
45
(define (remove-value-help-handler! proc)
 
46
  "Removes a handler for performing `help' on a value."
 
47
  (set! *value-help-handlers* (delete! proc *value-help-handlers*)))
 
48
 
 
49
(define (try-value-help name value)
 
50
  (or-map (lambda (proc) (proc name value)) *value-help-handlers*))
 
51
 
 
52
 
 
53
(define *name-help-handlers* '())
 
54
 
 
55
(define (add-name-help-handler! proc)
 
56
  "Adds a handler for performing `help' on a name.
 
57
 
 
58
`proc' will be called with the unevaluated name as its argument. That is
 
59
to say, when the user calls `(help FOO)', the name is FOO, exactly as
 
60
the user types it.
 
61
 
 
62
`proc' should return #t to indicate that it has performed help, a string
 
63
to override the default object documentation, or #f to try the other
 
64
handlers, potentially falling back on the normal behavior for `help'."
 
65
  (set! *name-help-handlers* (cons proc *name-help-handlers*)))
 
66
 
 
67
(define (remove-name-help-handler! proc)
 
68
  "Removes a handler for performing `help' on a name."
 
69
  (set! *name-help-handlers* (delete! proc *name-help-handlers*)))
 
70
 
 
71
(define (try-name-help name)
 
72
  (or-map (lambda (proc) (proc name)) *name-help-handlers*))
 
73
 
 
74
 
29
75
;;; Documentation
30
76
;;;
31
77
(define help
45
91
                                               type x))))
46
92
               (cond
47
93
 
 
94
                ;; User-specified
 
95
                ((try-name-help name)
 
96
                 => (lambda (x) (if (not (eq? x #t)) (display x))))
 
97
 
48
98
                ;; SYMBOL
49
99
                ((symbol? name)
50
100
                 (help-doc name
60
110
                ((and (list? name)
61
111
                      (= (length name) 2)
62
112
                      (eq? (car name) 'unquote))
63
 
                 (cond ((object-documentation
64
 
                         (local-eval (cadr name) env))
65
 
                        => write-line)
66
 
                       (else (not-found 'documentation (cadr name)))))
 
113
                 (let ((doc (try-value-help (cadr name)
 
114
                                            (local-eval (cadr name) env))))
 
115
                   (cond ((not doc) (not-found 'documentation (cadr name)))
 
116
                         ((eq? doc #t)) ;; pass
 
117
                         (else (write-line doc)))))
67
118
 
68
119
                ;; (quote SYMBOL)
69
120
                ((and (list? name)
109
160
  (let ((entries (apropos-fold (lambda (module name object data)
110
161
                                 (cons (list module
111
162
                                             name
112
 
                                             (object-documentation object)
 
163
                                             (try-value-help name object)
113
164
                                             (cond ((closure? object)
114
165
                                                    "a procedure")
115
166
                                                   ((procedure? object)