Commit 6a67b20d authored by Stefan Monnier's avatar Stefan Monnier

* lisp/emacs-lisp/eieio*.el: Move the function defs to defclass.

* lisp/emacs-lisp/eieio.el (defclass): Move from eieio-defclass all the code
that creates functions, and most of the sanity checks.
Mark as obsolete the <class>-child-p function.
* lisp/emacs-lisp/eieio-core.el (eieio--define-field-accessors): Remove.
(eieio--class, eieio--object): Use cl-defstruct.
(eieio--object-num-slots): Define manually.
(eieio-defclass-autoload): Use eieio--class-make.
(eieio-defclass-internal): Rename from eieio-defclass.  Move all the
`(lambda...) definitions and most of the sanity checks to `defclass'.
Mark as obsolete the <class>-list-p function, the <class> variable and
the <initarg> variables.  Use pcase-dolist.
(eieio-defclass): New compatibility function.
* lisp/emacs-lisp/eieio-opt.el (eieio-build-class-alist)
(eieio-class-speedbar): Don't use eieio-default-superclass var.
parent 54181569
GNU Emacs NEWS -- history of user-visible changes. GNU Emacs NEWS -- history of user-visible changes.
Copyright (C) 2014 Free Software Foundation, Inc. Copyright (C) 2014, 2015 Free Software Foundation, Inc.
See the end of the file for license conditions. See the end of the file for license conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org. Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
...@@ -187,6 +187,11 @@ Unicode standards. ...@@ -187,6 +187,11 @@ Unicode standards.
* Changes in Specialized Modes and Packages in Emacs 25.1 * Changes in Specialized Modes and Packages in Emacs 25.1
** EIEIO
*** The <class>-list-p and <class>-child-p functions are declared obsolete.
*** The <class> variables are declared obsolete.
*** The <initarg> variables are declared obsolete.
** ido ** ido
*** New command `ido-bury-buffer-at-head' bound to C-S-b *** New command `ido-bury-buffer-at-head' bound to C-S-b
Bury the buffer at the head of `ido-matches', analogous to how C-k Bury the buffer at the head of `ido-matches', analogous to how C-k
......
2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/eieio.el (defclass): Move from eieio-defclass all the code
that creates functions, and most of the sanity checks.
Mark as obsolete the <class>-child-p function.
* emacs-lisp/eieio-core.el (eieio--define-field-accessors): Remove.
(eieio--class, eieio--object): Use cl-defstruct.
(eieio--object-num-slots): Define manually.
(eieio-defclass-autoload): Use eieio--class-make.
(eieio-defclass-internal): Rename from eieio-defclass. Move all the
`(lambda...) definitions and most of the sanity checks to `defclass'.
Mark as obsolete the <class>-list-p function, the <class> variable and
the <initarg> variables. Use pcase-dolist.
(eieio-defclass): New compatibility function.
* emacs-lisp/eieio-opt.el (eieio-build-class-alist)
(eieio-class-speedbar): Don't use eieio-default-superclass var.
2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/eieio-generic.el: New file. * emacs-lisp/eieio-generic.el: New file.
* emacs-lisp/eieio-core.el: Move all generic function code to * emacs-lisp/eieio-core.el: Move all generic function code to
eieio-generic.el. eieio-generic.el.
(eieio--defmethod): Declare. (eieio--defmethod): Declare.
* emacs-lisp/eieio.el: Require eieio-generic. Move all generic * emacs-lisp/eieio.el: Require eieio-generic. Move all generic
function code to eieio-generic.el. function code to eieio-generic.el.
* emacs-lisp/eieio-opt.el (eieio-help-generic): Move to * emacs-lisp/eieio-opt.el (eieio-help-generic): Move to
......
This diff is collapsed.
...@@ -230,7 +230,7 @@ Optional argument CLASS is the class to start with. ...@@ -230,7 +230,7 @@ Optional argument CLASS is the class to start with.
If INSTANTIABLE-ONLY is non nil, only allow names of classes which If INSTANTIABLE-ONLY is non nil, only allow names of classes which
are not abstract, otherwise allow all classes. are not abstract, otherwise allow all classes.
Optional argument BUILDLIST is more list to attach and is used internally." Optional argument BUILDLIST is more list to attach and is used internally."
(let* ((cc (or class eieio-default-superclass)) (let* ((cc (or class 'eieio-default-superclass))
(sublst (eieio--class-children (eieio--class-v cc)))) (sublst (eieio--class-children (eieio--class-v cc))))
(unless (assoc (symbol-name cc) buildlist) (unless (assoc (symbol-name cc) buildlist)
(when (or (not instantiable-only) (not (class-abstract-p cc))) (when (or (not instantiable-only) (not (class-abstract-p cc)))
...@@ -561,7 +561,7 @@ current expansion depth." ...@@ -561,7 +561,7 @@ current expansion depth."
(when (eq (point-min) (point-max)) (when (eq (point-min) (point-max))
;; This function is only called once, to start the whole deal. ;; This function is only called once, to start the whole deal.
;; Create and expand the default object. ;; Create and expand the default object.
(eieio-class-button eieio-default-superclass 0) (eieio-class-button 'eieio-default-superclass 0)
(forward-line -1) (forward-line -1)
(speedbar-expand-line))) (speedbar-expand-line)))
......
...@@ -58,13 +58,11 @@ ...@@ -58,13 +58,11 @@
;;; Defining a new class ;;; Defining a new class
;; ;;
(defmacro defclass (name superclass slots &rest options-and-doc) (defmacro defclass (name superclasses slots &rest options-and-doc)
"Define NAME as a new class derived from SUPERCLASS with SLOTS. "Define NAME as a new class derived from SUPERCLASS with SLOTS.
OPTIONS-AND-DOC is used as the class' options and base documentation. OPTIONS-AND-DOC is used as the class' options and base documentation.
SUPERCLASS is a list of superclasses to inherit from, with SLOTS SUPERCLASSES is a list of superclasses to inherit from, with SLOTS
being the slots residing in that class definition. NOTE: Currently being the slots residing in that class definition. Supported tags are:
only one slot may exist in SUPERCLASS as multiple inheritance is not
yet supported. Supported tags are:
:initform - Initializing form. :initform - Initializing form.
:initarg - Tag used during initialization. :initarg - Tag used during initialization.
...@@ -115,12 +113,178 @@ Options in CLOS not supported in EIEIO: ...@@ -115,12 +113,178 @@ Options in CLOS not supported in EIEIO:
Due to the way class options are set up, you can add any tags you wish, Due to the way class options are set up, you can add any tags you wish,
and reference them using the function `class-option'." and reference them using the function `class-option'."
(declare (doc-string 4)) (declare (doc-string 4))
;; This is eval-and-compile only to silence spurious compiler warnings (eieio--check-type listp superclasses)
;; about functions and variables not known to be defined.
;; When eieio-defclass code is merged here and this becomes (cond ((and (stringp (car options-and-doc))
;; transparent to the compiler, the eval-and-compile can be removed. (/= 1 (% (length options-and-doc) 2)))
`(eval-and-compile (error "Too many arguments to `defclass'"))
(eieio-defclass ',name ',superclass ',slots ',options-and-doc))) ((and (symbolp (car options-and-doc))
(/= 0 (% (length options-and-doc) 2)))
(error "Too many arguments to `defclass'")))
(if (stringp (car options-and-doc))
(setq options-and-doc
(cons :documentation options-and-doc)))
;; Make sure the method invocation order is a valid value.
(let ((io (eieio--class-option-assoc options-and-doc
:method-invocation-order)))
(when (and io (not (member io '(:depth-first :breadth-first :c3))))
(error "Method invocation order %s is not allowed" io)))
(let ((testsym1 (intern (concat (symbol-name name) "-p")))
(testsym2 (intern (format "eieio--childp--%s" name)))
(accessors ()))
;; Collect the accessors we need to define.
(pcase-dolist (`(,sname . ,soptions) slots)
(let* ((acces (plist-get soptions :accessor))
(initarg (plist-get soptions :initarg))
(reader (plist-get soptions :reader))
(writer (plist-get soptions :writer))
(alloc (plist-get soptions :allocation))
(label (plist-get soptions :label)))
(if eieio-error-unsupported-class-tags
(let ((tmp soptions))
(while tmp
(if (not (member (car tmp) '(:accessor
:initform
:initarg
:documentation
:protection
:reader
:writer
:allocation
:type
:custom
:label
:group
:printer
:allow-nil-initform
:custom-groups)))
(signal 'invalid-slot-type (list (car tmp))))
(setq tmp (cdr (cdr tmp))))))
;; Make sure the :allocation parameter has a valid value.
(if (not (memq alloc '(nil :class :instance)))
(signal 'invalid-slot-type (list :allocation alloc)))
;; Label is nil, or a string
(if (not (or (null label) (stringp label)))
(signal 'invalid-slot-type (list :label label)))
;; Is there an initarg, but allocation of class?
(if (and initarg (eq alloc :class))
(message "Class allocated slots do not need :initarg"))
;; Anyone can have an accessor function. This creates a function
;; of the specified name, and also performs a `defsetf' if applicable
;; so that users can `setf' the space returned by this function.
(when acces
;; FIXME: The defmethod below only defines a part of the generic
;; function (good), but the define-setter below affects the whole
;; generic function (bad)!
(push `(gv-define-setter ,acces (store object)
;; Apparently, eieio-oset-default doesn't work like
;; oref-default and only accept class arguments!
(list ',(if nil ;; (eq alloc :class)
'eieio-oset-default
'eieio-oset)
object '',sname store))
accessors)
(push `(defmethod ,acces ,(if (eq alloc :class) :static :primary)
((this ,name))
,(format
"Retrieve the slot `%S' from an object of class `%S'."
sname name)
(if (slot-boundp this ',sname)
;; Use oref-default for :class allocated slots, since
;; these also accept the use of a class argument instead
;; of an object argument.
(,(if (eq alloc :class) 'eieio-oref-default 'eieio-oref)
this ',sname)
;; Else - Some error? nil?
nil))
accessors))
;; If a writer is defined, then create a generic method of that
;; name whose purpose is to set the value of the slot.
(if writer
(push `(defmethod ,writer ((this ,name) value)
,(format "Set the slot `%S' of an object of class `%S'."
sname name)
(setf (slot-value this ',sname) value))
accessors))
;; If a reader is defined, then create a generic method
;; of that name whose purpose is to access this slot value.
(if reader
(push `(defmethod ,reader ((this ,name))
,(format "Access the slot `%S' from object of class `%S'."
sname name)
(slot-value this ',sname))
accessors))
))
`(progn
;; This test must be created right away so we can have self-
;; referencing classes. ei, a class whose slot can contain only
;; pointers to itself.
;; Create the test function.
(defun ,testsym1 (obj)
,(format "Test OBJ to see if it an object of type %S." name)
(and (eieio-object-p obj)
(same-class-p obj ',name)))
(defun ,testsym2 (obj)
,(format
"Test OBJ to see if it an object is a child of type %S."
name)
(and (eieio-object-p obj)
(object-of-class-p obj ',name)))
,@(when eieio-backward-compatibility
(let ((f (intern (format "%s-child-p" name))))
`((defalias ',f ',testsym2)
(make-obsolete
',f ,(format "use (cl-typep ... '%s) instead" name) "25.1"))))
;; When using typep, (typep OBJ 'myclass) returns t for objects which
;; are subclasses of myclass. For our predicates, however, it is
;; important for EIEIO to be backwards compatible, where
;; myobject-p, and myobject-child-p are different.
;; "cl" uses this technique to specify symbols with specific typep
;; test, so we can let typep have the CLOS documented behavior
;; while keeping our above predicate clean.
(put ',name 'cl-deftype-satisfies #',testsym2)
(eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc)
,@accessors
;; Create the constructor function
,(if (eieio--class-option-assoc options-and-doc :abstract)
;; Abstract classes cannot be instantiated. Say so.
(let ((abs (eieio--class-option-assoc options-and-doc :abstract)))
(if (not (stringp abs))
(setq abs (format "Class %s is abstract" name)))
`(defun ,name (&rest _)
,(format "You cannot create a new object of type %S." name)
(error ,abs)))
;; Non-abstract classes need a constructor.
`(defun ,name (&rest slots)
,(format "Create a new object with name NAME of class type %S."
name)
(if (and slots
(let ((x (car slots)))
(or (stringp x) (null x))))
(funcall (if eieio-backward-compatibility #'ignore #'message)
"Obsolete name %S passed to %S constructor"
(pop slots) ',name))
(apply #'eieio-constructor ',name slots))))))
;;; CLOS style implementation of object creators. ;;; CLOS style implementation of object creators.
......
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