Commit 54181569 authored by Stefan Monnier's avatar Stefan Monnier

* emacs-lisp/eieio-generic.el: New file.

* lisp/emacs-lisp/eieio-core.el: Move all generic function code to
(eieio--defmethod): Declare.
* lisp/emacs-lisp/eieio.el: Require eieio-generic.  Move all generic
function code to eieio-generic.el.
* lisp/emacs-lisp/eieio-opt.el (eieio-help-generic): Move to
* lisp/emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke): Update call
to eieio--generic-call.
* lisp/emacs-lisp/eieio-base.el (eieio-instance-inheritor): Don't use
<class>-child type.
* test/automated/eieio-test-methodinvoke.el (eieio-test-method-store):
Update reference to eieio--generic-call-key.
* test/automated/eieio-tests.el (eieio-test-23-inheritance-check): Don't use
parent 1599688e
2015-01-08 Stefan Monnier <>
* emacs-lisp/eieio-generic.el: New file.
* emacs-lisp/eieio-core.el: Move all generic function code to
(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
* emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke): Update call
to eieio--generic-call.
* emacs-lisp/eieio-base.el (eieio-instance-inheritor): Don't use
<class>-child type.
2015-01-07 Stefan Monnier <>
* emacs-lisp/chart.el (chart-add-sequence, chart-bar-quickie):
;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*-
;;; Copyright (C) 2000-2002, 2004-2005, 2007-2014 Free Software
;;; Copyright (C) 2000-2002, 2004-2005, 2007-2015 Free Software
;;; Foundation, Inc.
;; Author: Eric M. Ludlam <>
......@@ -40,7 +40,7 @@
;; error if a slot is unbound.
(defclass eieio-instance-inheritor ()
((parent-instance :initarg :parent-instance
:type eieio-instance-inheritor-child
:type eieio-instance-inheritor
"The parent of this instance.
If a slot of this class is referenced, and is unbound, then the parent
This diff is collapsed.
;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -*- lexical-binding:t -*-
;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <>
;; Keywords: OO, lisp
......@@ -137,7 +137,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
(let* ((eieio-pre-method-execution-functions
(lambda (l) (throw 'moose l) ))
(catch 'moose (eieio-generic-call
(catch 'moose (eieio--generic-call
method (list class))))
(_buf (data-debug-new-buffer "*Method Invocation*"))
(data2 (mapcar (lambda (sym)
This diff is collapsed.
;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar)
;; Copyright (C) 1996, 1998-2003, 2005, 2008-2014 Free Software
;; Copyright (C) 1996, 1998-2003, 2005, 2008-2015 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <>
......@@ -311,69 +311,6 @@ are not abstract."
(eieio-help-class ctr))
(defun eieio-help-generic (generic)
"Describe GENERIC if it is a generic function."
(when (and (symbolp generic) (generic-p generic))
(goto-char (point-min))
(when (re-search-forward " in `.+'.$" nil t)
(replace-match ".")))
(insert "\n\nThis is a generic function"
((and (generic-primary-only-p generic)
(generic-primary-only-one-p generic))
" with only one primary method")
((generic-primary-only-p generic)
" with only primary methods")
(t ""))
(insert (propertize "Implementations:\n\n" 'face 'bold))
(let ((i 4)
(prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] ))
;; Loop over fanciful generics
(while (< i 7)
(let ((gm (aref (get generic 'eieio-method-tree) i)))
(when gm
(insert "Generic "
(aref prefix (- i 3))
(or (nth 2 gm) "Undocumented")
(setq i (1+ i)))
(setq i 0)
;; Loop over defined class-specific methods
(while (< i 4)
(let* ((gm (reverse (aref (get generic 'eieio-method-tree) i)))
cname location)
(while gm
(setq cname (caar gm))
(insert "`")
(help-insert-xref-button (symbol-name cname)
'help-variable cname)
(insert "' " (aref prefix i) " ")
;; argument list
(let* ((func (cdr (car gm)))
(arglst (help-function-arglist func)))
(prin1 arglst (current-buffer)))
(insert "\n"
(or (documentation (cdr (car gm)))
;; Print file location if available
(when (and (setq location (get generic 'method-locations))
(setq location (assoc cname location)))
(setq location (cadr location))
(insert "\n\nDefined in `")
(file-name-nondirectory location)
'eieio-method-def cname generic location)
(insert "'\n"))
(setq gm (cdr gm))
(insert "\n")))
(setq i (1+ i)))))))
(defun eieio-all-generic-functions (&optional class)
"Return a list of all generic functions.
Optional CLASS argument returns only those functions that contain
......@@ -53,6 +53,7 @@
(message eieio-version))
(require 'eieio-core)
(require 'eieio-generic)
;;; Defining a new class
......@@ -147,70 +148,6 @@ a string."
(apply (class-constructor class) initargs))
;;; CLOS methods and generics
(defmacro defgeneric (method _args &optional doc-string)
"Create a generic function METHOD.
DOC-STRING is the base documentation for this class. A generic
function has no body, as its purpose is to decide which method body
is appropriate to use. Uses `defmethod' to create methods, and calls
`defgeneric' for you. With this implementation the ARGS are
currently ignored. You can use `defgeneric' to apply specialized
top level documentation to a method."
(declare (doc-string 3))
`(eieio--defalias ',method
(eieio--defgeneric-init-form ',method ,doc-string)))
(defmacro defmethod (method &rest args)
"Create a new METHOD through `defgeneric' with ARGS.
The optional second argument KEY is a specifier that
modifies how the method is called, including:
:before - Method will be called before the :primary
:primary - The default if not specified
:after - Method will be called after the :primary
:static - First arg could be an object or class
The next argument is the ARGLIST. The ARGLIST specifies the arguments
to the method as with `defun'. The first argument can have a type
specifier, such as:
where VARNAME is the name of the local variable for the method being
created. The CLASS is a class symbol for a class made with `defclass'.
A DOCSTRING comes after the ARGLIST, and is optional.
All the rest of the args are the BODY of the method. A method will
return the value of the last form in the BODY.
(defmethod mymethod [:before | :primary | :after | :static]
((typearg class-name) arg2 &optional opt &rest rest)
(declare (doc-string 3)
(&define ; this means we are defining something
[&or name ("setf" :name setf name)]
;; ^^ This is the methods symbol
[ &optional symbolp ] ; this is key :before etc
list ; arguments
[ &optional stringp ] ; documentation string
def-body ; part to be debugged
(let* ((key (if (keywordp (car args)) (pop args)))
(params (car args))
(arg1 (car params))
(fargs (if (consp arg1)
(cons (car arg1) (cdr params))
(class (if (consp arg1) (nth 1 arg1)))
(code `(lambda ,fargs ,@(cdr args))))
;; Make sure there is a generic and the byte-compiler sees it.
(defgeneric ,method ,args
,(or (documentation code)
(format "Generically created method `%s'." method)))
(eieio--defmethod ',method ',key ',class #',code))))
;;; Get/Set slots in an object.
(defmacro oref (obj slot)
......@@ -519,44 +456,6 @@ If SLOT is unbound, do nothing."
(eieio-oset object slot (delete item (eieio-oref object slot)))))
;; Method Calling Functions
(defun next-method-p ()
"Return non-nil if there is a next method.
Returns a list of lambda expressions which is the `next-method'
(defun call-next-method (&rest replacement-args)
"Call the superclass method from a subclass method.
The superclass method is specified in the current method list,
and is called the next method.
If REPLACEMENT-ARGS is non-nil, then use them instead of
`eieio-generic-call-arglst'. The generic arg list are the
arguments passed in at the top level.
Use `next-method-p' to find out if there is a next method to call."
(if (not (eieio--scoped-class))
(error "`call-next-method' not called within a class specific method"))
(if (and (/= eieio-generic-call-key eieio--method-primary)
(/= eieio-generic-call-key eieio--method-static))
(error "Cannot `call-next-method' except in :primary or :static methods")
(let ((newargs (or replacement-args eieio-generic-call-arglst))
(next (car eieio-generic-call-next-method-list))
(if (not (and next (car next)))
(apply #'no-next-method newargs)
(let* ((eieio-generic-call-next-method-list
(cdr eieio-generic-call-next-method-list))
(eieio-generic-call-arglst newargs)
(fcn (car next))
(eieio--with-scoped-class (cdr next)
(apply fcn newargs)) ))))
;;; Here are some CLOS items that need the CL package
......@@ -686,34 +585,6 @@ 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)
slot-name fn)))
(defgeneric no-applicable-method (object method &rest args)
"Called if there are no implementations for OBJECT in METHOD.")
(defmethod no-applicable-method ((object eieio-default-superclass)
method &rest _args)
"Called if there are no implementations for OBJECT in METHOD.
OBJECT is the object which has no method implementation.
ARGS are the arguments that were passed to METHOD.
Implement this for a class to block this signal. The return
value becomes the return value of the original method call."
(signal 'no-method-definition (list method (eieio-object-name object)))
(defgeneric no-next-method (object &rest args)
"Called from `call-next-method' when no additional methods are available.")
(defmethod no-next-method ((object eieio-default-superclass)
&rest args)
"Called from `call-next-method' when no additional methods are available.
OBJECT is othe object being called on `call-next-method'.
ARGS are the arguments it is called by.
This method signals `no-next-method' by default. Override this
method to not throw an error, and its return value becomes the
return value of `call-next-method'."
(signal 'no-next-method (list (eieio-object-name object) args))
(defgeneric clone (obj &rest params)
"Make a copy of OBJ, and then supply PARAMS.
PARAMS is a parameter list of the same form used by `initialize-instance'.
......@@ -865,7 +736,6 @@ of `eq'."
(error "EIEIO: `change-class' is unimplemented"))
;; Hook ourselves into help system for describing classes and methods.
(add-hook 'help-fns-describe-function-functions 'eieio-help-generic)
(add-hook 'help-fns-describe-function-functions 'eieio-help-constructor)
;;; Interfacing with edebug
......@@ -903,7 +773,7 @@ Optional argument GROUP is the sub-group of slots to display.
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "6377e022e85d377b399f44c98b4eab4a")
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "7267115a161243e1e6ea75f2d25c8ebc")
;;; Generated autoloads from eieio-opt.el
(autoload 'eieio-browse "eieio-opt" "\
......@@ -924,11 +794,6 @@ Describe CTR if it is a class constructor.
\(fn CTR)" nil nil)
(autoload 'eieio-help-generic "eieio-opt" "\
Describe GENERIC if it is a generic function.
\(fn GENERIC)" nil nil)
;;; End of automatically extracted autoloads.
2015-01-08 Stefan Monnier <>
* automated/eieio-tests.el (eieio-test-23-inheritance-check): Don't use
* automated/eieio-test-methodinvoke.el (eieio-test-method-store):
Update reference to eieio--generic-call-key.
2015-01-07 Stefan Monnier <>
* automated/eieio-tests.el: Use cl-lib. Don't use <class> as a variable.
;;; eieio-testsinvoke.el -- eieio tests for method invocation
;; Copyright (C) 2005, 2008, 2010, 2013-2014 Free Software Foundation, Inc.
;; Copyright (C) 2005, 2008, 2010, 2013-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <>
......@@ -60,7 +60,7 @@
(defun eieio-test-method-store ()
"Store current invocation class symbol in the invocation order list."
(let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ]
(or eieio-generic-call-key 0)))
(or eieio--generic-call-key 0)))
;; FIXME: Don't depend on `eieio--scoped-class'!
(c (list keysym (eieio--class-symbol (eieio--scoped-class)))))
(push c eieio-test-method-order-list)))
......@@ -542,10 +542,10 @@ METHOD is the method that was attempting to be called."
(should (same-class-p eitest-a 'class-a))
(should (class-a-p eitest-a))
(should (not (class-a-p eitest-ab)))
(should (class-a-child-p eitest-a))
(should (class-a-child-p eitest-ab))
(should (cl-typep eitest-a 'class-a))
(should (cl-typep eitest-ab 'class-a))
(should (not (class-a-p "foo")))
(should (not (class-a-child-p "foo"))))
(should (not (cl-typep "foo" 'class-a))))
(ert-deftest eieio-test-24-object-predicates ()
(let ((listooa (list (class-ab) (class-a)))
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