]> code.delx.au - gnu-emacs/commitdiff
* lisp/emacs-lisp/eieio*.el: Align a bit better with CLOS
authorStefan Monnier <monnier@iro.umontreal.ca>
Mon, 16 Feb 2015 07:22:46 +0000 (02:22 -0500)
committerStefan Monnier <monnier@iro.umontreal.ca>
Mon, 16 Feb 2015 07:22:46 +0000 (02:22 -0500)
* lisp/cedet/semantic/db-el.el (semanticdb-elisp-sym->tag): Fix copy&paste
error (semanticdb-project-database => sym).  Avoid eieio--class-public-a
when possible.

* lisp/emacs-lisp/eieio-base.el (make-instance): Add a method here rather
than on eieio-constructor.

* lisp/emacs-lisp/eieio-core.el (eieio--class-print-name): New function.
(eieio-class-name): Make it do what the docstring claims.
(eieio-defclass-internal): Simplify since `prots' isn't used any more.
(eieio--slot-name-index): Simplify accordingly.
(eieio-barf-if-slot-unbound): Pass the class object rather than its
name to `slot-unbound'.

* lisp/emacs-lisp/eieio.el (defclass): Use make-instance rather than
eieio-constructor.
(set-slot-value): Mark as obsolete.
(eieio-object-class-name): Improve call to eieio-class-name.
(eieio-slot-descriptor-name, eieio-class-slots): New functions.
(object-slots): Use it.  Declare obsolete.
(eieio-constructor): Merge it with `make-instance'.
(initialize-instance): Use `dolist'.
(eieio-override-prin1, eieio-edebug-prin1-to-string):
Use eieio--class-print-name.

* test/automated/eieio-test-methodinvoke.el (make-instance): Add methods
here rather than on eieio-constructor.

lisp/ChangeLog
lisp/cedet/ChangeLog
lisp/cedet/semantic/db-el.el
lisp/emacs-lisp/eieio-base.el
lisp/emacs-lisp/eieio-core.el
lisp/emacs-lisp/eieio.el
test/ChangeLog
test/automated/eieio-test-methodinvoke.el

index bb8c97badf7223ccdfefefea2dfe003ad4ca0c3d..e4383437c6d4e59b0a026d1540b9a5609f55dca4 100644 (file)
@@ -1,3 +1,26 @@
+2015-02-16  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * emacs-lisp/eieio.el (defclass): Use make-instance rather than
+       eieio-constructor.
+       (set-slot-value): Mark as obsolete.
+       (eieio-object-class-name): Improve call to eieio-class-name.
+       (eieio-slot-descriptor-name, eieio-class-slots): New functions.
+       (object-slots): Use it.  Declare obsolete.
+       (eieio-constructor): Merge it with `make-instance'.
+       (initialize-instance): Use `dolist'.
+       (eieio-override-prin1, eieio-edebug-prin1-to-string):
+       Use eieio--class-print-name.
+
+       * emacs-lisp/eieio-core.el (eieio--class-print-name): New function.
+       (eieio-class-name): Make it do what the docstring claims.
+       (eieio-defclass-internal): Simplify since `prots' isn't used any more.
+       (eieio--slot-name-index): Simplify accordingly.
+       (eieio-barf-if-slot-unbound): Pass the class object rather than its
+       name to `slot-unbound'.
+
+       * emacs-lisp/eieio-base.el (make-instance): Add a method here rather
+       than on eieio-constructor.
+
 2015-02-16  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        * emacs-lisp/cl-macs.el (cl-defstruct): Keep type=nil by default.
index 6bbae7e08a8802092a0f56660eb848179f676739..838a26934915f6cef98faec69bf6643999007718 100644 (file)
@@ -1,3 +1,9 @@
+2015-02-16  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * semantic/db-el.el (semanticdb-elisp-sym->tag): Fix copy&paste error
+       (semanticdb-project-database => sym).  Avoid eieio--class-public-a
+       when possible.
+
 2015-02-04  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        Use cl-generic instead of EIEIO's defgeneric/defmethod.
