diff options
Diffstat (limited to 'lisp/emacs-lisp/gv.el')
| -rw-r--r-- | lisp/emacs-lisp/gv.el | 47 |
1 files changed, 37 insertions, 10 deletions
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 065a9688770..5470b8532fc 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -166,15 +166,25 @@ arguments as NAME. DO is a function as defined in `gv-get'." ;; (`(expand ,expander) `(gv-define-expand ,name ,expander)) (_ (message "Unknown %s declaration %S" symbol handler) nil)))) +;; Additions for `declare'. We specify the values as named aliases so +;; that `describe-variable' prints something useful; cf. Bug#40491. + +;;;###autoload +(defsubst gv--expander-defun-declaration (&rest args) + (apply #'gv--defun-declaration 'gv-expander args)) + +;;;###autoload +(defsubst gv--setter-defun-declaration (&rest args) + (apply #'gv--defun-declaration 'gv-setter args)) + ;;;###autoload (or (assq 'gv-expander defun-declarations-alist) - (let ((x `(gv-expander - ,(apply-partially #'gv--defun-declaration 'gv-expander)))) + (let ((x (list 'gv-expander #'gv--expander-defun-declaration))) (push x macro-declarations-alist) (push x defun-declarations-alist))) ;;;###autoload (or (assq 'gv-setter defun-declarations-alist) - (push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter)) + (push (list 'gv-setter #'gv--setter-defun-declaration) defun-declarations-alist)) ;; (defmacro gv-define-expand (name expander) @@ -214,7 +224,7 @@ The first arg in ARGLIST (the one that receives VAL) receives an expression which can do arbitrary things, whereas the other arguments are all guaranteed to be pure and copyable. Example use: (gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))" - (declare (indent 2) (debug (&define name sexp def-body))) + (declare (indent 2) (debug (&define name :name gv-setter sexp def-body))) `(gv-define-expander ,name (lambda (do &rest args) (declare-function @@ -407,6 +417,17 @@ The return value is the last VAL in the list. `(delq ,p ,getter)))))) ,v)))))))))) +(gv-define-expander plist-get + (lambda (do plist prop) + (macroexp-let2 macroexp-copyable-p key prop + (gv-letplace (getter setter) plist + (macroexp-let2 nil p `(cdr (plist-member ,getter ,key)) + (funcall do + `(car ,p) + (lambda (val) + `(if ,p + (setcar ,p ,val) + ,(funcall setter `(cons ,key (cons ,val ,getter))))))))))) ;;; Some occasionally handy extensions. @@ -517,9 +538,12 @@ This macro only makes sense when used in a place." (gv-letplace (dgetter dsetter) d (funcall do `(cons ,agetter ,dgetter) - (lambda (v) `(progn - ,(funcall asetter `(car ,v)) - ,(funcall dsetter `(cdr ,v))))))))) + (lambda (v) + (macroexp-let2 nil v v + `(progn + ,(funcall asetter `(car ,v)) + ,(funcall dsetter `(cdr ,v)) + ,v)))))))) (put 'logand 'gv-expander (lambda (do place &rest masks) @@ -529,9 +553,12 @@ This macro only makes sense when used in a place." (funcall do `(logand ,getter ,mask) (lambda (v) - (funcall setter - `(logior (logand ,v ,mask) - (logand ,getter (lognot ,mask)))))))))) + (macroexp-let2 nil v v + `(progn + ,(funcall setter + `(logior (logand ,v ,mask) + (logand ,getter (lognot ,mask)))) + ,v)))))))) ;;; References |