procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/emacs-lisp/eieio*.el: Remove "name" field of objects

Browse source 
* lisp/emacs-lisp/eieio-base.el (clone) <eieio-instance-inheritor>:
Use call-next-method.
(eieio-constructor): Rename from `constructor'.
(eieio-persistent-convert-list-to-object): Drop objname.
(eieio-persistent-validate/fix-slot-value): Don't hardcode
eieio--object-num-slots.
(eieio-named): Use a normal slot.
(slot-missing) <eieio-named>: Remove.
(eieio-object-name-string, eieio-object-set-name-string, clone)
<eieio-named>: New methods.

* lisp/emacs-lisp/eieio-core.el (eieio--defalias): Follow aliases.
(eieio--object): Remove `name' field.
(eieio-defclass): Adjust to new convention where constructors don't
take an "object name" any more.
(eieio--defgeneric-init-form, eieio--defmethod): Follow aliases.
(eieio-validate-slot-value, eieio-oset-default)
(eieio-slot-name-index): Don't hardcode eieio--object-num-slots.
(eieio-generic-call-primary-only): Simplify.

* lisp/emacs-lisp/eieio-custom.el (eieio-widget-test): Remove dummy arg.
(eieio-object-value-get): Use eieio-object-set-name-string.

* lisp/emacs-lisp/eieio.el (make-instance): Simplify by not adding an object
name argument.
(eieio-object-name): Use eieio-object-name-string.
(eieio--object-names): New const.
(eieio-object-name-string, eieio-object-set-name-string): Re-implement
using a hashtable rather than a built-in slot.
(eieio-constructor): Rename from `constructor'.  Remove `newname' arg.
(clone): Don't mess with the object's "name".

* test/automated/eieio-test-persist.el (persistent-with-objs-slot-subs):
The type FOO-child is the same as FOO.

* test/automated/eieio-tests.el: Remove dummy object names.
This commit is contained in:
Stefan Monnier 2014-12-22 22:05:46 -05:00
parent d4a12e7a9a
commit ee93d7ad42
8 changed files with 167 additions and 135 deletions
Download patch file Download diff file Expand all files Collapse all files

80
lisp/emacs-lisp/eieio-base.el
View file

