;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: package.lisp,v 1.25 2003/03/25 05:08:33 kevin Exp $
+;;;; $Id: package.lisp,v 1.26 2003/03/25 06:50:47 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
;;;; *************************************************************************
(:nicknames #:ho-user)
(:use #:hyperobject #:cl #:cl-user))
+#+sbcl
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (if (find-package 'sb-mop)
+ (pushnew :sb-mop cl:*features*)
+ (pushnew :sb-acl cl:*features*)))
+
(eval-when (:compile-toplevel :load-toplevel :execute)
(shadowing-import
#+allegro
- `(mop::class-slots mop::slot-definition-name mop:finalize-inheritance
+ '(mop::class-slots mop::slot-definition-name mop:finalize-inheritance
mop::standard-direct-slot-definition mop::standard-effective-slot-definition
mop:direct-slot-definition-class mop:compute-effective-slot-definition
excl::compute-effective-slot-definition-initargs
mop:slot-value-using-class)
#+lispworks
- `(clos:class-slots clos::slot-definition-name clos:finalize-inheritance
+ '(clos:class-slots clos::slot-definition-name clos:finalize-inheritance
clos::standard-direct-slot-definition clos::standard-effective-slot-definition
clos:direct-slot-definition-class clos:compute-effective-slot-definition
clos::compute-effective-slot-definition-initargs
clos:slot-value-using-class)
- #+sbcl
- `(,@(if (find-package 'sb-mop)
- '(sb-mop:class-slots
- sb-mop::standard-class
- sb-mop:slot-definition-name sb-mop:finalize-inheritance
- sb-mop::standard-direct-slot-definition
- sb-mop::standard-effective-slot-definition sb-mop:validate-superclass
- sb-mop:direct-slot-definition-class sb-mop:compute-effective-slot-definition
- sb-mop::compute-effective-slot-definition-initargs
- sb-mop:slot-value-using-class)
- '(sb-pcl::class-of sb-pcl::class-name sb-pcl::class-slots sb-pcl::find-class
- sb-pcl::standard-class
- sb-pcl:slot-definition-name sb-pcl::finalize-inheritance
- sb-pcl::standard-direct-slot-definition
- sb-pcl::standard-effective-slot-definition sb-pcl::validate-superclass
- sb-pcl::direct-slot-definition-class sb-pcl::compute-effective-slot-definition
- sb-pcl::compute-effective-slot-definition-initargs
- sb-pcl::slot-value-using-class)))
- #+cmu
- `(pcl:class-of pcl:class-name pcl:class-slots pcl:find-class pcl::standard-class
- pcl::slot-definition-name pcl:finalize-inheritance
- pcl::standard-direct-slot-definition pcl::standard-effective-slot-definition
- pcl::validate-superclass pcl:direct-slot-definition-class
- pcl:compute-effective-slot-definition
- pcl::compute-effective-slot-definition-initargs
- pcl::slot-value-using-class)
- #+scl
- `(clos:class-slots clos::standard-class
- clos::slot-definition-name clos:finalize-inheritance
- clos::standard-direct-slot-definition clos::standard-effective-slot-definition
- clos::validate-superclass clos:direct-slot-definition-class
- clos:compute-effective-slot-definition
- clos::compute-effective-slot-definition-initargs
- clos::slot-value-using-class)
-
+ #+sbcl-mop
+ '(sb-mop:class-slots
+ sb-mop::standard-class
+ sb-mop:slot-definition-name sb-mop:finalize-inheritance
+ sb-mop::standard-direct-slot-definition
+ sb-mop::standard-effective-slot-definition sb-mop:validate-superclass
+ sb-mop:direct-slot-definition-class sb-mop:compute-effective-slot-definition
+ sb-mop::compute-effective-slot-definition-initargs
+ sb-mop:slot-value-using-class)
+ #+sbcl-pcl
+ '(sb-pcl:class-of sb-pcl:class-name sb-pcl:class-slots sb-pcl:find-class
+ sb-pcl::standard-class
+ sb-pcl:slot-definition-name sb-pcl::finalize-inheritance
+ sb-pcl::standard-direct-slot-definition
+ sb-pcl::standard-effective-slot-definition sb-pcl::validate-superclass
+ sb-pcl::direct-slot-definition-class sb-pcl::compute-effective-slot-definition
+ sb-pcl::compute-effective-slot-definition-initargs
+ sb-pcl::slot-value-using-class))
+ #+cmu
+ '(pcl:class-of pcl:class-name pcl:class-slots pcl:find-class pcl::standard-class
+ pcl::slot-definition-name pcl:finalize-inheritance
+ pcl::standard-direct-slot-definition pcl::standard-effective-slot-definition
+ pcl::validate-superclass pcl:direct-slot-definition-class
+ pcl:compute-effective-slot-definition
+ pcl::compute-effective-slot-definition-initargs
+ pcl::slot-value-using-class)
+ #+scl
+ '(clos:class-slots clos::standard-class
+ clos::slot-definition-name clos:finalize-inheritance
+ clos::standard-direct-slot-definition clos::standard-effective-slot-definition
+ clos::validate-superclass clos:direct-slot-definition-class
+ clos:compute-effective-slot-definition
+ clos::compute-effective-slot-definition-initargs
+ clos::slot-value-using-class)
+
:hyperobject))
-
+#+sbcl
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (if (find-package 'sb-mop)
+ (setq cl:*features* (delete :sb-mop cl:*features*))
+ (setq cl:*features* (delete :sb-acl cl:*features*))))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: views.lisp,v 1.21 2003/01/17 19:16:28 kevin Exp $
+;;;; $Id: views.lisp,v 1.22 2003/03/25 06:45:57 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
;;;;
(defclass object-view ()
- ((object-class :initform nil :initarg :object-class :accessor object-class
- :documentation "Name of class for object to be viewed.")
+ ((object-class-name :initform nil :initarg :object-class-name
+ :accessor object-class-name
+ :documentation "Name of class of object to be viewed.")
+ (object-class :initform nil :initarg :object-class
+ :accessor object-class
+ :documentation "Class of object to be viewed.")
(slots :initform nil :initarg :slots :accessor slots
:documentation "List of effective slots for object to be viewed.")
(name :initform nil :initarg :name :accessor name
(aif (find category (views obj-class) :key #'category)
it
(let ((view
- (make-instance 'object-view :object-class (class-name obj-class)
+ (make-instance 'object-view :object-class-name (class-name obj-class)
:category category
:slots slots)))
(push view (views obj-class))
((eq view-def :default)
(let* ((name (class-name cl))
(view (make-instance 'object-view :name "automatic"
- :object-class name
+ :object-class-name name
:category :compact-text)))
view))
((consp view-def)
(defmethod initialize-instance :after ((view object-view)
&rest initargs &key &allow-other-keys)
- (initialize-view (find-class (object-class view)) view))
+ (initialize-view (object-class view) view))
(defun initialize-view (obj-cl view)
"Calculate all view slots for a hyperobject class"
(setf (list-end-indent view) t)
(setf (list-end-fmtstr view) "</~a>~%")
(setf (list-end-value-func view) #'xmlformat-list-end-value-func)
- (setf (obj-start-fmtstr view) (format nil "<~(~a~)>" (object-class view)))
+ (setf (obj-start-fmtstr view) (format nil "<~(~a~)>" (object-class-name view)))
(setf (obj-start-indent view) t)
- (setf (obj-end-fmtstr view) (format nil "</~(~a~)>~%" (object-class view)))
+ (setf (obj-end-fmtstr view) (format nil "</~(~a~)>~%" (object-class-name view)))
(setf (obj-end-indent view) nil)
(setf (obj-data-indent view) nil))