Commit cb4db863 authored by Stefan Monnier's avatar Stefan Monnier

* lisp/emacs-lisp/eieio*.el: Use class objects in `parent' field.

* lisp/emacs-lisp/eieio-core.el (eieio-class-object): New function.
(eieio-class-parents-fast): Remove macro.
(eieio--class-option-assoc): Rename from class-option-assoc.
Update all callers.
(eieio--class-option): Rename from class-option.  Change `class' arg to
be a class object.  Update all callers.
(eieio--class-method-invocation-order): Rename from
class-method-invocation-order.  Change `class' arg to be a class
object.  Update all callers.
(eieio-defclass-autoload, eieio-defclass): Set the `parent' field to
a list of class objects rather than names.
(eieio-defclass): Remove redundant quotes.  Use `eieio-oref-default'
for accessors to class allocated slots.
(eieio--perform-slot-validation-for-default): Rename from
eieio-perform-slot-validation-for-default.  Update all callers.
(eieio--add-new-slot): Rename from eieio-add-new-slot.
Update all callers.  Use push.
(eieio-copy-parents-into-subclass): Adjust to new content of
`parent' field.  Use dolist.
(eieio-oref): Remove support for providing a class rather than
an object.
(eieio-oref-default): Prefer class objects over class names.
(eieio--slot-originating-class-p): Rename from
eieio-slot-originating-class-p.  Update all callers.  Use `or'.
(eieio--slot-name-index): Turn check into assertion.
(eieio--class-slot-name-index): Rename from
eieio-class-slot-name-index.  Change `class' arg to be a class object.
Update all callers.
(eieio-attribute-to-initarg): Move to eieio-test-persist.el.
(eieio--c3-candidate): Rename from eieio-c3-candidate.
Update all callers.
(eieio--c3-merge-lists): Rename from eieio-c3-merge-lists.
Update all callers.
(eieio--class-precedence-c3): Rename from eieio-class-precedence-c3.
Update all callers.
(eieio--class-precedence-dfs): Rename from eieio-class-precedence-dfs.
Update all callers.
(eieio--class-precedence-bfs): Rename from eieio-class-precedence-bfs.
Update all callers.  Adjust to new `parent' content.
(eieio--class-precedence-list): Rename from -class-precedence-list.
Update all callers.
(eieio-generic-call): Use autoloadp and autoload-do-load.
Slight simplification.
(eieio-generic-call, eieio-generic-call-primary-only): Adjust to new
return value of `eieio-generic-form'.
(eieiomt-add): Index the hashtable with class objects rather than
class names.
(eieio-generic-form): Accept class objects as well.

* lisp/emacs-lisp/eieio.el (eieio-class-parents): Accept class objects.
(eieio--class-slot-initarg): Rename from class-slot-initarg.
Change `class' arg to be a class object.  Update all callers.
(call-next-method): Adjust to new return value of `eieio-generic-form'.
(eieio-default-superclass): Set var to the class object.
(eieio-edebug-prin1-to-string): Fix recursive call for lists.
Change print behavior to affect class objects rather than
class symbols.