index e37b65a461ec999224bb343cb9b6cde3f4a53330..b20a756f6b7af9a3e3493728487f8d3a888658c2 100644 (file)
@@ -223,9 +223,11 @@ TOKTYPE is a hint to the type of tag desired."
            (symbol-name sym)
            "class"
            (semantic-elisp-desymbolify
-             ;; FIXME: This only gives the instance slots and ignores the
-             ;; class-allocated slots.
-            (eieio--class-public-a (find-class 'semanticdb-project-database))) ;; slots ;FIXME: eieio--
+             (let ((class (find-class sym)))
+               (if (fboundp 'eieio-slot-descriptor-name)
+                   (mapcar #'eieio-slot-descriptor-name
+                           (eieio-class-slots class))
+                 (eieio--class-public-a class))))
            (semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents
            ))
          ((not toktype)
index fcf02b92736e90b8dee19ce5d8d368b23afcd690..1cc9f895f8a8e92a14dc436ceacad819d20134f3 100644 (file)
@@ -140,7 +140,7 @@ Multiple calls to `make-instance' will return this object."))
 A singleton is a class which will only ever have one instance."
   :abstract t)
 
-(cl-defmethod eieio-constructor ((class (subclass eieio-singleton)) &rest _slots)
+(cl-defmethod make-instance ((class (subclass eieio-singleton)) &rest _slots)
   "Constructor for singleton CLASS.
 NAME and SLOTS initialize the new object.
 This constructor guarantees that no matter how many you request,
index e71c54d412317909ff6859678e7919d1775696f9..408922a2daac200c43570ae9c0567b5d85cc760d 100644 (file)
@@ -181,15 +181,15 @@ Currently under control of this var:
 CLASS is a symbol."                     ;FIXME: Is it a vector or a symbol?
   (and (symbolp class) (eieio--class-p (eieio--class-v class))))
 
+(defun eieio--class-print-name (class)
+  "Return a printed representation of CLASS."
+  (format "#<class %s>" (eieio-class-name class)))
+
 (defun eieio-class-name (class)
   "Return a Lisp like symbol name for CLASS."
-  ;; FIXME: What's a "Lisp like symbol name"?
-  ;; FIXME: CLOS returns a symbol, but the code returns a string.
-  (if (eieio--class-p class) (setq class (eieio--class-symbol class)))
-  (cl-check-type class class)
-  ;; I think this is supposed to return a symbol, but to me CLASS is a symbol,
-  ;; and I wanted a string.  Arg!
-  (format "#<class %s>" (symbol-name class)))
+  (setq class (eieio--class-object class))
+  (cl-check-type class eieio--class)
+  (eieio--class-symbol class))
 (define-obsolete-function-alias 'class-name #'eieio-class-name "24.4")
 
 (defalias 'eieio--class-constructor #'identity
@@ -317,7 +317,7 @@ See `defclass' for more information."
         (newc (if (and oldc (not (eieio--class-default-object-cache oldc)))
                    ;; The oldc class is a stub setup by eieio-defclass-autoload.
                    ;; Reuse it instead of creating a new one, so that existing
-                   ;; references are still valid.
+                   ;; references stay valid.
                    oldc
                  (eieio--class-make cname)))
         (groups nil) ;; list of groups id'd from slots
@@ -488,16 +488,10 @@ See `defclass' for more information."
     ;; Attach slot symbols into a hashtable, and store the index of
     ;; this slot as the value this table.
     (let* ((cnt 0)
-          (pubsyms (eieio--class-public-a newc))
-          (prots (eieio--class-protection newc))
           (oa (make-hash-table :test #'eq)))
-      (while pubsyms
-       (let ((newsym (list cnt)))
-          (setf (gethash (car pubsyms) oa) newsym)
-          (setq cnt (1+ cnt))
-          (if (car prots) (setcdr newsym (car prots))))
-       (setq pubsyms (cdr pubsyms)
-             prots (cdr prots)))
+      (dolist (pubsym (eieio--class-public-a newc))
+        (setf (gethash pubsym oa) cnt)
+        (setq cnt (1+ cnt)))
       (setf (eieio--class-symbol-hashtable newc) oa))
 
     ;; Set up a specialized doc string.
@@ -895,7 +889,7 @@ INSTANCE is the object being referenced.  SLOTNAME is the offending
 slot.  If the slot is ok, return VALUE.
 Argument FN is the function calling this verifier."
   (if (and (eq value eieio-unbound) (not eieio-skip-typecheck))
-      (slot-unbound instance (eieio--object-class-name instance) slotname fn)
+      (slot-unbound instance (eieio--object-class-object instance) slotname fn)
     value))
 
 \f
@@ -1029,8 +1023,7 @@ The slot is a symbol which is installed in CLASS by the `defclass' call.
 If SLOT is the value created with :initarg instead,
 reverse-lookup that name, and recurse with the associated slot value."
   ;; Removed checks to outside this call
-  (let* ((fsym (gethash slot (eieio--class-symbol-hashtable class)))
-        (fsi (car fsym)))
+  (let* ((fsi (gethash slot (eieio--class-symbol-hashtable class))))
     (if (integerp fsi)
         (+ (eval-when-compile eieio--object-num-slots) fsi)
       (let ((fn (eieio--initarg-to-attribute class slot)))
index 526090954a9807074573762d003add1fe593cf4d..4f6b6d731833422f05fbb38cb53ce860d1a193c0 100644 (file)
@@ -272,34 +272,9 @@ This method is obsolete."
                             ;; but hide it so we don't trigger indefinitely.
                             `(,(car whole) (identity ,(car slots))
                               ,@(cdr slots)))))))
-             (apply #'eieio-constructor ',name slots))))))
+             (apply #'make-instance ',name slots))))))
 
 
-;;; CLOS style implementation of object creators.
-;;
-(defun make-instance (class &rest initargs)
-  "Make a new instance of CLASS based on INITARGS.
-CLASS is a class symbol.  For example:
-
-  (make-instance 'foo)
-
-  INITARGS is a property list with keywords based on the :initarg
-for each slot.  For example:
-
-  (make-instance 'foo :slot1 value1 :slotN valueN)
-
-Compatibility note:
-
-If the first element of INITARGS is a string, it is used as the
-name of the class.
-
-In EIEIO, the class' constructor requires a name for use when printing.
-`make-instance' in CLOS doesn't use names the way Emacs does, so the
-class is used as the name slot instead when INITARGS doesn't start with
-a string."
-  (apply (eieio--class-constructor class) initargs))
-
-\f
 ;;; Get/Set slots in an object.
 ;;
 (defmacro oref (obj slot)
@@ -311,6 +286,7 @@ created by the :initarg tag."
 
 (defalias 'slot-value 'eieio-oref)
 (defalias 'set-slot-value 'eieio-oset)
+(make-obsolete 'set-slot-value "use (setf (slot-value ..) ..) instead" "25.1")
 
 (defmacro oref-default (obj slot)
   "Get the default value of OBJ (maybe a class) for SLOT.
@@ -363,7 +339,7 @@ variable name of the same name as the slot."
   (declare (obsolete eieio-named "25.1")))
 
 (defun eieio-object-name (obj &optional extra)
-  "Return a Lisp like symbol string for object OBJ.
+  "Return a printed representation for object OBJ.
 If EXTRA, include that in the string returned to represent the symbol."
   (cl-check-type obj eieio-object)
   (format "#<%s %s%s>" (eieio--object-class-name obj)
@@ -402,7 +378,7 @@ If EXTRA, include that in the string returned to represent the symbol."
 (defun eieio-object-class-name (obj)
   "Return a Lisp like symbol name for OBJ's class."
   (cl-check-type obj eieio-object)
-  (eieio-class-name (eieio--object-class-name obj)))
+  (eieio-class-name (eieio--object-class-object obj)))
 (define-obsolete-function-alias
   'object-class-name 'eieio-object-class-name "24.4")
 
@@ -463,10 +439,23 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
                 child (pop p)))
         (if child t))))
 
+(defun eieio-slot-descriptor-name (slot) slot)
+
+(defun eieio-class-slots (class)
+  "Return list of slots available in instances of CLASS."
+  ;; FIXME: This only gives the instance slots and ignores the
+  ;; class-allocated slots.
+  ;; FIXME: It only gives the slot's *names* rather than actual
+  ;; slot descriptors.
+  (setq class (eieio--class-object class))
+  (cl-check-type class eieio--class)
+  (eieio--class-public-a class))
+
 (defun object-slots (obj)
   "Return list of slots available in OBJ."
+  (declare (obsolete eieio-class-slots "25.1"))
   (cl-check-type obj eieio-object)
-  (eieio--class-public-a (eieio--object-class-object obj)))
+  (eieio-class-slots (eieio--object-class-object obj)))
 
 (defun eieio--class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg."
   (cl-check-type class eieio--class)
@@ -613,6 +602,9 @@ If SLOT is unbound, do nothing."
 ;;; Here are some CLOS items that need the CL package
 ;;
 
+;; FIXME: Shouldn't this be a more complex gv-expander which extracts the
+;; common code between oref and oset, so as to reduce the redundant work done
+;; in (push foo (oref bar baz)), like we do for the `nth' expander?
 (gv-define-simple-setter eieio-oref eieio-oset)
 
 \f
@@ -636,20 +628,28 @@ This class is not stored in the `parent' slot of a class vector."
 
 (defalias 'standard-class 'eieio-default-superclass)
 
-(cl-defgeneric eieio-constructor (class &rest slots)
-  "Default constructor for CLASS `eieio-default-superclass'.")
+(cl-defgeneric make-instance (class &rest initargs)
+  "Make a new instance of CLASS based on INITARGS.
+For example:
+
+  (make-instance 'foo)
+
+INITARGS is a property list with keywords based on the `:initarg'
+for each slot.  For example:
+
+  (make-instance 'foo :slot1 value1 :slotN valueN)")
 
-(define-obsolete-function-alias 'constructor #'eieio-constructor "25.1")
+(define-obsolete-function-alias 'constructor #'make-instance "25.1")
 
-(cl-defmethod eieio-constructor
-  ((class (subclass eieio-default-superclass)) &rest slots)
+(cl-defmethod make-instance
+    ((class (subclass eieio-default-superclass)) &rest slots)
   "Default constructor for CLASS `eieio-default-superclass'.
-SLOTS are the initialization slots used by `shared-initialize'.
+SLOTS are the initialization slots used by `initialize-instance'.
 This static method is called when an object is constructed.
 It allocates the vector used to represent an EIEIO object, and then
-calls `shared-initialize' on that object."
+calls `initialize-instance' on that object."
   (let* ((new-object (copy-sequence (eieio--class-default-object-cache
-                                     (eieio--class-v class)))))
+                                     (eieio--class-object class)))))
     (if (and slots
              (let ((x (car slots)))
                (or (stringp x) (null x))))
@@ -662,6 +662,7 @@ calls `shared-initialize' on that object."
     ;; Return the created object.
     new-object))
 
+;; FIXME: CLOS uses "&rest INITARGS" instead.
 (cl-defgeneric shared-initialize (obj slots)
   "Set slots of OBJ with SLOTS which is a list of name/value pairs.
 Called from the constructor routine.")
@@ -677,6 +678,7 @@ Called from the constructor routine."
         (eieio-oset obj rn (car (cdr slots)))))
     (setq slots (cdr (cdr slots)))))
 
+;; FIXME: CLOS uses "&rest INITARGS" instead.
 (cl-defgeneric initialize-instance (this &optional slots)
   "Construct the new object THIS based on SLOTS.")
 
@@ -693,9 +695,8 @@ dynamically set from SLOTS."
   ;; First, see if any of our defaults are `lambda', and
   ;; re-evaluate them and apply the value to our slots.
   (let* ((this-class (eieio--object-class-object this))
-        (slot (eieio--class-public-a this-class))
         (defaults (eieio--class-public-d this-class)))
-    (while slot
+    (dolist (slot (eieio--class-public-a this-class))
       ;; For each slot, see if we need to evaluate it.
       ;;
       ;; Paul Landes said in an email:
@@ -705,10 +706,9 @@ dynamically set from SLOTS."
       ;; > web.
       (let ((dflt (eieio-default-eval-maybe (car defaults))))
        (when (not (eq dflt (car defaults)))
-         (eieio-oset this (car slot) dflt) ))
+         (eieio-oset this slot dflt) ))
       ;; Next.
-      (setq slot (cdr slot)
-           defaults (cdr defaults))))
+      (setq defaults (cdr defaults))))
   ;; Shared initialize will parse our slots for us.
   (shared-initialize this slots))
 
