procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/gnus/gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-groups):

Browse source 
Use defsetf.
This commit is contained in:
Stefan Monnier 2012-08-10 17:20:24 -04:00
parent daa9f1a607
commit 86b9724a1e
2 changed files with 13 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lisp/gnus/ChangeLog
View file

@ -1,3 +1,8 @@
2012-08-10 Stefan Monnier <monnier@iro.umontreal.ca>
* gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-groups):
Use defsetf.
2012-08-10 Daiki Ueno <ueno@unixuser.org>
* auth-source.el: (auth-source-plstore-search)

40
lisp/gnus/gnus-agent.el
View file

@ -354,23 +354,11 @@ manipulated as follows:
(func LIST): Returns VALUE1
(setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1."
`(progn (defmacro ,name (category)
(list (quote cdr) (list (quote assq)
(quote (quote ,prop-name)) category)))
(list 'cdr (list 'assq '',prop-name category)))
(define-setf-method ,name (category)
(let* ((--category--temp-- (make-symbol "--category--"))
(--value--temp-- (make-symbol "--value--")))
(list (list --category--temp--) ; temporary-variables
(list category) ; value-forms
(list --value--temp--) ; store-variables
(let* ((category --category--temp--) ; store-form
(value --value--temp--))
(list (quote gnus-agent-cat-set-property)
category
(quote (quote ,prop-name))
value))
(list (quote ,name) --category--temp--) ; access-form
)))))
(defsetf ,name (category) (value)
(list 'gnus-agent-cat-set-property
category '',prop-name value))))
)
(defmacro gnus-agent-cat-name (category)
@ -398,22 +386,10 @@ manipulated as follows:
gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
;; This form is equivalent to defsetf except that it calls make-symbol
;; whereas defsetf calls gensym (Using gensym creates a run-time
;; dependency on the CL library).
(eval-and-compile
(define-setf-method gnus-agent-cat-groups (category)
(let* ((--category--temp-- (make-symbol "--category--"))
(--groups--temp-- (make-symbol "--groups--")))
(list (list --category--temp--)
(list category)
(list --groups--temp--)
(let* ((category --category--temp--)
(groups --groups--temp--))
(list (quote gnus-agent-set-cat-groups) category groups))
(list (quote gnus-agent-cat-groups) --category--temp--))))
)
;; This form may expand to code that uses CL functions at run-time,
;; but that's OK since those functions will only ever be called from
;; something like `setf', so only when CL is loaded anyway.
(defsetf gnus-agent-cat-groups gnus-agent-set-cat-groups)
(defun gnus-agent-set-cat-groups (category groups)
(unless (eq groups 'ignore)