[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/ice-9 session.scm
From: |
Thien-Thi Nguyen |
Subject: |
guile/guile-core/ice-9 session.scm |
Date: |
Fri, 18 May 2001 10:05:07 -0700 |
CVSROOT: /cvs
Module name: guile
Changes by: Thien-Thi Nguyen <address@hidden> 01/05/18 10:05:06
Modified files:
guile-core/ice-9: session.scm
Log message:
(help): Use `provided?' instead of `feature?'.
Factor "TYPE not found for X" output into internal proc.
Support `(quote SYMBOL)'; call `search-documentation-files'.
(help-doc): If initial search fails, try using
`search-documentation-files'.
(apropos-fold-accessible, apropos-fold-all): Use `identity'
instead of `(lambda (x) x)'. "An identity edit", ha ha.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/session.scm.diff?cvsroot=OldCVS&tr1=1.26&tr2=1.27&r1=text&r2=text
Patches:
Index: guile/guile-core/ice-9/session.scm
diff -u guile/guile-core/ice-9/session.scm:1.26
guile/guile-core/ice-9/session.scm:1.27
--- guile/guile-core/ice-9/session.scm:1.26 Tue May 15 07:59:00 2001
+++ guile/guile-core/ice-9/session.scm Fri May 18 10:05:06 2001
@@ -32,43 +32,61 @@
"(help [NAME])
Prints useful information. Try `(help)'."
(cond ((not (= (length exp) 2))
- (help-usage))
- ((not (feature? 'regex))
- (display "`help' depends on the `regex' feature.
+ (help-usage))
+ ((not (provided? 'regex))
+ (display "`help' depends on the `regex' feature.
You don't seem to have regular expressions installed.\n"))
- (else
- (let ((name (cadr exp)))
- (cond ((symbol? name)
- (help-doc name
- (string-append "^"
- (regexp-quote
- (symbol->string name))
- "$")))
- ((string? name)
- (help-doc name name))
- ((and (list? name)
- (= (length name) 2)
- (eq? (car name) 'unquote))
- (let ((doc (object-documentation (local-eval (cadr name)
- env))))
- (if (not doc)
- (simple-format #t "No documentation found for ~S\n"
- (cadr name))
- (write-line doc))))
- ((and (list? name)
- (and-map symbol? name)
- (not (null? name))
- (not (eq? (car name) 'quote)))
- (let ((doc (module-commentary name)))
- (if (not doc)
- (simple-format
- #t "No commentary found for module ~S\n" name)
- (begin
- (display name) (write-line " commentary:")
- (write-line doc)))))
- (else
- (help-usage)))
- *unspecified*))))))
+ (else
+ (let ((name (cadr exp))
+ (not-found (lambda (type x)
+ (simple-format #t "No ~A found for ~A\n"
+ type x))))
+ (cond
+
+ ;; SYMBOL
+ ((symbol? name)
+ (help-doc name
+ (simple-format
+ #f "^~A$"
+ (regexp-quote (symbol->string name)))))
+
+ ;; "STRING"
+ ((string? name)
+ (help-doc name name))
+
+ ;; (unquote SYMBOL)
+ ((and (list? name)
+ (= (length name) 2)
+ (eq? (car name) 'unquote))
+ (cond ((object-documentation
+ (local-eval (cadr name) env))
+ => write-line)
+ (else (not-found 'documentation (cadr name)))))
+
+ ;; (quote SYMBOL)
+ ((and (list? name)
+ (= (length name) 2)
+ (eq? (car name) 'quote)
+ (symbol? (cadr name)))
+ (cond ((search-documentation-files (cadr name))
+ => write-line)
+ (else (not-found 'documentation (cadr name)))))
+
+ ;; (SYM1 SYM2 ...)
+ ((and (list? name)
+ (and-map symbol? name)
+ (not (null? name))
+ (not (eq? (car name) 'quote)))
+ (cond ((module-commentary name)
+ => (lambda (doc)
+ (display name) (write-line " commentary:")
+ (write-line doc)))
+ (else (not-found 'commentary name))))
+
+ ;; unrecognized
+ (else
+ (help-usage)))
+ *unspecified*))))))
(define (module-filename name) ; fixme: better way? / done elsewhere?
(let* ((name (map symbol->string name))
@@ -104,64 +122,71 @@
(name cadr)
(doc caddr)
(type cadddr))
- (if (null? entries)
- ;; no matches
- (begin
- (display "Did not find any object ")
- (simple-format #t
- (if (symbol? term)
- "named `~A'\n"
- "matching regexp \"~A\"\n")
- term))
- (let ((first? #t)
- (undocumented-entries '())
- (documented-entries '())
- (documentations '()))
-
- (for-each (lambda (entry)
- (let ((entry-summary (simple-format #f
- "~S: ~S\n"
- (module-name (module
entry))
- (name entry))))
- (if (doc entry)
- (begin
- (set! documented-entries
- (cons entry-summary documented-entries))
- ;; *fixme*: Use `describe' when we have GOOPS?
- (set! documentations
- (cons (simple-format #f
- "`~S' is ~A in the ~S
module.\n\n~A\n"
- (name entry)
- (type entry)
- (module-name (module
entry))
- (doc entry))
- documentations)))
- (set! undocumented-entries
- (cons entry-summary undocumented-entries)))))
- entries)
-
- (if (and (not (null? documented-entries))
- (or (> (length documented-entries) 1)
- (not (null? undocumented-entries))))
- (begin
- (display "Documentation found for:\n")
- (for-each (lambda (entry) (display entry)) documented-entries)
- (set! first? #f)))
-
- (for-each (lambda (entry)
- (if first?
- (set! first? #f)
- (newline))
- (display entry))
- documentations)
-
- (if (not (null? undocumented-entries))
- (begin
- (if first?
- (set! first? #f)
- (newline))
- (display "No documentation found for:\n")
- (for-each (lambda (entry) (display entry))
undocumented-entries)))))))
+ (cond ((not (null? entries))
+ (let ((first? #t)
+ (undocumented-entries '())
+ (documented-entries '())
+ (documentations '()))
+
+ (for-each (lambda (entry)
+ (let ((entry-summary (simple-format
+ #f "~S: ~S\n"
+ (module-name (module entry))
+ (name entry))))
+ (if (doc entry)
+ (begin
+ (set! documented-entries
+ (cons entry-summary documented-entries))
+ ;; *fixme*: Use `describe' when we have GOOPS?
+ (set! documentations
+ (cons (simple-format
+ #f "`~S' is ~A in the ~S
module.\n\n~A\n"
+ (name entry)
+ (type entry)
+ (module-name (module entry))
+ (doc entry))
+ documentations)))
+ (set! undocumented-entries
+ (cons entry-summary
+ undocumented-entries)))))
+ entries)
+
+ (if (and (not (null? documented-entries))
+ (or (> (length documented-entries) 1)
+ (not (null? undocumented-entries))))
+ (begin
+ (display "Documentation found for:\n")
+ (for-each (lambda (entry) (display entry))
+ documented-entries)
+ (set! first? #f)))
+
+ (for-each (lambda (entry)
+ (if first?
+ (set! first? #f)
+ (newline))
+ (display entry))
+ documentations)
+
+ (if (not (null? undocumented-entries))
+ (begin
+ (if first?
+ (set! first? #f)
+ (newline))
+ (display "No documentation found for:\n")
+ (for-each (lambda (entry) (display entry))
+ undocumented-entries)))))
+ ((search-documentation-files term)
+ => (lambda (doc)
+ (write-line "Documentation from file:")
+ (write-line doc)))
+ (else
+ ;; no matches
+ (display "Did not find any object ")
+ (simple-format #t
+ (if (symbol? term)
+ "named `~A'\n"
+ "matching regexp \"~A\"\n")
+ term)))))
(define (help-usage)
(display "Usage: (help NAME) gives documentation about objects named NAME (a
symbol)
@@ -318,7 +343,7 @@
(define-public (apropos-fold-accessible module)
(make-fold-modules (lambda () (list module))
module-uses
- (lambda (x) x)))
+ identity))
(define (root-modules)
(cons the-root-module
@@ -338,7 +363,7 @@
(make-fold-modules root-modules submodules module-public-interface))
(define-public apropos-fold-all
- (make-fold-modules root-modules submodules (lambda (x) x)))
+ (make-fold-modules root-modules submodules identity))
(define-public (source obj)
(cond ((procedure? obj) (procedure-source obj))
@@ -396,3 +421,5 @@
(set-system-module! m s)
(string-append "Module " (symbol->string (module-name m))
" is now a " (if s "system" "user") " module."))))))
+
+;;; session.scm ends here
- guile/guile-core/ice-9 session.scm,
Thien-Thi Nguyen <=