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.
Copyright (C) 2014 Free Software Foundation, Inc.
Copyright (C) 2014, 2015 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
......@@ -187,6 +187,11 @@ Unicode standards.
* 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
*** 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
......
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>
* emacs-lisp/eieio-generic.el: New file.
* emacs-lisp/eieio-core.el: Move all generic function code to
eieio-generic.el.
(eieio--defmethod): Declare.
* emacs-lisp/eieio.el: Require eieio-generic. Move all generic
function code to eieio-generic.el.
* 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.
If INSTANTIABLE-ONLY is non nil, only allow names of classes which
are not abstract, otherwise allow all classes.
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))))
(unless (assoc (symbol-name cc) buildlist)
(when (or (not instantiable-only) (not (class-abstract-p cc)))
......@@ -561,7 +561,7 @@ current expansion depth."
(when (eq (point-min) (point-max))
;; This function is only called once, to start the whole deal.
;; Create and expand the default object.
(eieio-class-button eieio-default-superclass 0)
(eieio-class-button 'eieio-default-superclass 0)
(forward-line -1)
(speedbar-expand-line)))
......
......@@ -58,13 +58,11 @@
;;; 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.
OPTIONS-AND-DOC is used as the class' options and base documentation.
SUPERCLASS is a list of superclasses to inherit from, with SLOTS
being the slots residing in that class definition. NOTE: Currently
only one slot may exist in SUPERCLASS as multiple inheritance is not
yet supported. Supported tags are:
SUPERCLASSES is a list of superclasses to inherit from, with SLOTS
being the slots residing in that class definition. Supported tags are:
:initform - Initializing form.
:initarg - Tag used during initialization.
......@@ -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,
and reference them using the function `class-option'."
(declare (doc-string 4))
;; This is eval-and-compile only to silence spurious compiler warnings
;; about functions and variables not known to be defined.
;; When eieio-defclass code is merged here and this becomes
;; transparent to the compiler, the eval-and-compile can be removed.
`(eval-and-compile
(eieio-defclass ',name ',superclass ',slots ',options-and-doc)))
(eieio--check-type listp superclasses)
(cond ((and (stringp (car options-and-doc))
(/= 1 (% (length options-and-doc) 2)))
(error "Too many arguments to `defclass'"))
((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.
......
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