From 9fac7ca418d0d16d40c24231a686b3ecd6b6a826 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 25 Mar 2003 06:50:47 +0000 Subject: [PATCH] r4245: Auto commit for Debian build --- package.lisp | 88 +++++++++++++++++++++++++++++----------------------- views.lisp | 20 +++++++----- 2 files changed, 61 insertions(+), 47 deletions(-) diff --git a/package.lisp b/package.lisp index e4221b7..723a22f 100644 --- a/package.lisp +++ b/package.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; ************************************************************************* @@ -34,56 +34,66 @@ (: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*)))) diff --git a/views.lisp b/views.lisp index deef126..795f079 100644 --- a/views.lisp +++ b/views.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -20,8 +20,12 @@ (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 @@ -97,7 +101,7 @@ (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)) @@ -132,7 +136,7 @@ ((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) @@ -142,7 +146,7 @@ (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" @@ -377,9 +381,9 @@ (setf (list-end-indent view) t) (setf (list-end-fmtstr view) "~%") (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 "~%" (object-class view))) + (setf (obj-end-fmtstr view) (format nil "~%" (object-class-name view))) (setf (obj-end-indent view) nil) (setf (obj-data-indent view) nil)) -- 2.34.1