diff --git a/ChangeLog.n b/ChangeLog.n index d85f0af94fe03b3ac273fb4df486892fa5ce12e0..c795e23cd0be5909ce1dd131a25b3ac6bc5ebfe0 100644 --- a/ChangeLog.n +++ b/ChangeLog.n @@ -10,6 +10,25 @@ Tests for new features: <`no new features', `no tests for new features', or <standard changelog date stamp> * <changes go here...> +******************************************************************************* +2.2.2.2 + +Tue Sep 29 10:45:59 1998 Duane Rettig <duane@beta> + + * clim/ptypes.lisp: + * test/test-suite.lisp: + * tk/foreign-obj.lisp: + * tk/gcontext.lisp: + * tk/make-classes.lisp: + * tk/meta-tk.lisp: + * tk/widget.lisp: + * tk/xlib.lisp: + * tk-silica/xt-grapics.lisp: + * utils/autoconstructor.lisp: + * utils/clos.lisp: + * utils/defun.lisp: Move clos internals to excl package; rename + clos package to acl-mop (nicknames mop and clos) + ******************************************************************************* 2.2.2.1 -- join from acl50 branch next merge tag: acl50_merge2 diff --git a/clim/ptypes1.lisp b/clim/ptypes1.lisp index 1398359237a642076d0c25b8df0267a615d0c298..96975766d7dad88598680f31f1ac0e77719fc0aa 100644 --- a/clim/ptypes1.lisp +++ b/clim/ptypes1.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: ptypes1.lisp,v 1.30 1998/08/06 23:16:03 layer Exp $ +;; $Id: ptypes1.lisp,v 1.31 1998/09/29 21:02:32 duane Exp $ (in-package :clim-internals) @@ -415,7 +415,7 @@ #-aclpc (second (class-name class)) #+aclpc (gethash class *presentation-class-name-table*) ) - + (defmethod class-presentation-type-name ((class class) &optional environment) (class-proper-name class environment)) @@ -424,13 +424,13 @@ (defun-inline find-class-prototype (class) (cond #+Allegro - ((eq class clos::*the-class-t*) + ((eq class excl::*the-class-t*) *class-prototype-for-t*) (t ;; Finalization is necessary according to AMOP. -smh 18may93 - (unless (#-aclpc clos:class-finalized-p + (unless (#-aclpc clos:class-finalized-p #+aclpc acl:class-finalized-p class) - (#-aclpc clos:finalize-inheritance + (#-aclpc clos:finalize-inheritance #+aclpc acl:finalize-inheritance class)) (class-prototype class)))) @@ -440,9 +440,9 @@ ;; can come up with structure classes #+Symbolics (find-class-prototype class) ;; Finalization is necessary according to AMOP. -smh 18may93 - (unless (#-aclpc clos:class-finalized-p + (unless (#-aclpc clos:class-finalized-p #+aclpc acl:class-finalized-p class) - (#-aclpc clos:finalize-inheritance + (#-aclpc clos:finalize-inheritance #+aclpc acl:finalize-inheritance class)) (class-precedence-list class)) @@ -798,9 +798,9 @@ (clos:structure-class (setq direct-supertypes 'clos:structure-object)) #+Allegro - (clos::structure-class + (structure-class (setq direct-supertypes 'common-lisp:structure-object)) - #+CCL-2 + #+CCL-2 (structure-class (setq direct-supertypes 'structure-object)) #+aclpc @@ -809,7 +809,7 @@ (t (setq direct-supertypes 'standard-object))))) (with-warnings-for-definition name define-presentation-type - (let* ((supertypes-list (if (listp direct-supertypes) + (let* ((supertypes-list (if (listp direct-supertypes) direct-supertypes (list direct-supertypes))) (direct-superclasses (mapcar #'(lambda (name) @@ -832,7 +832,7 @@ (let ((ptype-package (find-package :registered-presentation-classes)) (*package* (find-package :lisp))) (intern (lisp:format nil "~A ~S" 'ptype name) ptype-package)))) - + ;; If both a regular class and a presentation type class exist, ;; get rid of the presentation type class, with a warning (when (and (not (compile-file-environment-p environment)) @@ -867,7 +867,7 @@ (clos:structure-class 'defstruct) #+CCL-2 (structure-class 'defstruct) #+aclpc (cl:structure-class 'defstruct) - #+Allegro (clos::structure-class 'defstruct)) + #+Allegro (structure-class 'defstruct)) name))) (let ((class-name `(presentation-type ,name))) (setq class @@ -921,7 +921,7 @@ ;;--- Should the following be done at compile time? It's unclear. (find-class registered-class-name) class) #+aclpc (setf (gethash class *presentation-class-name-table*) - name) + name) ;; Always put the class into the table, even if FIND-CLASS could find it, for better ;; virtual memory locality in systems where FIND-CLASS uses the property list. @@ -1386,7 +1386,7 @@ #-CLIM-extends-CLOS (defun generate-presentation-type-inheritance-methods (name class parameters-var options-var &optional environment) - (let ((superclasses + (let ((superclasses #-(or Allegro aclpc) (cdr (class-precedence-list class)) #+aclpc (progn @@ -1878,7 +1878,7 @@ ,(cond ((eq kind ':default) `t) ((eq (class-name class) presentation-type-name) presentation-type-name) - (t + (t #+(or CCL-2 aclpc) (gethash class *presentation-class-type-table*) #-(or CCL-2 aclpc) class)))) (type-class `(,type-class-var diff --git a/test/test-suite.lisp b/test/test-suite.lisp index 9ed60511dc7ab05164c6149c80c79eaeeff0321e..f7461d2d5a90917e383c4161127eea35e3fc6e0a 100644 --- a/test/test-suite.lisp +++ b/test/test-suite.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*- -;; $Id: test-suite.lisp,v 1.83 1998/08/06 23:17:11 layer Exp $ +;; $Id: test-suite.lisp,v 1.84 1998/09/29 21:02:34 duane Exp $ (in-package :clim-user) @@ -1412,14 +1412,14 @@ people, shall not perish from the earth. (let ((color (make-gray-color 0.7))) (format-graph-from-roots ;; dependee-mixin no longer exported -- smh 18may93 - (mapcar #'find-class '(clos:metaobject clos::dependee-mixin)) + (mapcar #'find-class '(clos:metaobject excl::dependee-mixin)) #'(lambda (o s) - (let ((text (format nil "~A" (clos::class-name o)))) + (let ((text (format nil "~A" (excl::class-name o)))) (multiple-value-bind (width height) (text-size s text) (with-new-output-record (s) (draw-rectangle* s 0 0 width height :filled t :ink color) (draw-text* s text 0 0 :align-x :left :align-y :top))))) - #'clos::class-direct-subclasses + #'clos:class-direct-subclasses :stream stream :merge-duplicates t))) @@ -1430,17 +1430,17 @@ people, shall not perish from the earth. (formatting-item-list (stream) (dolist (center-nodes '(nil t)) (formatting-cell (stream) - (format-graph-from-roots + (format-graph-from-roots ;; dependee-mixin no longer exported -- smh 18may93 (mapcar #'find-class '(number)) #'(lambda (o s) - (let ((text (format nil "~A" (#-aclpc clos::class-name + (let ((text (format nil "~A" (#-aclpc excl::class-name #+aclpc cl:class-name o)))) (multiple-value-bind (width height) (text-size s text) (with-new-output-record (s) (draw-rectangle* s 0 0 width height :filled t :ink color) - (draw-text* s text 0 0 :align-x :left :align-y :top))))) - #-aclpc #'clos::class-direct-subclasses + (draw-text* s text 0 0 :align-x :left :align-y :top))))) + #-aclpc #'clos:class-direct-subclasses #+aclpc #'cl::class-direct-subclasses :stream stream :center-nodes center-nodes diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp index 4accb06f2a5aea5b792daa3ee170e218733b9e54..5530c14d8807d0319c4d42e951a8dc043e7cd62a 100644 --- a/tk-silica/xt-graphics.lisp +++ b/tk-silica/xt-graphics.lisp @@ -15,15 +15,15 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: xt-graphics.lisp,v 1.96 1998/08/06 23:17:27 layer Exp $ +;; $Id: xt-graphics.lisp,v 1.97 1998/09/29 21:02:37 duane Exp $ (in-package :tk-silica) (defclass ink-gcontext (tk::gcontext) - ((last-clip-region-tick :initform nil clos::fixed-index 2) - (last-line-style :initform nil clos::fixed-index 3) - (shift-tile-origin :initform nil clos::fixed-index 4) - (ink-clip-region :initform nil clos::fixed-index 5))) + ((last-clip-region-tick :initform nil excl::fixed-index 2) + (last-line-style :initform nil excl::fixed-index 3) + (shift-tile-origin :initform nil excl::fixed-index 4) + (ink-clip-region :initform nil excl::fixed-index 5))) (defmacro ink-gcontext-last-clip-region-tick (gcontext) `(locally (declare (optimize (speed 3) (safety 0))) diff --git a/tk/foreign-obj.lisp b/tk/foreign-obj.lisp index c84a81b3d73e5a2325c96914e12c6aab99a523b3..192447b3ba4f060443747b7530a0711e52054606 100644 --- a/tk/foreign-obj.lisp +++ b/tk/foreign-obj.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: foreign-obj.lisp,v 1.18 1998/08/06 23:17:15 layer Exp $ +;; $Id: foreign-obj.lisp,v 1.19 1998/09/29 21:02:35 duane Exp $ (in-package :tk) @@ -25,7 +25,7 @@ (defclass display (ff:foreign-pointer) ((context :initarg :context :reader display-context) (xid->object-mapping :initform (make-hash-table :test #'equal) - clos::fixed-index 0))) + excl::fixed-index 0))) (defmacro display-xid->object-mapping (object) `(locally (declare (optimize (speed 3) (safety 0))) diff --git a/tk/gcontext.lisp b/tk/gcontext.lisp index 580a949034272dc1a309ef865a804a3cf985c1cd..4b071285c7232900e750740bbfab4c3dfef3c054 100644 --- a/tk/gcontext.lisp +++ b/tk/gcontext.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: gcontext.lisp,v 1.33 1998/08/06 23:17:15 layer Exp $ +;; $Id: gcontext.lisp,v 1.34 1998/09/29 21:02:35 duane Exp $ (in-package :tk) @@ -121,7 +121,7 @@ ',name))) (defclass gcontext (display-object) - ((cached-clip-mask :initform nil clos::fixed-index 1))) + ((cached-clip-mask :initform nil excl::fixed-index 1))) (defmethod initialize-instance :after ((gcontext gcontext) &key diff --git a/tk/make-classes.lisp b/tk/make-classes.lisp index e91dbf7f5529c8145d83a037dc1a443c5a9509be..0bc80674b77eb91cd0232082d80c8d9e03a1432a 100644 --- a/tk/make-classes.lisp +++ b/tk/make-classes.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: make-classes.lisp,v 1.47 1998/08/06 23:17:16 layer Exp $ +;; $Id: make-classes.lisp,v 1.48 1998/09/29 21:02:35 duane Exp $ (in-package :tk) @@ -198,7 +198,7 @@ #+ignore (format excl:*initial-terminal-io* ";; Initializing class ~s~%" class-ep) (let ((class - (clos::ensure-class + (clos:ensure-class (lispify-class-name (widget-class-name handle)) :direct-superclasses (list (if (zerop (xt-class-superclass handle)) 'xt-root-class @@ -341,7 +341,7 @@ ;; This is a terrible hack used to compensate for bugs/inconsistencies ;; in the XM and OLIT toolkits. (defun add-resource-to-class (class resource) - (clos::map-over-subclasses + (excl::map-over-subclasses #'(lambda (c) (pushnew resource (slot-value c 'specially-hacked-resources)) (with-slots (cached-resources get-values-cache set-values-cache @@ -355,8 +355,8 @@ #+(version>= 5 0) (defun fixup-class-entry-points () (let ((root (find-class 'xt-root-class))) - (clos::map-over-subclasses #'tk::unregister-address root) - (clos::map-over-subclasses + (excl::map-over-subclasses #'tk::unregister-address root) + (excl::map-over-subclasses #'(lambda (class) (let* ((old-addr (and (typep class 'xt-class) (ff::foreign-pointer-address class))) @@ -375,8 +375,8 @@ #+(and (not (version>= 5 0)) dlfcn) (defun fixup-class-entry-points () (let ((root (find-class 'xt-root-class))) - (clos::map-over-subclasses #'tk::unregister-address root) - (clos::map-over-subclasses + (excl::map-over-subclasses #'tk::unregister-address root) + (excl::map-over-subclasses #'(lambda (class) (let* ((old-addr (and (typep class 'xt-class) (ff::foreign-pointer-address class))) diff --git a/tk/meta-tk.lisp b/tk/meta-tk.lisp index 2ad07dca65e89d60d12c26397ab0b11538d01e29..f36a7ede3536865905273364c9939f15d0c7dac4 100644 --- a/tk/meta-tk.lisp +++ b/tk/meta-tk.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: meta-tk.lisp,v 1.15 1998/08/06 23:17:16 layer Exp $ +;; $Id: meta-tk.lisp,v 1.16 1998/09/29 21:02:35 duane Exp $ (in-package :tk) @@ -48,9 +48,9 @@ (ff:foreign-pointer-address class)))) (defmethod class-handle ((class xt-class)) - (unless (clos::class-finalized-p class) - (clos::finalize-inheritance class)) - (dolist (c (clos::class-precedence-list class) + (unless (clos:class-finalized-p class) + (clos:finalize-inheritance class)) + (dolist (c (clos:class-precedence-list class) (error "Cannot get handle for class" class)) (when (and (typep c 'xt-class) (not (zerop (ff:foreign-pointer-address c)))) diff --git a/tk/widget.lisp b/tk/widget.lisp index 7bf9d4e500e4ff573e21b132c1de6c56b90990f5..0fa23607acd3dd703b991bcbfb5008d5b42def9a 100644 --- a/tk/widget.lisp +++ b/tk/widget.lisp @@ -15,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: widget.lisp,v 1.45 1998/08/06 23:17:19 layer Exp $ +;; $Id: widget.lisp,v 1.46 1998/09/29 21:02:35 duane Exp $ (in-package :tk) @@ -132,7 +132,7 @@ n))))) (defun find-class-maybe (x) - (if (typep x 'clos::class) x + (if (typep x 'class) x (find-class x))) (defmethod widget-window (widget &optional (errorp t) peek) @@ -286,7 +286,7 @@ (defparameter *fallback-resources* `("clim*dragInitiatorProtocolStyle: DRAG_NONE" "clim*dragreceiverprotocolstyle: DRAG_NONE" - #+ignore + #+ignore ,@(excl:ics-target-case (:+ics '("clim*xnlLanguage: japanese")))) "A list of resource specification strings") diff --git a/tk/xlib.lisp b/tk/xlib.lisp index c3b8c4b92a1f234422e1db3f6683658e66e4bb7b..c2d4bf935e5f3fe8b26c0485011cdf7c7c596efe 100644 --- a/tk/xlib.lisp +++ b/tk/xlib.lisp @@ -15,7 +15,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: xlib.lisp,v 1.61 1998/08/06 23:17:19 layer Exp $ +;; $Id: xlib.lisp,v 1.62 1998/09/29 21:02:35 duane Exp $ (in-package :tk) @@ -37,7 +37,7 @@ (defclass display-object (ff:foreign-pointer) ((display :initarg :display - clos::fixed-index 0))) + excl::fixed-index 0))) (defclass screen (display-object) ()) diff --git a/utils/autoconstructor.lisp b/utils/autoconstructor.lisp index 098e6f30638255dfdf5e08b9f5bafd03025d2c7b..2e8496233cb14778dfbbcd55746a819920e5e467 100644 --- a/utils/autoconstructor.lisp +++ b/utils/autoconstructor.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: autoconstructor.lisp,v 1.8 1998/08/06 23:17:30 layer Exp $ +;; $Id: autoconstructor.lisp,v 1.9 1998/09/29 21:02:38 duane Exp $ ;;; ;;; Copyright (c) 1990 by Xerox Corporation. All rights reserved. @@ -52,7 +52,7 @@ (defvar %constructors-p t) (defun autoconstructor (class) (or - (and %constructors-p (clos::class-autoconstructor + (and %constructors-p (excl::class-autoconstructor (if (symbolp class) (find-class class) class))) #'(lambda (&rest args) (declare (dynamic-extent args)) @@ -75,7 +75,7 @@ #+Allegro-v4.0-constructors (defmacro defautoconstructor (name class &optional extra-args) (when extra-args "Extra args to autocontructor ~S,~S,~S" name class extra-args) - `(clos::defautoconstructor ,name ,class)) + `(excl::defautoconstructor ,name ,class)) #-(or PCL Allegro-v4.0-constructors) (defmacro defautoconstructor (name class &optional extra-args) @@ -87,7 +87,7 @@ ;;; #+PCL -(import '(pcl::class-slots +(import '(pcl::class-slots pcl::class-default-initargs pcl::method-lambda-list pcl::slotd-name @@ -117,7 +117,7 @@ (declare (dynamic-extent args) (ignore args)) (error "Constructor ~S not loaded." ',name)) - + ;; Register auto constructor name (setf (autoconstructor ',class-name) ',name) @@ -127,7 +127,7 @@ ',class-name ',(class-name (class-of class)) ',name - + ;; No initargs in the constructor ;; Established later nil;;',supplied-initarg-names @@ -140,7 +140,7 @@ ;; functions which return the actual constructor code. The ;; constructor code is usually a closures over the arguments ;; to the generator. - ,(make-automatic-constructor-code-generators + ,(make-automatic-constructor-code-generators class name extra-args)))))) (defmethod make-automatic-constructor-code-generators @@ -169,14 +169,14 @@ `(function (lambda (class .wrapper. defaults init shared) (let ((.extra-args. ',extra-args)) - (funcall + (funcall (if ;;; the automatic arglist and hence supplied initargs have ;; not changed since the call to this generator generator, (or (null *clim-development-flag*) - (equal ',arglist + (equal ',arglist (automatic-generator-1 class .extra-args. t))) ;; THEN just continue to use the general generator - ,(funcall (cadr + ,(funcall (cadr (assoc 'pcl::general pcl::*constructor-code-types*)) class name arglist @@ -199,7 +199,7 @@ (defun automatic-generator-1 (class extra-args &optional just-arg-list) (let* ((arg-specs (nconc (copy-list extra-args) (find-constructor-args class))) - (supplied-initargs + (supplied-initargs (unless just-arg-list (with-collection (dolist (spec arg-specs) @@ -228,7 +228,7 @@ (defvar *debug-constructor-hax* nil) - + (defun arg-spec-key (val) (if (listp val) (car val) val)) (defun grope-for-pcl-data (class) @@ -249,7 +249,7 @@ (dolist (m (compute-applicable-methods #'initialize-instance (list (class-prototype class)))) - + (let ((keys (get-keys (method-lambda-list m)))) (when keys (setq all-keys (nconc all-keys keys))))) @@ -258,7 +258,7 @@ (delete-duplicates (with-collection (dolist (default defaults) - (collect + (collect (list (intern (string (car default)) package) (caddr default))))) :from-end t @@ -272,7 +272,7 @@ (form (slotd-initform slotd)) (initargs (slotd-initargs slotd))) (when initargs - (collect + (collect (list name form (remove-duplicates initargs :from-end t))))))) @@ -284,16 +284,16 @@ (unless (classp class) (setq class (find-class class))) (setq package (symbol-package (class-name class))) - + (multiple-value-bind (arg-specs defaults slots) (grope-for-pcl-data class) - + (when *debug-constructor-hax* (format t "~%Having Groped, discovered ... ~%") (pprint (list arg-specs defaults slots)) (terpri)) - - (setq + + (setq arg-specs (nconc arg-specs (with-collection @@ -316,28 +316,28 @@ (when (eq iform pcl::*slotd-unsupplied*) (setq iform 'pcl::*slot-unbound*)) (if (= (length iargs) 1) - (collect + (collect (list (intern (string (car iargs)) package) iform)) ;; (progn (when *debug-constructor-hax* - (warn "Multiple initargs for ~s -> ~s" + (warn "Multiple initargs for ~s -> ~s" class (car slot))) (dolist (iarg iargs) - (collect + (collect (list (intern (string iarg) package) iform))))))))) (unless (member (arg-spec-key iarg-spec) arg-specs :key #'arg-spec-key) (setq arg-specs (nconc arg-specs (list iarg-spec))))) - + (when *debug-constructor-hax* (format t "~%Consolidated into: ~%") (pprint arg-specs) (terpri)) - + arg-specs)) diff --git a/utils/clos.lisp b/utils/clos.lisp index 296d4b9ef4f7b3e26d5cbd0643b5ecca0c2458f9..bf24795259880d889313bf228eaea446921c233f 100644 --- a/utils/clos.lisp +++ b/utils/clos.lisp @@ -16,16 +16,19 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: clos.lisp,v 1.14 1998/08/06 23:17:32 layer Exp $ +;; $Id: clos.lisp,v 1.15 1998/09/29 21:02:38 duane Exp $ ;;; -;;; Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. -;;; +;;; Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved. +;;; ;;; SILICA CLOS Extensions - adaptations of CLOS to meet SILICA's needs. -;;; +;;; (in-package :clim-utils) +#+Allegro-v4.0-constructors +(require :constructor "sys:;clos;constructor") + ;;; ---------------- ;;; Constructors ;;; @@ -42,7 +45,7 @@ #+Allegro-v4.0-constructors (defmacro define-constructor (name class lambda-list &body initargs) - `(clos::defconstructor ,name ,class ,lambda-list ,@initargs)) + `(excl::defconstructor ,name ,class ,lambda-list ,@initargs)) #-(or PCL Allegro-v4.0-constructors) ;; NB: any &REST argument is declared to have dynamic extent! @@ -121,11 +124,11 @@ ; ;(eval-when (compile load eval) (proclaim '(inline %make-standard-class))) ;(defun %make-standard-class (name supers) -; +; ; #+Lucid ; ;; Jonl thinks this is okay, but I personally find it pretty gross. -- RR ; (eval `(defclass ,name ,supers ())) -; +; ; #-Lucid ; ;; by which we mean PCL and Genera CLOS, at this point ; (let ((class (make-instance 'standard-class :direct-superclasses supers))) @@ -142,13 +145,13 @@ ; (when (not #-PCL (typep (car tail) 'standard-class) ; #+PCL (classp (car tail))) ; (setf (car tail) (find-class (car tail)))))) -; +; ; (or (gethash supers *dynamic-classes*) ; ;; ; ;; If there is no entry for a dynamic class with these supers ; ;; then we have to create one. This involves creating the class, ; ;; setting its supers and adding the entry to *dynamic-classes*. -; ;; +; ;; ; (let ((supers (copy-list supers))) ; (setf (gethash supers *dynamic-classes*) ; (%make-standard-class @@ -220,7 +223,7 @@ (defun collect-root-classes (&optional package) (w::with-collection - (let ((classes (mapcar #'find-class (classes-in-package + (let ((classes (mapcar #'find-class (classes-in-package (or package :silica) t)))) (dolist (class classes) (if (not (intersection (pcl::class-local-supers class) @@ -254,7 +257,7 @@ (setf old-p t)))) (return-from make-setf*-function-name (values writer old-p))) (values (setf (get accessor-name 'setf-function-name) - (intern (format nil "~A ~A:~A" + (intern (format nil "~A ~A:~A" 'setf* (package-name (symbol-package accessor-name)) accessor-name) diff --git a/utils/defun.lisp b/utils/defun.lisp index 71b2810270e58858cb8d79c7c7addd58a0c6821d..69018d37ad1ffe375ad33b2e617c80e48f58d047 100644 --- a/utils/defun.lisp +++ b/utils/defun.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: defun.lisp,v 1.14 1998/08/06 23:17:32 layer Exp $ +;; $Id: defun.lisp,v 1.15 1998/09/29 21:02:38 duane Exp $ (in-package :clim-utils) @@ -316,7 +316,7 @@ (defparameter *defgeneric* #+PCL 'pcl::defgeneric - #+Allegro 'clos::defgeneric + #+Allegro 'clos:defgeneric #+aclpc 'cl:defgeneric #-(or Allegro aclpc PCL) 'clos:defgeneric) @@ -331,7 +331,7 @@ ;;; DEFMETHOD needs to handle the DYNAMIC-EXTENT declaration, too. (defparameter *defmethod* #+PCL 'pcl::defmethod - #+Allegro 'clos::defmethod + #+Allegro 'clos:defmethod #+aclpc 'cl:defmethod #-(or Allegro PCL aclpc) 'clos:defmethod) diff --git a/utils/packages.lisp b/utils/packages.lisp index 94c135122e9b0edec837fa1eeffdb3c2fcaff2d8..c316018743f4015b6ebc0e305e6e3b8e77237906 100644 --- a/utils/packages.lisp +++ b/utils/packages.lisp @@ -16,7 +16,7 @@ ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; -;; $Id: packages.lisp,v 1.86 1998/08/06 23:17:35 layer Exp $ +;; $Id: packages.lisp,v 1.87 1998/09/29 21:02:38 duane Exp $ (in-package :common-lisp-user) @@ -3315,7 +3315,7 @@ (cl:defvar *clim-major-version* 2) (cl:defvar *clim-minor-version* 2) (cl:defvar *clim-generation-version* 2) -(cl:defvar *clim-build-version* 1) +(cl:defvar *clim-build-version* 2) (cl:defparameter *clim-version* (cl:format () "~d.~d.~d.~a"