mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-09 15:50:40 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/emacs-lisp/cl-macs.el (cl-defstruct): Obey the :read-only property.

Browse source
This commit is contained in:
Stefan Monnier 2012-10-09 02:01:10 -04:00
parent 7518fc1221
commit 94c66ce57b
3 changed files with 29 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lisp/emacs-lisp/cl-loaddefs.el
View file

@ -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" "\

43
lisp/emacs-lisp/cl-macs.el
View file

@ -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)