Commit c4e2be45 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/emacs-lisp/eieio*.el: Align a bit better with CLOS

* 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.
parent 6bf61df8
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.
......
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.
......
......@@ -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)
......
......@@ -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,
......
......@@ -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))
......@@ -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)))
......
......@@ -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))
;;; 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)
......@@ -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))))
......
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.
......
......@@ -179,12 +179,12 @@
(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)
)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment