[Emacs-diffs] /srv/bzr/emacs/trunk r105547: * lisp/emacs-lisp/eieio.el (eieio-defmethod, eieio-defgeneric):

[Stefan Monnier]

------------------------------------------------------------
revno: 105547
fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9313
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2011-08-23 14:53:51 -0400
message:
  * lisp/emacs-lisp/eieio.el (eieio-defmethod, eieio-defgeneric):
  Add compatibility functions.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/eieio.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-08-23 15:21:19 +0000
+++ b/lisp/ChangeLog    2011-08-23 18:53:51 +0000
@@ -1,3 +1,8 @@
+2011-08-23  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/eieio.el (eieio-defmethod, eieio-defgeneric):
+       Add compatibility functions (bug#9313).
+
 2011-08-23  Eli Zaretskii  <address@hidden>
 
        * cus-start.el (all): Add entry for bidi-paragraph-direction.

=== modified file 'lisp/emacs-lisp/eieio.el'
--- a/lisp/emacs-lisp/eieio.el  2011-05-23 00:39:25 +0000
+++ b/lisp/emacs-lisp/eieio.el  2011-08-23 18:53:51 +0000
@@ -1312,20 +1312,20 @@
 (defun eieio--defmethod (method kind argclass code)
   "Work part of the `defmethod' macro defining METHOD with ARGS."
   (let ((key
-    ;; find optional keys
+         ;; find optional keys
          (cond ((or (eq ':BEFORE kind)
                     (eq ':before kind))
-                method-before)
+                method-before)
                ((or (eq ':AFTER kind)
                     (eq ':after kind))
-                method-after)
+                method-after)
                ((or (eq ':PRIMARY kind)
                     (eq ':primary kind))
-                method-primary)
+                method-primary)
                ((or (eq ':STATIC kind)
                     (eq ':static kind))
-                method-static)
-               ;; Primary key
+                method-static)
+               ;; Primary key
                (t method-primary))))
     ;; Make sure there is a generic (when called from defclass).
     (eieio--defalias
@@ -1338,8 +1338,8 @@
     ;; under the type `primary' which is a non-specific calling of the
     ;; function.
     (if argclass
-         (if (not (class-p argclass))
-             (error "Unknown class type %s in method parameters"
+        (if (not (class-p argclass))
+            (error "Unknown class type %s in method parameters"
                    argclass))
       (if (= key -1)
          (signal 'wrong-type-argument (list :static 'non-class-arg)))
@@ -2864,6 +2864,106 @@
 )
 
 
+;;; Obsolete backward compatibility functions.
+;; Needed to run byte-code compiled with the EIEIO of Emacs-23.
+
+(defun eieio-defmethod (method args)
+  "Obsolete work part of an old version of the `defmethod' macro."
+  (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa)
+    ;; find optional keys
+    (setq key
+         (cond ((or (eq ':BEFORE (car args))
+                    (eq ':before (car args)))
+                (setq args (cdr args))
+                method-before)
+               ((or (eq ':AFTER (car args))
+                    (eq ':after (car args)))
+                (setq args (cdr args))
+                method-after)
+               ((or (eq ':PRIMARY (car args))
+                    (eq ':primary (car args)))
+                (setq args (cdr args))
+                method-primary)
+               ((or (eq ':STATIC (car args))
+                    (eq ':static (car args)))
+                (setq args (cdr args))
+                method-static)
+               ;; Primary key
+               (t method-primary)))
+    ;; get body, and fix contents of args to be the arguments of the fn.
+    (setq body (cdr args)
+         args (car args))
+    (setq loopa args)
+    ;; Create a fixed version of the arguments
+    (while loopa
+      (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa))
+                        argfix))
+      (setq loopa (cdr loopa)))
+    ;; make sure there is a generic
+    (eieio-defgeneric
+     method
+     (if (stringp (car body))
+        (car body) (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
+    ;; under the type `primary' which is a non-specific calling of the
+    ;; function.
+    (setq firstarg (car args))
+    (if (listp firstarg)
+       (progn
+         (setq argclass  (nth 1 firstarg))
+         (if (not (class-p argclass))
+             (error "Unknown class type %s in method parameters"
+                    (nth 1 firstarg))))
+      (if (= key -1)
+         (signal 'wrong-type-argument (list :static 'non-class-arg)))
+      ;; generics are higher
+      (setq key (eieio-specialized-key-to-generic-key key)))
+    ;; Put this lambda into the symbol so we can find it
+    (if (byte-code-function-p (car-safe body))
+       (eieiomt-add method (car-safe body) key argclass)
+      (eieiomt-add method (append (list 'lambda (reverse argfix)) body)
+                  key argclass))
+    )
+
+  (when eieio-optimize-primary-methods-flag
+    ;; Optimizing step:
+    ;;
+    ;; If this method, after this setup, only has primary methods, then
+    ;; we can setup the generic that way.
+    (if (generic-primary-only-p method)
+       ;; If there is only one primary method, then we can go one more
+       ;; optimization step.
+       (if (generic-primary-only-one-p method)
+           (eieio-defgeneric-reset-generic-form-primary-only-one method)
+         (eieio-defgeneric-reset-generic-form-primary-only method))
+      (eieio-defgeneric-reset-generic-form method)))
+
+  method)
+(make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1")
+
+(defun eieio-defgeneric (method doc-string)
+  "Obsolete work part of an old version of the `defgeneric' macro."
+  (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))
+(make-obsolete 'eieio-defgeneric nil "24.1")
+
 ;;; Interfacing with edebug
 ;;
 (defun eieio-edebug-prin1-to-string (object &optional noescape)