From 94c66ce57bb8992de45349f8e8849797d4bdd3a7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Oct 2012 02:01:10 -0400 Subject: [PATCH] * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Obey the :read-only property. --- lisp/ChangeLog | 7 ++++-- lisp/emacs-lisp/cl-loaddefs.el | 2 +- lisp/emacs-lisp/cl-macs.el | 43 ++++++++++++++++++---------------- 3 files changed, 29 insertions(+), 23 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dc78d92554..184356f99f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2012-10-09 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl-defstruct): Obey the :read-only property. + 2012-10-09 Fabián Ezequiel Gallina Implemented `backward-up-list'-like navigation. @@ -20,8 +24,7 @@ 2012-10-08 Fabián Ezequiel Gallina Fix shell handling of unbalanced quotes and parens in output. - * progmodes/python.el (python-rx-constituents): Added - string-delimiter. + * progmodes/python.el (python-rx-constituents): Add string-delimiter. (python-syntax-propertize-function): Use it. (python-shell-output-syntax-table): New var. (inferior-python-mode): Prevent unbalanced parens/quotes from diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index e25ac5f970..d05fbc4206 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -260,7 +260,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value. ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "6951d080daefb5194b1d21fe9b2deae4") +;;;;;; "cl-macs" "cl-macs.el" "885919e79dbcd11081cfb2e039b470c7") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 99bae1944e..592c33d21c 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2324,26 +2324,29 @@ value, that slot cannot be set via `setf'. (if (= pos 0) '(car cl-x) `(nth ,pos cl-x)))) forms) (push (cons accessor t) side-eff) - ;; Don't bother defining a setf-expander, since gv-get can use - ;; the compiler macro to get the same result. - ;;(push `(gv-define-setter ,accessor (cl-val cl-x) - ;; ,(if (cadr (memq :read-only (cddr desc))) - ;; `(progn (ignore cl-x cl-val) - ;; (error "%s is a read-only slot" - ;; ',accessor)) - ;; ;; If cl is loaded only for compilation, - ;; ;; the call to cl--struct-setf-expander would - ;; ;; cause a warning because it may not be - ;; ;; defined at run time. Suppress that warning. - ;; `(progn - ;; (declare-function - ;; cl--struct-setf-expander "cl-macs" - ;; (x name accessor pred-form pos)) - ;; (cl--struct-setf-expander - ;; cl-val cl-x ',name ',accessor - ;; ,(and pred-check `',pred-check) - ;; ,pos)))) - ;; forms) + (if (cadr (memq :read-only (cddr desc))) + (push `(gv-define-expander ,accessor + (lambda (_cl-do _cl-x) + (error "%s is a read-only slot" ',accessor))) + forms) + ;; For normal slots, we don't need to define a setf-expander, + ;; since gv-get can use the compiler macro to get the + ;; same result. + ;; (push `(gv-define-setter ,accessor (cl-val cl-x) + ;; ;; If cl is loaded only for compilation, + ;; ;; the call to cl--struct-setf-expander would + ;; ;; cause a warning because it may not be + ;; ;; defined at run time. Suppress that warning. + ;; (progn + ;; (declare-function + ;; cl--struct-setf-expander "cl-macs" + ;; (x name accessor pred-form pos)) + ;; (cl--struct-setf-expander + ;; cl-val cl-x ',name ',accessor + ;; ,(and pred-check `',pred-check) + ;; ,pos))) + ;; forms) + ) (if print-auto (nconc print-func (list `(princ ,(format " %s" slot) cl-s) -- 2.20.1