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

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

(defmethod describe-object ((object pathname) stream) ...)

File size: 4.1 KB
Line 
1;;; describe.lisp
2;;;
3;;; Copyright (C) 2005 Peter Graves
4;;; $Id: describe.lisp,v 1.4 2005-09-15 10:47:14 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 '#:clos)
23(require '#:format)
24
25(defun describe-arglist (object stream)
26  (multiple-value-bind
27      (arglist known-p)
28      (arglist object)
29    (when known-p
30      (format stream "~&The function's lambda list is:~%  ~A~%" arglist))))
31
32(defun %describe-object (object stream)
33  (format stream "~S is an object of type ~S.~%" object (type-of object)))
34
35(defun describe (object &optional stream)
36  (describe-object object (out-synonym-of stream))
37  (values))
38
39(defmethod describe-object ((object t) stream)
40  (let ((*print-pretty* t))
41    (typecase object
42      (SYMBOL
43       (let ((package (symbol-package object)))
44         (if package
45             (multiple-value-bind
46                 (sym status)
47                 (find-symbol (symbol-name object) package)
48               (format stream "~S is an ~A symbol in the ~A package.~%"
49                       object
50                       (if (eq status :internal) "internal" "external")
51                       (package-name package)))
52             (format stream "~S is an uninterned symbol.~%" object))
53         (cond ((special-variable-p object)
54                (format stream "It is a ~A; "
55                        (if (constantp object) "constant" "special variable"))
56                (if (boundp object)
57                    (format stream "its value is ~S.~%" (symbol-value object))
58                    (format stream "it is unbound.~%")))
59               ((boundp object)
60                (format stream "It is an undefined variable; its value is ~S.~%"
61                        (symbol-value object)))))
62       (when (autoloadp object)
63         (resolve object))
64       (let ((function (and (fboundp object) (symbol-function object))))
65         (when function
66           (format stream "Its function binding is ~S.~%" function)
67           (describe-arglist function stream)))
68       (let ((docstring (get object '%function-documentation)))
69         (when docstring
70           (format stream "Function documentation:~%  ~A~%" docstring)))
71       (let ((plist (symbol-plist object)))
72         (when plist
73           (format stream "The symbol's property list contains these indicator/value pairs:~%")
74           (loop
75             (when (null plist) (return))
76             (format stream "  ~S ~S~%" (car plist) (cadr plist))
77             (setf plist (cddr plist))))))
78      (FUNCTION
79       (%describe-object object stream)
80       (describe-arglist object stream))
81      (INTEGER
82       (%describe-object object stream)
83       (format stream "~D.~%~
84                       #x~X~%~
85                       #o~O~%~
86                       #b~B~%"
87               object object object object))
88      (t
89       (%describe-object object stream))))
90  (values))
91
92(defmethod describe-object ((object pathname) stream)
93  (format stream "~S is an object of type ~S:~%" object (type-of object))
94  (format stream " HOST         ~S~%" (pathname-host object))
95  (format stream " DEVICE       ~S~%" (pathname-device object))
96  (format stream " DIRECTORY    ~S~%" (pathname-directory object))
97  (format stream " NAME         ~S~%" (pathname-name object))
98  (format stream " TYPE         ~S~%" (pathname-type object))
99  (format stream " VERSION      ~S~%" (pathname-version object)))
100
101(defmethod describe-object ((object standard-object) stream)
102  (%describe-object object stream)
103  (values))
Note: See TracBrowser for help on using the repository browser.