diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 1 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 75 |
2 files changed, 44 insertions, 32 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4c28d816f60..6ca8eed8ac6 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4173,6 +4173,7 @@ binding slots have been popped." ;; Compile normally, but deal with warnings for the function being defined. (put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias) +;; Used for eieio--defalias as well. (defun byte-compile-file-form-defalias (form) (if (and (consp (cdr form)) (consp (nth 1 form)) (eq (car (nth 1 form)) 'quote) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 268698e4128..d71213bfac8 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -420,6 +420,7 @@ It creates an autoload function for CNAME's constructor." (load-library (car (cdr (symbol-function cname)))))) (defun eieio-defclass (cname superclasses slots options-and-doc) + ;; FIXME: Most of this should be moved to the `defclass' macro. "Define CNAME as a new subclass of SUPERCLASSES. SLOTS are the slots residing in that class definition, and options or documentation OPTIONS-AND-DOC is the toplevel documentation for this class. @@ -1139,6 +1140,17 @@ a string." ;;; CLOS methods and generics ;; + +(put 'eieio--defalias 'byte-hunk-handler + #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler) +(defun eieio--defalias (name body) + "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." + (unless (and (fboundp name) + (eq (symbol-function name) body)) + (defalias name body))) + (defmacro defgeneric (method args &optional doc-string) "Create a generic function METHOD. DOC-STRING is the base documentation for this class. A generic @@ -1147,7 +1159,21 @@ 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." - `(eieio-defgeneric (quote ,method) ,doc-string)) + `(eieio--defalias ',method + (eieio--defgeneric-init-form ',method ,doc-string))) + +(defun eieio--defgeneric-init-form (method doc-string) + "Form to use for the initial definition of a generic." + (cond + ((or (not (fboundp method)) + (eq 'autoload (car-safe (symbol-function method)))) + ;; Make sure the method tables are installed. + (eieiomt-install method) + ;; Construct the actual body of this function. + (eieio-defgeneric-form method doc-string)) + ((generic-p method) (symbol-function method)) ;Leave it as-is. + (t (error "You cannot create a generic/method over an existing symbol: %s" + method)))) (defun eieio-defgeneric-form (method doc-string) "The lambda form that would be used as the function defined on METHOD. @@ -1237,26 +1263,6 @@ IMPL is the symbol holding the method implementation." (cdr entry) )))) -(defun eieio-defgeneric (method doc-string) - "Engine part to `defgeneric' macro defining METHOD with DOC-STRING." - (if (and (fboundp method) (not (generic-p method)) - (or (byte-code-function-p (symbol-function method)) - (not (eq 'autoload (car (symbol-function method))))) - ) - (error "You cannot create a generic/method over an existing symbol: %s" - method)) - ;; Don't do this over and over. - (unless (fboundp 'method) - ;; This defun tells emacs where the first definition of this - ;; method is defined. - `(defun ,method nil) - ;; Make sure the method tables are installed. - (eieiomt-install method) - ;; Apply the actual body of this function. - (fset method (eieio-defgeneric-form method doc-string)) - ;; Return the method - 'method)) - (defun eieio-unbind-method-implementations (method) "Make the generic method METHOD have no implementations. It will leave the original generic function in place, @@ -1292,12 +1298,17 @@ Summary: (let* ((key (if (keywordp (car args)) (pop args))) (params (car args)) (arg1 (car params)) - (class (if (consp arg1) (nth 1 arg1)))) - `(eieio--defmethod ',method ',key ',class - (lambda ,(if (consp arg1) - (cons (car arg1) (cdr params)) - params) - ,@(cdr args))))) + (args (if (consp arg1) + (cons (car arg1) (cdr params)) + params)) + (class (if (consp arg1) (nth 1 arg1))) + (code `(lambda ,args ,@(cdr args)))) + `(progn + ;; 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)))) (defun eieio--defmethod (method kind argclass code) "Work part of the `defmethod' macro defining METHOD with ARGS." @@ -1317,11 +1328,11 @@ Summary: method-static) ;; Primary key (t method-primary)))) - ;; make sure there is a generic - (eieio-defgeneric - method - (or (documentation code) - (format "Generically created method `%s'." method))) + ;; Make sure there is a generic (when called from defclass). + (eieio--defalias + method (eieio--defgeneric-init-form + method (or (documentation code) + (format "Generically created method `%s'." method)))) ;; create symbol for property to bind to. If the first arg is of ;; the form (varname vartype) and `vartype' is a class, then ;; that class will be the type symbol. If not, then it will fall |