bug#8338: 24.0.50; lexbind lisp error

[Stefan Monnier]

> I looked at the bzr trunk and here is how to reproduce

> emacs -Q
> enable semantic (semantic-mode 1)
> open a c file kernel/fork.c
> on a function name do semantic-ia-show-summary
> exit emacs. This will ask to create semanticDB
> start emacs -Q 
> open the same c file 
> you get the error

I believe I have found the culprit and fixed it with the patch below
which I have just installed into trunk.
Thanks Eric for pointing out that maybe the real problem was hidden by
a condition-case somewhere.

I'm bumping into another unexplained problem now, tho.  It might be due
to some local messed up database (the same problem shows up with
Emacs-23.3), but in any case, please confirm (or infirm) that the
problem is really fixed for you.


        Stefan
        

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog      2011-05-05 03:26:55 +0000
+++ lisp/ChangeLog      2011-05-05 03:41:47 +0000
@@ -1,3 +1,13 @@
+2011-05-05  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       Fix earlier half-done eieio-defmethod change (bug#8338).
+       * emacs-lisp/eieio.el (eieio--defmethod): Rename from eieio-defmethod.
+       Streamline and change calling convention.
+       (defmethod): Adjust accordingly and simplify.
+       (eieio-defclass): Fix broken calls to eieio-defmethod and redirect to
+       new eieio--defmethod.
+       (slot-boundp): Minor CSE simplification.
+
 2011-05-05  Milan Zamazal  <pdm@zamazal.org>
 
        * progmodes/glasses.el (glasses-separate-capital-groups): New option.

=== modified file 'lisp/emacs-lisp/eieio.el'
--- lisp/emacs-lisp/eieio.el    2011-04-01 15:16:50 +0000
+++ lisp/emacs-lisp/eieio.el    2011-05-05 03:31:19 +0000
@@ -656,14 +656,14 @@
        ;; so that users can `setf' the space returned by this function
        (if acces
            (progn
-             (eieio-defmethod acces
-               (list (if (eq alloc :class) :static :primary)
-                     (list (list 'this cname))
-                     (format
+             (eieio--defmethod
+               acces (if (eq alloc :class) :static :primary) cname
+               `(lambda (this)
+                  ,(format
                       "Retrieves the slot `%s' from an object of class `%s'"
                       name cname)
-                     (list 'if (list 'slot-boundp 'this (list 'quote name))
-                           (list 'eieio-oref 'this (list 'quote name))
+                  (if (slot-boundp this ',name)
+                      (eieio-oref this ',name)
                            ;; Else - Some error?  nil?
                            nil)))
 
@@ -683,22 +683,21 @@
        ;; 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
-           (progn
-             (eieio-defmethod writer
-               (list (list (list 'this cname) 'value)
-                     (format "Set the slot `%s' of an object of class `%s'"
+            (eieio--defmethod
+             writer nil cname
+             `(lambda (this value)
+                ,(format "Set the slot `%s' of an object of class `%s'"
                              name cname)
-                     `(setf (slot-value this ',name) value)))
-             ))
+                (setf (slot-value this ',name) value))))
        ;; If a reader is defined, then create a generic method
        ;; of that name whose purpose is to access this slot value.
        (if reader
-           (progn
-             (eieio-defmethod reader
-               (list (list (list 'this cname))
-                     (format "Access the slot `%s' from object of class `%s'"
+            (eieio--defmethod
+             reader nil cname
+             `(lambda (this)
+                ,(format "Access the slot `%s' from object of class `%s'"
                              name cname)
-                     `(slot-value this ',name)))))
+                (slot-value this ',name))))
        )
       (setq slots (cdr slots)))
 
@@ -1290,83 +1289,48 @@
                      ((typearg class-name) arg2 &optional opt &rest rest)
     \"doc-string\"
      body)"
-  (let* ((key (cond ((or (eq ':BEFORE (car args))
-                         (eq ':before (car args)))
-                     (setq args (cdr args))
-                     :before)
-                    ((or (eq ':AFTER (car args))
-                         (eq ':after (car args)))
-                     (setq args (cdr args))
-                     :after)
-                    ((or (eq ':PRIMARY (car args))
-                         (eq ':primary (car args)))
-                     (setq args (cdr args))
-                     :primary)
-                    ((or (eq ':STATIC (car args))
-                         (eq ':static (car args)))
-                     (setq args (cdr args))
-                     :static)
-                    (t nil)))
+  (let* ((key (if (keywordp (car args)) (pop args)))
         (params (car args))
-        (lamparams
-          (mapcar (lambda (param) (if (listp param) (car param) param))
-                  params))
         (arg1 (car params))
-        (class (if (listp arg1) (nth 1 arg1) nil)))
-    `(eieio-defmethod ',method
-                      '(,@(if key (list key))
-                        ,params)
-                      (lambda ,lamparams ,@(cdr args)))))
+        (class (if (consp arg1) (nth 1 arg1))))
+    `(eieio--defmethod ',method ',key ',class
+                       (lambda ,(if (consp arg1)
+                               (cons (car arg1) (cdr params))
+                             params)
+                         ,@(cdr args)))))
 
-(defun eieio-defmethod (method args &optional code)
+(defun eieio--defmethod (method kind argclass code)
   "Work part of the `defmethod' macro defining METHOD with ARGS."
-  (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa)
+  (let ((key
     ;; find optional keys
-    (setq key
-         (cond ((or (eq ':BEFORE (car args))
-                    (eq ':before (car args)))
-                (setq args (cdr args))
+         (cond ((or (eq ':BEFORE kind)
+                    (eq ':before kind))
                 method-before)
-               ((or (eq ':AFTER (car args))
-                    (eq ':after (car args)))
-                (setq args (cdr args))
+               ((or (eq ':AFTER kind)
+                    (eq ':after kind))
                 method-after)
-               ((or (eq ':PRIMARY (car args))
-                    (eq ':primary (car args)))
-                (setq args (cdr args))
+               ((or (eq ':PRIMARY kind)
+                    (eq ':primary kind))
                 method-primary)
-               ((or (eq ':STATIC (car args))
-                    (eq ':static (car args)))
-                (setq args (cdr args))
+               ((or (eq ':STATIC kind)
+                    (eq ':static kind))
                 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)))
+               (t method-primary))))
     ;; make sure there is a generic
     (eieio-defgeneric
      method
-     (if (stringp (car body))
-        (car body) (format "Generically created method `%s'." 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
     ;; 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 argclass
          (if (not (class-p argclass))
              (error "Unknown class type %s in method parameters"
-                    (nth 1 firstarg))))
+                   argclass))
       (if (= key -1)
          (signal 'wrong-type-argument (list :static 'non-class-arg)))
       ;; generics are higher
@@ -1884,11 +1848,11 @@
   ;; Skip typechecking while retrieving this value.
   (let ((eieio-skip-typecheck t))
     ;; Return nil if the magic symbol is in there.
-    (if (eieio-object-p object)
-       (if (eq (eieio-oref object slot) eieio-unbound) nil t)
-      (if (class-p object)
-         (if (eq (eieio-oref-default object slot) eieio-unbound) nil t)
-       (signal 'wrong-type-argument (list 'eieio-object-p object))))))
+    (not (eq (cond
+             ((eieio-object-p object) (eieio-oref object slot))
+             ((class-p object)        (eieio-oref-default object slot))
+             (t (signal 'wrong-type-argument (list 'eieio-object-p object))))
+            eieio-unbound))))
 
 (defun slot-makeunbound (object slot)
   "In OBJECT, make SLOT unbound."