Commit 9869b3ae authored by Stefan Monnier's avatar Stefan Monnier
Browse files

Fix earlier half-done eieio-defmethod change.

* lisp/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.

Fixes: debbugs:8338
parent 773233f8
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.
......@@ -15,8 +25,8 @@
(autoload-find-generated-file): New function.
(generate-file-autoloads): Bind generated-autoload-file to
buffer-file-name.
(update-file-autoloads, update-directory-autoloads): Use
autoload-find-generated-file. If called interactively, prompt for
(update-file-autoloads, update-directory-autoloads):
Use autoload-find-generated-file. If called interactively, prompt for
output file (Bug#7989).
(batch-update-autoloads): Doc fix.
......
......@@ -656,14 +656,14 @@ See `defclass' for more information."
;; 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 @@ See `defclass' for more information."
;; 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 @@ Summary:
((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)))))
(defun eieio-defmethod (method args &optional code)
(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 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 @@ OBJECT can be an instance or a class."
;; 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."
......
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