@ -63,25 +63,10 @@ SLOT-NAME is the offending slot. FN is the function signaling the error."
;; Throw the regular signal.
(call-next-method)))
(defmethod clone ((obj eieio-instance-inheritor) &rest params)
(defmethod clone ((obj eieio-instance-inheritor) &rest _params)
"Clone OBJ, initializing `:parent' to OBJ.
All slots are unbound, except those initialized with PARAMS."
(let ((nobj (make-vector (length obj) eieio-unbound))
(nm (eieio--object-name obj))
(passname (and params (stringp (car params))))
(num 1))
(aset nobj 0 'object)
(setf (eieio--object-class nobj) (eieio--object-class obj))
;; The following was copied from the default clone.
(if (not passname)
(save-match-data
(if (string-match "-\\([0-9]+\\)" nm)
(setq num (1+ (string-to-number (match-string 1 nm)))
nm (substring nm 0 (match-beginning 0))))
(setf (eieio--object-name nobj) (concat nm "-" (int-to-string num))))
(setf (eieio--object-name nobj) (car params)))
;; Now initialize from params.
(if params (shared-initialize nobj (if passname (cdr params) params)))
(let ((nobj (call-next-method)))
(oset nobj parent-instance obj)
nobj))
@ -155,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)
(defmethod constructor :STATIC ((class eieio-singleton) _name &rest _slots)
(defmethod eieio-constructor :STATIC ((class 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,
@ -270,7 +255,7 @@ malicious code.
Note: This function recurses when a slot of :type of some object is
identified, and needing more object creation."
(let ((objclass (nth 0 inputlist))
(objname (nth 1 inputlist))
;; (objname (nth 1 inputlist))
(slots (nthcdr 2 inputlist))
(createslots nil))
@ -293,7 +278,7 @@ identified, and needing more object creation."
(setq slots (cdr (cdr slots))))
(apply 'make-instance objclass objname (nreverse createslots))
(apply #'make-instance objclass (nreverse createslots))
;;(eval inputlist)
))
@ -308,7 +293,8 @@ Second, any text properties will be stripped from strings."
(let ((slot-idx (eieio-slot-name-index class nil slot))
(type nil)
(classtype nil))
(setq slot-idx (- slot-idx 3))
(setq slot-idx (- slot-idx
(eval-when-compile eieio--object-num-slots)))
(setq type (aref (eieio--class-public-type (eieio--class-v class))
slot-idx))
@ -463,34 +449,38 @@ instance."
;;; Named object
;;
;; Named objects use the objects `name' as a slot, and that slot
;; is accessed with the `object-name' symbol.
(defclass eieio-named ()
()
"Object with a name.
Name storage already occurs in an object. This object provides get/set
access to it."
((object-name :initarg :object-name :initform nil))
"Object with a name."
:abstract t)
(defmethod slot-missing ((obj eieio-named)
slot-name operation &optional new-value)
"Called when a non-existent slot is accessed.
For variable `eieio-named', provide an imaginary `object-name' slot.
Argument OBJ is the named object.
Argument SLOT-NAME is the slot that was attempted to be accessed.
OPERATION is the type of access, such as `oref' or `oset'.
NEW-VALUE is the value that was being set into SLOT if OPERATION were
a set type."
(if (memq slot-name '(object-name :object-name))
(cond ((eq operation 'oset)
(if (not (stringp new-value))
(signal 'invalid-slot-type
(list obj slot-name 'string new-value)))
(eieio-object-set-name-string obj new-value))
(t (eieio-object-name-string obj)))
(call-next-method)))
(defmethod eieio-object-name-string ((obj eieio-named))
"Return a string which is OBJ's name."
(or (slot-value obj 'object-name)
(symbol-name (eieio-object-class obj))))
(defmethod eieio-object-set-name-string ((obj eieio-named) name)
"Set the string which is OBJ's NAME."
(eieio--check-type stringp name)
(eieio-oset obj 'object-name name))
(defmethod clone ((obj eieio-named) &rest params)
"Clone OBJ, initializing `:parent' to OBJ.
All slots are unbound, except those initialized with PARAMS."
(let* ((newname (and (stringp (car params)) (pop params)))
(nobj (apply #'call-next-method obj params))
(nm (slot-value obj 'object-name)))
(eieio-oset obj 'object-name
(or newname
(save-match-data
(if (and nm (string-match "-\\([0-9]+\\)" nm))
(let ((num (1+ (string-to-number
(match-string 1 nm)))))
(concat (substring nm 0 (match-beginning 0))
"-" (int-to-string num)))
(concat nm "-1")))))
nobj))
(provide 'eieio-base)

55
lisp/emacs-lisp/eieio-core.el
View file

@ -39,6 +39,9 @@
"Like `defalias', but with less side-effects.
More specifically, it has no side-effects at all when the new function
definition is the same (`eq') as the old one."
(while (and (fboundp name) (symbolp (symbol-function name)))
;; Follow aliases, so methods applied to obsolete aliases still work.
(setq name (symbol-function name)))
(unless (and (fboundp name)
(eq (symbol-function name) body))
(defalias name body)))
@ -167,8 +170,7 @@ Stored outright without modifications or stripping.")))
(eieio--define-field-accessors object
(-unused-0 ;;Constant slot, set to `object'.
(class "class struct defining OBJ")
name)) ;FIXME: Get rid of this field!
(class "class struct defining OBJ")))
;; FIXME: The constants below should have an `eieio-' prefix added!!
(defconst eieio--method-static 0 "Index into :static tag on a method.")
@ -480,10 +482,10 @@ See `defclass' for more information."
;; Create the test function
(let ((csym (intern (concat (symbol-name cname) "-p"))))
(fset csym
(list 'lambda (list 'obj)
(format "Test OBJ to see if it an object of type %s" cname)
(list 'and '(eieio-object-p obj)
(list 'same-class-p 'obj cname)))))
`(lambda (obj)
,(format "Test OBJ to see if it an object of type %s" cname)
(and (eieio-object-p obj)
(same-class-p obj ',cname)))))
;; Make sure the method invocation order is a valid value.
(let ((io (class-option-assoc options :method-invocation-order)))
@ -499,7 +501,7 @@ See `defclass' for more information."
"Test OBJ to see if it an object is a child of type %s"
cname)
(and (eieio-object-p obj)
(object-of-class-p obj ,cname))))
(object-of-class-p obj ',cname))))
;; When using typep, (typep OBJ 'myclass) returns t for objects which
;; are subclasses of myclass. For our predicates, however, it is
@ -722,9 +724,14 @@ See `defclass' for more information."
;; Non-abstract classes need a constructor.
(fset cname
`(lambda (newname &rest slots)
`(lambda (&rest slots)
,(format "Create a new object with name NAME of class type %s" cname)
(apply #'constructor ,cname newname slots)))
(if (and slots
(let ((x (car slots)))
(or (stringp x) (null x))))
(message "Obsolete name %S passed to %S constructor"
(pop slots) ',cname))
(apply #'eieio-constructor ',cname slots)))
)
;; Set up a specialized doc string.
@ -761,7 +768,6 @@ See `defclass' for more information."
nil)))
(aset cache 0 'object)
(setf (eieio--object-class cache) cname)
(setf (eieio--object-name cache) 'default-cache-object)
(let ((eieio-skip-typecheck t))
;; All type-checking has been done to our satisfaction
;; before this call. Don't waste our time in this call..
@ -1087,6 +1093,10 @@ the new child class."
(defun eieio--defgeneric-init-form (method doc-string)
"Form to use for the initial definition of a generic."
(while (and (fboundp method) (symbolp (symbol-function method)))
;; Follow aliases, so methods applied to obsolete aliases still work.
(setq method (symbol-function method)))
(cond
((or (not (fboundp method))
(eq 'autoload (car-safe (symbol-function method))))
@ -1198,6 +1208,11 @@ but remove reference to all implementations of METHOD."
;; Primary key.
;; (t eieio--method-primary)
(t (error "Unknown method kind %S" kind)))))
(while (and (fboundp method) (symbolp (symbol-function method)))
;; Follow aliases, so methods applied to obsolete aliases still work.
(setq method (symbol-function method)))
;; Make sure there is a generic (when called from defclass).
(eieio--defalias
method (eieio--defgeneric-init-form
@ -1253,7 +1268,7 @@ an error."
(if eieio-skip-typecheck
nil
;; Trim off object IDX junk added in for the object index.
(setq slot-idx (- slot-idx 3))
(setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots)))
(let ((st (aref (eieio--class-public-type (eieio--class-v class)) slot-idx)))
(if (not (eieio-perform-slot-validation st value))
(signal 'invalid-slot-type (list class slot st value))))))
@ -1324,7 +1339,8 @@ Fills in OBJ's SLOT with its default value."
;;(signal 'invalid-slot-name (list (class-name cl) slot))
)
(eieio-barf-if-slot-unbound
(let ((val (nth (- c 3) (eieio--class-public-d (eieio--class-v cl)))))
(let ((val (nth (- c (eval-when-compile eieio--object-num-slots))
(eieio--class-public-d (eieio--class-v cl)))))
(eieio-default-eval-maybe val))
obj cl 'oref-default))))
@ -1382,7 +1398,8 @@ Fills in the default value in CLASS' in SLOT with VALUE."
(signal 'invalid-slot-name (list (eieio-class-name class) slot)))
(eieio-validate-slot-value class c value slot)
;; Set this into the storage for defaults.
(setcar (nthcdr (- c 3) (eieio--class-public-d (eieio--class-v class)))
(setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots))
(eieio--class-public-d (eieio--class-v class)))
value)
;; Take the value, and put it into our cache object.
(eieio-oset (eieio--class-default-object-cache (eieio--class-v class))
@ -1420,18 +1437,18 @@ reverse-lookup that name, and recurse with the associated slot value."
(if (integerp fsi)
(cond
((not (cdr fsym))
(+ 3 fsi))
(+ (eval-when-compile eieio--object-num-slots) fsi))
((and (eq (cdr fsym) 'protected)
(eieio--scoped-class)
(or (child-of-class-p class (eieio--scoped-class))
(and (eieio-object-p obj)
(child-of-class-p class (eieio--object-class obj)))))
(+ 3 fsi))
(+ (eval-when-compile eieio--object-num-slots) fsi))
((and (eq (cdr fsym) 'private)
(or (and (eieio--scoped-class)
(eieio-slot-originating-class-p (eieio--scoped-class) slot))
eieio-initializing-object))
(+ 3 fsi))
(+ (eval-when-compile eieio--object-num-slots) fsi))
(t nil))
(let ((fn (eieio-initarg-to-attribute class slot)))
(if fn (eieio-slot-name-index class obj fn) nil)))))
@ -1778,12 +1795,8 @@ for this common case to improve performance."
(setq mclass (eieio--object-class firstarg)))
((not firstarg)
(error "Method %s called on nil" method))
((not (eieio-object-p firstarg))
(error "Primary-only method %s called on something not an object" method))
(t
(error "EIEIO Error: Improperly classified method %s as primary only"
method)
))
(error "Primary-only method %s called on something not an object" method)))
;; Make sure the class is a valid class
;; mclass can be nil (meaning a generic for should be used.
;; mclass cannot have a value that is not a class, however.

4
lisp/emacs-lisp/eieio-custom.el
View file

@ -70,7 +70,7 @@ of these.")
:documentation "A number of thingies."))
"A class for testing the widget on.")
(defcustom eieio-widget-test (eieio-widget-test-class "Foo")
(defcustom eieio-widget-test (eieio-widget-test-class)
"Test variable for editing an object."
:type 'object
:group 'eieio)
@ -317,7 +317,7 @@ Optional argument IGNORE is an extraneous parameter."
fgroup (cdr fgroup)
fcust (cdr fcust)))
;; Set any name updates on it.
(if name (setf (eieio--object-name obj) name))
(if name (eieio-object-set-name-string obj name))
;; This is the same object we had before.
obj))

60
lisp/emacs-lisp/eieio.el
View file

@ -144,12 +144,7 @@ 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."
(if (and (car initargs) (stringp (car initargs)))
(apply (class-constructor class) initargs)
(apply (class-constructor class)
(cond ((symbolp class) (symbol-name class))
(t (format "%S" class)))
initargs)))
(apply (class-constructor class) initargs))
;;; CLOS methods and generics
@ -279,20 +274,28 @@ variable name of the same name as the slot."
If EXTRA, include that in the string returned to represent the symbol."
(eieio--check-type eieio-object-p obj)
(format "#<%s %s%s>" (symbol-name (eieio--object-class obj))
(eieio--object-name obj) (or extra "")))
(eieio-object-name-string obj) (or extra "")))
(define-obsolete-function-alias 'object-name #'eieio-object-name "24.4")
(defun eieio-object-name-string (obj) "Return a string which is OBJ's name."
(eieio--check-type eieio-object-p obj)
(eieio--object-name obj))
(defconst eieio--object-names (make-hash-table :test #'eq :weakness 'key))
;; In the past, every EIEIO object had a `name' field, so we had the two method
;; below "for free". Since this field is very rarely used, we got rid of it
;; and instead we keep it in a weak hash-tables, for those very rare objects
;; that use it.
(defmethod eieio-object-name-string (obj)
"Return a string which is OBJ's name."
(declare (obsolete eieio-named "25.1"))
(or (gethash obj eieio--object-names)
(symbol-name (eieio-object-class obj))))
(define-obsolete-function-alias
'object-name-string #'eieio-object-name-string "24.4")
(defun eieio-object-set-name-string (obj name)
(defmethod eieio-object-set-name-string (obj name)
"Set the string which is OBJ's NAME."
(eieio--check-type eieio-object-p obj)
(declare (obsolete eieio-named "25.1"))
(eieio--check-type stringp name)
(setf (eieio--object-name obj) name))
(setf (gethash obj eieio--object-names) name))
(define-obsolete-function-alias
'object-set-name-string 'eieio-object-set-name-string "24.4")
@ -574,20 +577,19 @@ This class is not stored in the `parent' slot of a class vector."
(defalias 'standard-class 'eieio-default-superclass)
(defgeneric constructor (class newname &rest slots)
(defgeneric eieio-constructor (class &rest slots)
"Default constructor for CLASS `eieio-default-superclass'.")
(defmethod constructor :static
((class eieio-default-superclass) newname &rest slots)
(define-obsolete-function-alias 'constructor #'eieio-constructor "25.1")
(defmethod eieio-constructor :static
((class eieio-default-superclass) &rest slots)
"Default constructor for CLASS `eieio-default-superclass'.
NEWNAME is the name to be given to the constructed object.
SLOTS are the initialization slots used by `shared-initialize'.
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."
(let* ((new-object (copy-sequence (eieio--class-default-object-cache (eieio--class-v class)))))
;; Update the name for the newly created object.
(setf (eieio--object-name new-object) newname)
;; Call the initialize method on the new object with the slots
;; that were passed down to us.
(initialize-instance new-object slots)
@ -715,18 +717,10 @@ first and modify the returned object.")
(defmethod clone ((obj eieio-default-superclass) &rest params)
"Make a copy of OBJ, and then apply PARAMS."
(let ((nobj (copy-sequence obj))
(nm (eieio--object-name obj))
(passname (and params (stringp (car params))))
(num 1))
(if params (shared-initialize nobj (if passname (cdr params) params)))
(if (not passname)
(save-match-data
(if (string-match "-\\([0-9]+\\)" nm)
(setq num (1+ (string-to-number (match-string 1 nm)))
nm (substring nm 0 (match-beginning 0))))
(setf (eieio--object-name nobj) (concat nm "-" (int-to-string num))))
(setf (eieio--object-name nobj) (car params)))
(let ((nobj (copy-sequence obj)))
(if (stringp (car params))
(message "Obsolete name %S passed to clone" (pop params)))
(if params (shared-initialize nobj params))
nobj))
(defgeneric destructor (this &rest params)
@ -889,7 +883,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
;;; Start of automatically extracted autoloads.
;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "6413249ec10091eb7094238637b40e2c")
;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "3a6fffe3af331fe960f967d0da99e8e9")
;;; Generated autoloads from eieio-custom.el
(autoload 'customize-object "eieio-custom" "\
@ -900,7 +894,7 @@ Optional argument GROUP is the sub-group of slots to display.
;;;***
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "6f114a48de40212413d2776eedc3ec14")
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "2ff7d98da3f84c6af5c873ffb781930e")
;;; Generated autoloads from eieio-opt.el
(autoload 'eieio-browse "eieio-opt" "\