src/documentation.lisp

   1 ;;; documentation.lisp --- Accessing DOCUMENTATION
   2
   3 ;;; APROPOS and friends
   4
   5 (defun map-apropos-symbols (function string package external-only)
   6   (flet ((handle-symbol (symbol)
   7            ;; TODO: it's implementation-dependent, though CHAR-EQUAL seems
   8            ;; more reasonable nevertheless
   9            (when (search string (symbol-name symbol) :test #'char=)
  10              (funcall function symbol))))
  11     (if package
  12         (if external-only
  13             (do-external-symbols (symbol package) (handle-symbol symbol))
  14             (do-symbols (symbol package) (handle-symbol symbol)))
  15         (if external-only
  16             (do-all-external-symbols (symbol) (handle-symbol symbol))
  17             (do-all-symbols (symbol) (handle-symbol symbol))))))
  18
  19 (defun apropos-list (string &optional package external-only)
  20   (let (symbols)
  21     (map-apropos-symbols
  22      (lambda (symbol)
  23        (pushnew symbol symbols :test #'eq))
  24      string package external-only)
  25     symbols))
  26
  27 (defun apropos (string &optional package external-only)
  28   (map-apropos-symbols
  29    (lambda (symbol)
  30      (format t "~S" symbol)
  31      (when (boundp symbol)
  32        (format t " (bound)"))
  33      (when (fboundp symbol)
  34        (format t " (fbound)"))
  35      (terpri))
  36    string package external-only))
  37
  38 ;;; DESCRIBE
  39
  40 ;; TODO: this needs DESCRIBE-OBJECT as generic method
  41 ;; TODO: indentation for nested paragraphs
  42 (defun describe (object &optional stream)
  43   (declare (ignore stream))
  44   (typecase object
  45     (cons
  46      (format t "~S~%  [cons]~%" object))
  47     (integer
  48      (format t "~S~%  [integer]~%" object))
  49     (symbol
  50      (format t "~S~%  [symbol]~%" object)
  51      (when (boundp object)
  52        (format t "~%~A names a special variable:~%  Value: ~A~%"
  53                object (symbol-value object))
  54        (let ((documentation (documentation object 'variable)))
  55          (when documentation
  56            (format t "  Documentation:~%~A~%" documentation))))
  57      (when (fboundp object)
  58        (format t "~%~A names a function:~%" object)
  59        (let ((documentation (documentation object 'function)))
  60          (when documentation
  61            (format t "  Documentation:~%~A~%" documentation)))))
  62     (string
  63      (format t "~S~%  [string]~%~%Length: ~D~%"
  64              object (length object)))
  65     (float
  66      (format t "~S~%  [float]~%" object))
  67     (array
  68      (format t "~S~%  [array]~%" object))
  69     (function
  70      (format t "~S~%  [function]~%" object)
  71      (let ((documentation (documentation object 'function)))
  72        (when documentation
  73          (format t "  Documentation:~%~A~%" documentation))))
  74     (T
  75      (warn "~A not implemented yet for ~A" 'describe object)))
  76   (values))