@@ -742,7 +742,8 @@ Use `slot-boundp' to determine if a slot is bound or not.
 
 In CLOS, the argument list is (CLASS OBJECT SLOT-NAME), but
 EIEIO can only dispatch on the first argument, so the first two are swapped."
-  (signal 'unbound-slot (list (eieio-class-name class) (eieio-object-name object)
+  (signal 'unbound-slot (list (eieio-class-name class)
+                              (eieio-object-name object)
                              slot-name fn)))
 
 (cl-defgeneric clone (obj &rest params)
@@ -861,7 +862,7 @@ this object."
        ((consp thing)
         (eieio-list-prin1 thing))
        ((eieio--class-p thing)
-        (princ (eieio-class-name thing)))
+        (princ (eieio--class-print-name thing)))
        (t (prin1 thing))))
 
 (defun eieio-list-prin1 (list)
@@ -902,7 +903,7 @@ of `eq'."
 Used as advice around `edebug-prin1-to-string', held in the
 variable PRINT-FUNCTION.  Optional argument NOESCAPE is passed to
 `prin1-to-string' when appropriate."
-  (cond ((eieio--class-p object) (eieio-class-name object))
+  (cond ((eieio--class-p object) (eieio--class-print-name object))
        ((eieio-object-p object) (object-print object))
        ((and (listp object) (or (eieio--class-p (car object))
                                 (eieio-object-p (car object))))
index 29b7c7d59eaca66020f98a0b83c16ec91a633615..87425a69148ab15b0f603ae0ff654917f60b82df 100644 (file)
@@ -1,3 +1,8 @@
+2015-02-16  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * automated/eieio-test-methodinvoke.el (make-instance): Add methods
+       here rather than on eieio-constructor.
+
 2015-02-13  Magnus Henoch  <magnus.henoch@gmail.com>
 
        * automated/sasl-scram-rfc-tests.el: New file.
index da5f59a4654b2b585054b9a938317a515709952c..62f5603d3b67f7c3d7f3effac1d3f8033ab9faf6 100644 (file)
   (if (next-method-p) (call-next-method))
   )
 
-(defmethod eieio-constructor :STATIC ((p C-base2) &rest args)
+(defmethod make-instance :STATIC ((p C-base2) &rest args)
   (eieio-test-method-store :STATIC 'C-base2)
   (if (next-method-p) (call-next-method))
   )
 
-(defmethod eieio-constructor :STATIC ((p C) &rest args)
+(defmethod make-instance :STATIC ((p C) &rest args)
   (eieio-test-method-store :STATIC 'C)
   (call-next-method)
   )