1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-03 02:36:19 +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.
;;;;
;;;; 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
;;;; Ported from Scwm by Greg J. Badros
;;;;
;;;; Hopefully this will just be temporary... --12/12/99 gjb
(define-module (ice-9 doc)
: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)
"Write all arguments into the port. #t means `current-output-port'."
@ -34,16 +39,6 @@
(do ((zz lst (cdr zz))) ((null? zz))
(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)))
"Print the documentation for the string or symbol.
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))))))
(documentation-debug (display "file not found\n" port))))))
(define*-public (help obj #&optional (port (current-output-port)))
"Print all possible documentation for string or symbol."
(display " *** documentation for `" port)
(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 (hook-documentation hook)
"Return the docstring for HOOK."
(object-property hook 'doc))
(define-public (object-documentation sym)
"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)
(define-public (proc-documentation proc)
"Return documentation for PROC."
(or (procedure-documentation proc)
(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-procedure-property! proc 'documentation 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))
((and (or obj (not sym))
(cond ((procedure? obj)
(display (proc-doc obj))
(display (proc-documentation obj))
(newline)
#t)
((and (macro? obj) (macro-transformer obj))
(display (proc-doc (macro-transformer obj)))
(display (proc-documentation (macro-transformer obj)))
(newline))
(else #f))))
((symbol? sym)