source: trunk/j/src/org/armedbear/lisp/describe.lisp @ 8535

Last change on this file since 8535 was 8535, checked in by piso, 16 years ago

Initial checkin.

File size: 3.0 KB
Line 
1;;; describe.lisp
2;;;
3;;; Copyright (C) 2005 Peter Graves
4;;; $Id: describe.lisp,v 1.1 2005-02-11 22:08:02 piso Exp $
5;;;
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19
20(in-package #:system)
21
22(require 'format)
23
24(defun describe-arglist (object stream)
25  (multiple-value-bind
26      (arglist known-p)
27      (arglist object)
28    (when known-p
29      (if arglist
30          (format stream "~&The function's arguments are:~%  ~A~%" arglist)
31          (format stream "~&The function takes no arguments.")))))
32
33(defun describe (object &optional stream)
34  (let ((stream (out-synonym-of stream))
35        (*print-pretty* t))
36    (typecase object
37      (SYMBOL
38       (let ((package (symbol-package object)))
39         (if package
40             (multiple-value-bind
41                 (sym status)
42                 (find-symbol (symbol-name object) package)
43               (format stream "~S is an ~A symbol in the ~A package.~%"
44                       object
45                       (if (eq status :internal) "internal" "external")
46                       (package-name package)))
47             (format stream "~S is an uninterned symbol.~%" object))
48         (cond ((special-variable-p object)
49                (format stream "It is a ~A; "
50                        (if (constantp object) "constant" "special variable"))
51                (if (boundp object)
52                    (format stream "its value is ~S.~%" (symbol-value object))
53                    (format stream "it is unbound.~%")))
54               ((boundp object)
55                (format stream "It is an undefined variable; its value is ~S.~%"
56                        (symbol-value object)))))
57       (when (autoloadp object)
58         (resolve object))
59       (let ((function (and (fboundp object) (symbol-function object))))
60         (when function
61           (format stream "Its function binding is ~S.~%" function)
62           (describe-arglist function stream)))
63       (let ((plist (symbol-plist object)))
64         (when plist
65           (format stream "The symbol's property list has these indicator/value pairs:~%")
66           (loop
67             (when (null plist) (return))
68             (format stream "  ~S ~S~%" (car plist) (cadr plist))
69             (setf plist (cddr plist))))))
70      (FUNCTION
71       (format stream "~S is an object of type ~S.~%" object (type-of object))
72       (describe-arglist object stream))
73      (t
74       (%describe object stream))))
75  (values))
Note: See TracBrowser for help on using the repository browser.