1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-05 03:30:24 +02:00

* session.scm: Update references to `proc-doc' to be

`proc-documentation'

* doc.scm: Cleaned up a great deal.  Put variables at the top of
the file, eliminated `object-documentation' that was broken
(referencing Scwm), drop `help' as session.scm has a better
supported version of that procedure. Rename `proc-doc' to
`proc-documentation' -- `procedure-documentation' is a primitive
getter function, so I use the shorter name for this more useful
function.  (Alternatively, we could rename the primitive
getter...)
This commit is contained in:
Greg J. Badros 2000-06-06 16:21:45 +00:00
parent a6596faa22
commit c16c5d247a
2 changed files with 13 additions and 57 deletions

View file

@ -1,4 +1,4 @@
;;; $Id: doc.scm,v 1.3 1999-12-15 16:35:07 gjb Exp $ ;;; $Id: doc.scm,v 1.4 2000-06-06 16:21:45 gjb Exp $
;;;; Copyright (C) 1999 Free Software Foundation, Inc. ;;;; Copyright (C) 1999 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This program is free software; you can redistribute it and/or modify ;;;; This program is free software; you can redistribute it and/or modify
@ -19,7 +19,6 @@
;;;; Written by Sam Steingold, Greg J. Badros, and Maciej Stachowiak ;;;; Written by Sam Steingold, Greg J. Badros, and Maciej Stachowiak
;;;; Ported from Scwm by Greg J. Badros ;;;; Ported from Scwm by Greg J. Badros
;;;; ;;;;
;;;; Hopefully this will just be temporary... --12/12/99 gjb
(define-module (ice-9 doc) (define-module (ice-9 doc)
:use-module (ice-9 regex) :use-module (ice-9 regex)
@ -27,6 +26,12 @@
(define-public documentation-debug #f)
;; doc-files is the list of all places to look for documentation
(define-public doc-files
(map (lambda (x) (string-append (x) "/guile-procedures.txt"))
(list %library-dir %package-data-dir %site-dir (lambda () "."))))
(define-public (write-all port . lst) (define-public (write-all port . lst)
"Write all arguments into the port. #t means `current-output-port'." "Write all arguments into the port. #t means `current-output-port'."
@ -34,16 +39,6 @@
(do ((zz lst (cdr zz))) ((null? zz)) (do ((zz lst (cdr zz))) ((null? zz))
(if (string? (car zz)) (display (car zz) port) (write (car zz) port)))) (if (string? (car zz)) (display (car zz) port) (write (car zz) port))))
(define-public doc-files
(map (lambda (x) (string-append (x) "/guile-procedures.txt"))
(list %library-dir %package-data-dir %site-dir (lambda () "."))))
(define-public (hook-documentation hook)
"Return the docstring for HOOK."
(object-property hook 'doc))
(define-public documentation-debug #f)
(define*-public (documentation func #&optional (port (current-output-port))) (define*-public (documentation func #&optional (port (current-output-port)))
"Print the documentation for the string or symbol. "Print the documentation for the string or symbol.
Works by searching through the files listed in `doc-files'. Works by searching through the files listed in `doc-files'.
@ -80,43 +75,11 @@ Returns #t if any documentation was found, #f otherwise."
((set! ln (read-line fd)))))) ((set! ln (read-line fd))))))
(documentation-debug (display "file not found\n" port)))))) (documentation-debug (display "file not found\n" port))))))
(define*-public (help obj #&optional (port (current-output-port))) (define-public (hook-documentation hook)
"Print all possible documentation for string or symbol." "Return the docstring for HOOK."
(display " *** documentation for `" port) (object-property hook 'doc))
(display obj port)
(display "':\n\n" port)
(documentation obj port)
(let ((bb (symbol-binding #f (if (string? obj) (string->symbol obj) obj))))
(cond ((procedure? bb)
(display "\n *** procedure-documentation for `" port)
(display obj port) (display "':\n\n" port)
(with-output-to-port port
(lambda () (procedure-documentation bb))))))
(display "\n\n" port))
(define-public (object-documentation sym) (define-public (proc-documentation proc)
"Return documentation attached to SYM or to (eval SYM)."
(let ((evalsym (catch #t
(lambda () (eval sym))
(lambda (key . args)
#f))))
(cond
((procedure? evalsym)
(procedure-documentation evalsym))
((hook? evalsym)
(hook-documentation evalsym))
(else (scwm-option-documentation sym)))))
;; (proc-doc get-window)
;; (procedure-name get-window)
;; (procedure-properties get-window)
;; (procedure-property get-window 'documentation)
;; (procedure-property window-frame-size 'documentation)
;; (proc-doc get-window)
;; (proc-doc window-frame-size)
;; (set-procedure-property! get-window 'documentation "foo")
(define-public (proc-doc proc)
"Return documentation for PROC." "Return documentation for PROC."
(or (procedure-documentation proc) (or (procedure-documentation proc)
(procedure-property proc 'documentation) (procedure-property proc 'documentation)
@ -128,10 +91,3 @@ Returns #t if any documentation was found, #f otherwise."
(set! docstring (substring docstring 0 (- len 1))) (set! docstring (substring docstring 0 (- len 1)))
(set-procedure-property! proc 'documentation docstring) (set-procedure-property! proc 'documentation docstring)
docstring))) docstring)))
;; For testing...
;; (documentation "window-position")
;; (documentation "make-cl-constraint")
;; (apropos-internal "")
;; (substring (proc-doc get-window) 0 (- (string-length (proc-doc get-window)) 2))

View file

@ -42,11 +42,11 @@ Prints useful information. Try `(help)'."
;;((or obj (not sym)) (describe obj)) ;;((or obj (not sym)) (describe obj))
((and (or obj (not sym)) ((and (or obj (not sym))
(cond ((procedure? obj) (cond ((procedure? obj)
(display (proc-doc obj)) (display (proc-documentation obj))
(newline) (newline)
#t) #t)
((and (macro? obj) (macro-transformer obj)) ((and (macro? obj) (macro-transformer obj))
(display (proc-doc (macro-transformer obj))) (display (proc-documentation (macro-transformer obj)))
(newline)) (newline))
(else #f)))) (else #f))))
((symbol? sym) ((symbol? sym)