* lisp/emacs-lisp/eieio-base.el (eieio-persistent-convert-list-to-object):
Adjust to new convention for eieio-persistent-validate/fix-slot-value.
(eieio-persistent-validate/fix-slot-value):
Change `class' arg to be a class object.  Update all callers.

* test/automated/eieio-test-persist.el (eieio--attribute-to-initarg):
Move from eieio-core.el.  Rename from eieio-attribute-to-initarg.
Change arg to be a class object.  Update all callers.

* test/automated/eieio-tests.el (eieio-test-04-static-method)
(eieio-test-05-static-method-2): Use oref-default to access
class slots.
(eieio-test-23-inheritance-check): Don't assume that
eieio-class-parents returns class names, or that a class can only have
a single name.
parent 232823a1
2015-01-05 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/eieio.el (eieio-class-parents): Accept class objects.
(eieio--class-slot-initarg): Rename from class-slot-initarg.
Change `class' arg to be a class object. Update all callers.
(call-next-method): Adjust to new return value of `eieio-generic-form'.
(eieio-default-superclass): Set var to the class object.
(eieio-edebug-prin1-to-string): Fix recursive call for lists.
Change print behavior to affect class objects rather than
class symbols.
* emacs-lisp/eieio-core.el (eieio-class-object): New function.
(eieio-class-parents-fast): Remove macro.
(eieio--class-option-assoc): Rename from class-option-assoc.
Update all callers.
(eieio--class-option): Rename from class-option. Change `class' arg to
be a class object. Update all callers.
(eieio--class-method-invocation-order): Rename from
class-method-invocation-order. Change `class' arg to be a class
object. Update all callers.
(eieio-defclass-autoload, eieio-defclass): Set the `parent' field to
a list of class objects rather than names.
(eieio-defclass): Remove redundant quotes. Use `eieio-oref-default'
for accessors to class allocated slots.
(eieio--perform-slot-validation-for-default): Rename from
eieio-perform-slot-validation-for-default. Update all callers.
(eieio--add-new-slot): Rename from eieio-add-new-slot.
Update all callers. Use push.
(eieio-copy-parents-into-subclass): Adjust to new content of
`parent' field. Use dolist.
(eieio-oref): Remove support for providing a class rather than
an object.
(eieio-oref-default): Prefer class objects over class names.
(eieio--slot-originating-class-p): Rename from
eieio-slot-originating-class-p. Update all callers. Use `or'.
(eieio--slot-name-index): Turn check into assertion.
(eieio--class-slot-name-index): Rename from
eieio-class-slot-name-index. Change `class' arg to be a class object.
Update all callers.
(eieio-attribute-to-initarg): Move to eieio-test-persist.el.
(eieio--c3-candidate): Rename from eieio-c3-candidate.
Update all callers.
(eieio--c3-merge-lists): Rename from eieio-c3-merge-lists.
Update all callers.
(eieio--class-precedence-c3): Rename from eieio-class-precedence-c3.
Update all callers.
(eieio--class-precedence-dfs): Rename from eieio-class-precedence-dfs.
Update all callers.
(eieio--class-precedence-bfs): Rename from eieio-class-precedence-bfs.
Update all callers. Adjust to new `parent' content.
(eieio--class-precedence-list): Rename from -class-precedence-list.
Update all callers.
(eieio-generic-call): Use autoloadp and autoload-do-load.
Slight simplification.
(eieio-generic-call, eieio-generic-call-primary-only): Adjust to new
return value of `eieio-generic-form'.
(eieiomt-add): Index the hashtable with class objects rather than
class names.
(eieio-generic-form): Accept class objects as well.
* emacs-lisp/eieio-base.el (eieio-persistent-convert-list-to-object):
Adjust to new convention for eieio-persistent-validate/fix-slot-value.
(eieio-persistent-validate/fix-slot-value):
Change `class' arg to be a class object. Update all callers.
2014-12-29 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/eieio.el (child-of-class-p): Make it accept class objects
......
......@@ -270,7 +270,7 @@ identified, and needing more object creation."
;; In addition, strip out quotes, list functions, and update
;; object constructors as needed.
(setq value (eieio-persistent-validate/fix-slot-value
objclass name value))
(eieio--class-v objclass) name value))
(push name createslots)
(push value createslots)
......@@ -290,13 +290,13 @@ constructor functions are considered valid.
Second, any text properties will be stripped from strings."
(cond ((consp proposed-value)
;; Lists with something in them need special treatment.
(let ((slot-idx (eieio--slot-name-index (eieio--class-v class)
(let ((slot-idx (eieio--slot-name-index class
nil slot))
(type nil)
(classtype nil))
(setq slot-idx (- slot-idx
(eval-when-compile eieio--object-num-slots)))
(setq type (aref (eieio--class-public-type (eieio--class-v class))
(setq type (aref (eieio--class-public-type class)
slot-idx))
(setq classtype (eieio-persistent-slot-type-is-class-p
......
This diff is collapsed.
......@@ -208,8 +208,8 @@ Optional argument IGNORE is an extraneous parameter."
chil)))
;; Display information about the group being shown
(when master-group
(let ((groups (class-option (eieio--object-class-name obj)
:custom-groups)))
(let ((groups (eieio--class-option (eieio--object-class-object obj)
:custom-groups)))
(widget-insert "Groups:")
(while groups
(widget-insert " ")
......@@ -261,8 +261,8 @@ Optional argument IGNORE is an extraneous parameter."
(car flabel)
(let ((s (symbol-name
(or
(class-slot-initarg
(eieio--object-class-name obj)
(eieio--class-slot-initarg
(eieio--object-class-object obj)
(car slots))
(car slots)))))
(capitalize
......@@ -452,7 +452,7 @@ Must return the created widget."
(vector (concat "Group " (symbol-name group))
(list 'customize-object obj (list 'quote group))
t))
(class-option (eieio--object-class-name obj) :custom-groups)))
(eieio--class-option (eieio--object-class-object obj) :custom-groups)))
(defvar eieio-read-custom-group-history nil
"History for the custom group reader.")
......@@ -460,7 +460,8 @@ Must return the created widget."
(defmethod eieio-read-customization-group ((obj eieio-default-superclass))
"Do a completing read on the name of a customization group in OBJ.
Return the symbol for the group, or nil"
(let ((g (class-option (eieio--object-class-name obj) :custom-groups)))
(let ((g (eieio--class-option (eieio--object-class-object obj)
:custom-groups)))
(if (= (length g) 1)
(car g)
;; Make the association list
......
......@@ -96,7 +96,8 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
)
(while publa
(if (slot-boundp obj (car publa))
(let* ((i (class-slot-initarg cl (car publa)))
(let* ((i (eieio--class-slot-initarg (eieio--class-v cl)
(car publa)))
(v (eieio-oref obj (car publa))))
(data-debug-insert-thing
v prefix (concat
......@@ -104,7 +105,8 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
(symbol-name (car publa)))
" ")))
;; Unbound case
(let ((i (class-slot-initarg cl (car publa))))
(let ((i (eieio--class-slot-initarg (eieio--class-v cl)
(car publa))))
(data-debug-insert-custom
"#unbound" prefix
(concat (if i (symbol-name i)
......
......@@ -81,7 +81,7 @@ If CLASS is actually an object, then also display current values of that object.
;; Header line
(prin1 class)
(insert " is a"
(if (class-option class :abstract)
(if (eieio--class-option (eieio--class-v class) :abstract)
"n abstract"
"")
" class")
......
;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects -*- lexical-binding:t -*-
;;; or maybe Eric's Implementation of Emacs Interpreted Objects
;; Copyright (C) 1995-1996, 1998-2014 Free Software Foundation, Inc.
;; Copyright (C) 1995-1996, 1998-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.4
......@@ -319,8 +319,9 @@ If EXTRA, include that in the string returned to represent the symbol."
"Return parent classes to CLASS. (overload of variable).
The CLOS function `class-direct-superclasses' is aliased to this function."
(eieio--check-type class-p class)
(eieio-class-parents-fast class))
(let ((c (eieio-class-object class)))
(eieio--class-parent c)))
(define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4")
(defun eieio-class-children (class)
......@@ -366,10 +367,8 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
(setq class (eieio--class-object class))
(eieio--check-type eieio--class-p class)
(while (and child (not (eq child class)))
;; FIXME: eieio--class-parent should return class-objects rather than
;; class-names!
(setq p (append p (eieio--class-parent child))
child (eieio--class-v (pop p))))
child (pop p)))
(if child t))))
(defun object-slots (obj)
......@@ -377,9 +376,9 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
(eieio--check-type eieio-object-p obj)
(eieio--class-public-a (eieio--object-class-object obj)))
(defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg."
(eieio--check-type class-p class)
(let ((ia (eieio--class-initarg-tuples (eieio--class-v class)))
(defun eieio--class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg."
(eieio--check-type eieio--class-p class)
(let ((ia (eieio--class-initarg-tuples class))
(f nil))
(while (and ia (not f))
(if (eq (cdr (car ia)) slot)
......@@ -426,11 +425,9 @@ OBJECT can be an instance or a class."
(defun slot-exists-p (object-or-class slot)
"Return non-nil if OBJECT-OR-CLASS has SLOT."
(let ((cv (eieio--class-v (cond ((eieio-object-p object-or-class)
(eieio-object-class object-or-class))
((class-p object-or-class)
object-or-class))
)))
(let ((cv (cond ((eieio-object-p object-or-class)
(eieio--object-class-object object-or-class))
(t (eieio-class-object object-or-class)))))
(or (memq slot (eieio--class-public-a cv))
(memq slot (eieio--class-class-allocation-a cv)))
))
......@@ -555,7 +552,7 @@ Use `next-method-p' to find out if there is a next method to call."
(eieio-generic-call-arglst newargs)
(fcn (car next))
)
(eieio--with-scoped-class (eieio--class-v (cdr next))
(eieio--with-scoped-class (cdr next)
(apply fcn newargs)) ))))
;;; Here are some CLOS items that need the CL package
......@@ -580,6 +577,8 @@ Its slots are automatically adopted by classes with no specified parents.
This class is not stored in the `parent' slot of a class vector."
:abstract t)
(setq eieio-default-superclass (eieio--class-v 'eieio-default-superclass))
(defalias 'standard-class 'eieio-default-superclass)
(defgeneric eieio-constructor (class &rest slots)
......@@ -797,7 +796,7 @@ this object."
(eieio-print-depth (1+ eieio-print-depth)))
(while publa
(when (slot-boundp this (car publa))
(let ((i (class-slot-initarg cl (car publa)))
(let ((i (eieio--class-slot-initarg cv (car publa)))
(v (eieio-oref this (car publa)))
)
(unless (or (not i) (equal v (car publd)))
......@@ -874,11 +873,13 @@ 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 ((class-p object) (eieio-class-name object))
(cond ((eieio--class-p object) (eieio-class-name object))
((eieio-object-p object) (object-print object))
((and (listp object) (or (class-p (car object))
((and (listp object) (or (eieio--class-p (car object))
(eieio-object-p (car object))))
(concat "(" (mapconcat #'eieio-edebug-prin1-to-string object " ")
(concat "(" (mapconcat
(lambda (x) (eieio-edebug-prin1-to-string print-function x))
object " ")
")"))
(t (funcall print-function object noescape))))
......@@ -888,7 +889,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
;;; Start of automatically extracted autoloads.
;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "2b4c57cf907e879e8bbc88d8f0e2de4c")
;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "a3f314e2a27e52444df4597c6ae51458")
;;; Generated autoloads from eieio-custom.el
(autoload 'customize-object "eieio-custom" "\
......
2015-01-05 Stefan Monnier <monnier@iro.umontreal.ca>
* automated/eieio-tests.el (eieio-test-04-static-method)
(eieio-test-05-static-method-2): Use oref-default to access
class slots.
(eieio-test-23-inheritance-check): Don't assume that
eieio-class-parents returns class names, or that a class can only have
a single name.
* automated/eieio-test-persist.el (eieio--attribute-to-initarg):
Move from eieio-core.el. Rename from eieio-attribute-to-initarg.
Change arg to be a class object. Update all callers.
2014-12-29 Stefan Monnier <monnier@iro.umontreal.ca>
* automated/eieio-test-methodinvoke.el (eieio-test-method-store):
......
......@@ -32,6 +32,14 @@
(require 'eieio-base)
(require 'ert)
(defun eieio--attribute-to-initarg (class attribute)
"In CLASS, convert the ATTRIBUTE into the corresponding init argument tag.
This is usually a symbol that starts with `:'."
(let ((tuple (rassoc attribute (eieio--class-initarg-tuples class))))
(if tuple
(car tuple)
nil)))
(defun persist-test-save-and-compare (original)
"Compare the object ORIGINAL against the one read fromdisk."
......@@ -53,7 +61,8 @@
(let* ((oneslot (car slot-names))
(origvalue (eieio-oref original oneslot))
(fromdiskvalue (eieio-oref fromdisk oneslot))
(initarg-p (eieio-attribute-to-initarg class oneslot))
(initarg-p (eieio--attribute-to-initarg
(eieio--class-v class) oneslot))
)
(if initarg-p
......
;;; eieio-tests.el -- eieio tests routines
;; Copyright (C) 1999-2003, 2005-2010, 2012-2014 Free Software Foundation, Inc.
;; Copyright (C) 1999-2003, 2005-2010, 2012-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
......@@ -199,9 +199,9 @@ Argument C is the class bound to this static method."
(ert-deftest eieio-test-04-static-method ()
;; Call static method on a class and see if it worked
(static-method-class-method static-method-class 'class)
(should (eq (oref static-method-class some-slot) 'class))
(should (eq (oref-default static-method-class some-slot) 'class))
(static-method-class-method (static-method-class) 'object)
(should (eq (oref static-method-class some-slot) 'object)))
(should (eq (oref-default static-method-class some-slot) 'object)))
(ert-deftest eieio-test-05-static-method-2 ()
(defclass static-method-class-2 (static-method-class)
......@@ -215,9 +215,9 @@ Argument C is the class bound to this static method."
(oset-default c some-slot (intern (concat "moose-" (symbol-name value)))))
(static-method-class-method static-method-class-2 'class)
(should (eq (oref static-method-class-2 some-slot) 'moose-class))
(should (eq (oref-default static-method-class-2 some-slot) 'moose-class))
(static-method-class-method (static-method-class-2) 'object)
(should (eq (oref static-method-class-2 some-slot) 'moose-object)))
(should (eq (oref-default static-method-class-2 some-slot) 'moose-object)))
;;; Perform method testing
......@@ -536,7 +536,9 @@ METHOD is the method that was attempting to be called."
(should (object-of-class-p eitest-ab class-b))
(should (object-of-class-p eitest-ab class-ab))
(should (eq (eieio-class-parents class-a) nil))
(should (equal (eieio-class-parents class-ab) '(class-a class-b)))
;; FIXME: eieio-class-parents now returns class objects!
(should (equal (mapcar #'eieio-class-object (eieio-class-parents class-ab))
(mapcar #'eieio-class-object '(class-a class-b))))
(should (same-class-p eitest-a class-a))
(should (class-a-p eitest-a))
(should (not (class-a-p eitest-ab)))
......
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