aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEli Zaretskii2015-02-09 18:27:21 +0200
committerEli Zaretskii2015-02-09 18:27:21 +0200
commitcbf1c1f2c7d38b732c3e76c677478ed30a4fee14 (patch)
tree45cabfddf80f016b3928d11fa7537649b55bd30c
parent403cb178c75a80603dbd8ed23e342d2109645401 (diff)
parent2973127159944de98f1e4ece7fd46a202e1352c6 (diff)
downloademacs-cbf1c1f2c7d38b732c3e76c677478ed30a4fee14.tar.gz
emacs-cbf1c1f2c7d38b732c3e76c677478ed30a4fee14.zip
Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs
-rw-r--r--lisp/ChangeLog7
-rw-r--r--lisp/emacs-lisp/cl-generic.el13
-rw-r--r--lisp/emacs-lisp/eieio-core.el2
3 files changed, 13 insertions, 9 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9ca0c306e44..e86d62da05a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
12015-02-09 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/cl-generic.el (cl--generic-lambda): Use macroexp-parse-body.
4
5 * emacs-lisp/eieio-core.el (eieio-oset-default): Catch the unexpected
6 case where the default value would be re-interpreted as a form!
7
12015-02-09 Christopher Genovese <genovese@cmu.edu> (tiny change) 82015-02-09 Christopher Genovese <genovese@cmu.edu> (tiny change)
2 9
3 * help-fns.el (help-fns--signature): Keep doc for keymap. 10 * help-fns.el (help-fns--signature): Keep doc for keymap.
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 42e637958b1..c4232863cfc 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -243,8 +243,6 @@ This macro can only be used within the lexical scope of a cl-generic method."
243 "Make the lambda expression for a method with ARGS and BODY." 243 "Make the lambda expression for a method with ARGS and BODY."
244 (let ((plain-args ()) 244 (let ((plain-args ())
245 (specializers nil) 245 (specializers nil)
246 (doc-string (if (and (stringp (car-safe body)) (cdr body))
247 (pop body)))
248 (mandatory t)) 246 (mandatory t))
249 (dolist (arg args) 247 (dolist (arg args)
250 (push (pcase arg 248 (push (pcase arg
@@ -255,9 +253,7 @@ This macro can only be used within the lexical scope of a cl-generic method."
255 (_ arg)) 253 (_ arg))
256 plain-args)) 254 plain-args))
257 (setq plain-args (nreverse plain-args)) 255 (setq plain-args (nreverse plain-args))
258 (let ((fun `(cl-function (lambda ,plain-args 256 (let ((fun `(cl-function (lambda ,plain-args ,@body)))
259 ,@(if doc-string (list doc-string))
260 ,@body)))
261 (macroenv (cons `(cl-generic-current-method-specializers 257 (macroenv (cons `(cl-generic-current-method-specializers
262 . ,(lambda () specializers)) 258 . ,(lambda () specializers))
263 macroexpand-all-environment))) 259 macroexpand-all-environment)))
@@ -266,14 +262,13 @@ This macro can only be used within the lexical scope of a cl-generic method."
266 ;; destructuring args, `declare' and whatnot). 262 ;; destructuring args, `declare' and whatnot).
267 (pcase (macroexpand fun macroenv) 263 (pcase (macroexpand fun macroenv)
268 (`#'(lambda ,args . ,body) 264 (`#'(lambda ,args . ,body)
269 (let* ((doc-string (and doc-string (stringp (car body)) (cdr body) 265 (let* ((parsed-body (macroexp-parse-body body))
270 (pop body)))
271 (cnm (make-symbol "cl--cnm")) 266 (cnm (make-symbol "cl--cnm"))
272 (nmp (make-symbol "cl--nmp")) 267 (nmp (make-symbol "cl--nmp"))
273 (nbody (macroexpand-all 268 (nbody (macroexpand-all
274 `(cl-flet ((cl-call-next-method ,cnm) 269 `(cl-flet ((cl-call-next-method ,cnm)
275 (cl-next-method-p ,nmp)) 270 (cl-next-method-p ,nmp))
276 ,@body) 271 ,@(cdr parsed-body))
277 macroenv)) 272 macroenv))
278 ;; FIXME: Rather than `grep' after the fact, the 273 ;; FIXME: Rather than `grep' after the fact, the
279 ;; macroexpansion should directly set some flag when cnm 274 ;; macroexpansion should directly set some flag when cnm
@@ -283,7 +278,7 @@ This macro can only be used within the lexical scope of a cl-generic method."
283 (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody))) 278 (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
284 (cons (not (not uses-cnm)) 279 (cons (not (not uses-cnm))
285 `#'(lambda (,@(if uses-cnm (list cnm)) ,@args) 280 `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
286 ,@(if doc-string (list doc-string)) 281 ,@(delq nil (car parsed-body))
287 ,(if (not (memq nmp uses-cnm)) 282 ,(if (not (memq nmp uses-cnm))
288 nbody 283 nbody
289 `(let ((,nmp (lambda () 284 `(let ((,nmp (lambda ()
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index fa8fefa1df0..e71c54d4123 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -1010,6 +1010,8 @@ Fills in the default value in CLASS' in SLOT with VALUE."
1010 (signal 'invalid-slot-name (list (eieio--class-symbol class) slot))) 1010 (signal 'invalid-slot-name (list (eieio--class-symbol class) slot)))
1011 (eieio--validate-slot-value class c value slot) 1011 (eieio--validate-slot-value class c value slot)
1012 ;; Set this into the storage for defaults. 1012 ;; Set this into the storage for defaults.
1013 (if (eieio-eval-default-p value)
1014 (error "Can't set default to a sexp that gets evaluated again"))
1013 (setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots)) 1015 (setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots))
1014 (eieio--class-public-d class)) 1016 (eieio--class-public-d class))
1015 value) 1017 value)