aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2012-08-10 17:20:24 -0400
committerStefan Monnier2012-08-10 17:20:24 -0400
commit86b9724a1e7cebc64b02246aae615e1e9d59ed05 (patch)
treee71b72eb0d4df1ccb237bf5c9c40e0562693d75b
parentdaa9f1a6076ee5e54c8b56b321bc1d2d991a15c6 (diff)
downloademacs-86b9724a1e7cebc64b02246aae615e1e9d59ed05.tar.gz
emacs-86b9724a1e7cebc64b02246aae615e1e9d59ed05.zip
* lisp/gnus/gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-groups):
Use defsetf.
-rw-r--r--lisp/gnus/ChangeLog5
-rw-r--r--lisp/gnus/gnus-agent.el42
2 files changed, 14 insertions, 33 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 2175687cfa9..7f2a7536717 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
12012-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-groups):
4 Use defsetf.
5
12012-08-10 Daiki Ueno <ueno@unixuser.org> 62012-08-10 Daiki Ueno <ueno@unixuser.org>
2 7
3 * auth-source.el: (auth-source-plstore-search) 8 * auth-source.el: (auth-source-plstore-search)
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 525008c351f..60d6102f7c0 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -354,23 +354,11 @@ manipulated as follows:
354 (func LIST): Returns VALUE1 354 (func LIST): Returns VALUE1
355 (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1." 355 (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1."
356 `(progn (defmacro ,name (category) 356 `(progn (defmacro ,name (category)
357 (list (quote cdr) (list (quote assq) 357 (list 'cdr (list 'assq '',prop-name category)))
358 (quote (quote ,prop-name)) category))) 358
359 359 (defsetf ,name (category) (value)
360 (define-setf-method ,name (category) 360 (list 'gnus-agent-cat-set-property
361 (let* ((--category--temp-- (make-symbol "--category--")) 361 category '',prop-name value))))
362 (--value--temp-- (make-symbol "--value--")))
363 (list (list --category--temp--) ; temporary-variables
364 (list category) ; value-forms
365 (list --value--temp--) ; store-variables
366 (let* ((category --category--temp--) ; store-form
367 (value --value--temp--))
368 (list (quote gnus-agent-cat-set-property)
369 category
370 (quote (quote ,prop-name))
371 value))
372 (list (quote ,name) --category--temp--) ; access-form
373 )))))
374 ) 362 )
375 363
376(defmacro gnus-agent-cat-name (category) 364(defmacro gnus-agent-cat-name (category)
@@ -398,22 +386,10 @@ manipulated as follows:
398 gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces) 386 gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
399 387
400 388
401;; This form is equivalent to defsetf except that it calls make-symbol 389;; This form may expand to code that uses CL functions at run-time,
402;; whereas defsetf calls gensym (Using gensym creates a run-time 390;; but that's OK since those functions will only ever be called from
403;; dependency on the CL library). 391;; something like `setf', so only when CL is loaded anyway.
404 392(defsetf gnus-agent-cat-groups gnus-agent-set-cat-groups)
405(eval-and-compile
406 (define-setf-method gnus-agent-cat-groups (category)
407 (let* ((--category--temp-- (make-symbol "--category--"))
408 (--groups--temp-- (make-symbol "--groups--")))
409 (list (list --category--temp--)
410 (list category)
411 (list --groups--temp--)
412 (let* ((category --category--temp--)
413 (groups --groups--temp--))
414 (list (quote gnus-agent-set-cat-groups) category groups))
415 (list (quote gnus-agent-cat-groups) --category--temp--))))
416 )
417 393
418(defun gnus-agent-set-cat-groups (category groups) 394(defun gnus-agent-set-cat-groups (category groups)
419 (unless (eq groups 'ignore) 395 (unless (eq groups 'ignore)