diff options
| author | Stefan Monnier | 2012-08-10 17:20:24 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2012-08-10 17:20:24 -0400 |
| commit | 86b9724a1e7cebc64b02246aae615e1e9d59ed05 (patch) | |
| tree | e71b72eb0d4df1ccb237bf5c9c40e0562693d75b | |
| parent | daa9f1a6076ee5e54c8b56b321bc1d2d991a15c6 (diff) | |
| download | emacs-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/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/gnus/gnus-agent.el | 42 |
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 @@ | |||
| 1 | 2012-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 | |||
| 1 | 2012-08-10 Daiki Ueno <ueno@unixuser.org> | 6 | 2012-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) |