diff options
Diffstat (limited to 'lisp/emacs-lisp/gv.el')
| -rw-r--r-- | lisp/emacs-lisp/gv.el | 119 |
1 files changed, 114 insertions, 5 deletions
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 33e85e49c7b..1db9d96d999 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -74,7 +74,7 @@ ;; (defvar gv--macro-environment nil ;; "Macro expanders for generalized variables.") -(define-error 'gv-invalid-place "%S is not a valid place expression") +(define-error 'gv-invalid-place "Invalid place expression") ;;;###autoload (defun gv-get (place do) @@ -87,11 +87,18 @@ with a (not necessarily copyable) Elisp expression that returns the value to set it to. DO must return an Elisp expression." (cond - ((symbolp place) (funcall do place (lambda (v) `(setq ,place ,v)))) + ((symbolp place) + (let ((me (macroexpand-1 place macroexpand-all-environment))) + (if (eq me place) + (funcall do place (lambda (v) `(setq ,place ,v))) + (gv-get me do)))) ((not (consp place)) (signal 'gv-invalid-place (list place))) (t (let* ((head (car place)) (gf (function-get head 'gv-expander 'autoload))) + (when (and (symbolp head) + (get head 'byte-obsolete-generalized-variable)) + (byte-compile-warn-obsolete head "generalized variable")) (if gf (apply gf do (cdr place)) (let ((me (macroexpand-1 place ;; (append macroexpand-all-environment @@ -166,6 +173,18 @@ 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)))) +(defun make-obsolete-generalized-variable (obsolete-name current-name when) + "Make byte-compiler warn that generalized variable OBSOLETE-NAME is obsolete. +The warning will say that CURRENT-NAME should be used instead. + +If CURRENT-NAME is a string, that is the `use instead' message. + +WHEN should be a string indicating when the variable was first +made obsolete, for example a date or a release number." + (put obsolete-name 'byte-obsolete-generalized-variable + (purecopy (list current-name when))) + obsolete-name) + ;; Additions for `declare'. We specify the values as named aliases so ;; that `describe-variable' prints something useful; cf. Bug#40491. @@ -392,6 +411,7 @@ The return value is the last VAL in the list. (gv-define-setter buffer-local-value (val var buf) (macroexp-let2 nil v val `(with-current-buffer ,buf (set (make-local-variable ,var) ,v)))) +(make-obsolete-generalized-variable 'buffer-local-value nil "29.1") (gv-define-expander alist-get (lambda (do key alist &optional default remove testfn) @@ -594,7 +614,7 @@ binding mode." code (macroexp-warn-and-return "Use of gv-ref probably requires lexical-binding" - code)))) + code nil nil place)))) (defsubst gv-deref (ref) "Dereference REF, returning the referenced value. @@ -602,7 +622,7 @@ This is like the `*' operator of the C language. REF must have been previously obtained with `gv-ref'." (funcall (car ref))) ;; Don't use `declare' because it seems to introduce circularity problems: -;; Warning: Eager macro-expansion skipped due to cycle: +;; Eager macro-expansion skipped due to cycle: ;; … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el") (gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v)) @@ -618,71 +638,160 @@ REF must have been previously obtained with `gv-ref'." ;; Some Emacs-related place types. (gv-define-simple-setter buffer-file-name set-visited-file-name t) +(make-obsolete-generalized-variable + 'buffer-file-name 'set-visited-file-name "29.1") + (gv-define-setter buffer-modified-p (flag &optional buf) (macroexp-let2 nil buffer `(or ,buf (current-buffer)) `(with-current-buffer ,buffer (set-buffer-modified-p ,flag)))) +(make-obsolete-generalized-variable + 'buffer-modified-p 'set-buffer-modified-p "29.1") + (gv-define-simple-setter buffer-name rename-buffer t) +(make-obsolete-generalized-variable 'buffer-name 'rename-buffer "29.1") + (gv-define-setter buffer-string (store) `(insert (prog1 ,store (erase-buffer)))) +(make-obsolete-generalized-variable 'buffer-string nil "29.1") + (gv-define-simple-setter buffer-substring cl--set-buffer-substring) +(make-obsolete-generalized-variable 'buffer-substring nil "29.1") + (gv-define-simple-setter current-buffer set-buffer) +(make-obsolete-generalized-variable 'current-buffer 'set-buffer "29.1") + (gv-define-simple-setter current-column move-to-column t) +(make-obsolete-generalized-variable 'current-column 'move-to-column "29.1") + (gv-define-simple-setter current-global-map use-global-map t) +(make-obsolete-generalized-variable 'current-global-map 'use-global-map "29.1") + (gv-define-setter current-input-mode (store) `(progn (apply #'set-input-mode ,store) ,store)) +(make-obsolete-generalized-variable 'current-input-mode nil "29.1") + (gv-define-simple-setter current-local-map use-local-map t) +(make-obsolete-generalized-variable 'current-local-map 'use-local-map "29.1") + (gv-define-simple-setter current-window-configuration set-window-configuration t) +(make-obsolete-generalized-variable + 'current-window-configuration 'set-window-configuration "29.1") + (gv-define-simple-setter default-file-modes set-default-file-modes t) +(make-obsolete-generalized-variable + 'default-file-modes 'set-default-file-modes "29.1") + (gv-define-simple-setter documentation-property put) +(make-obsolete-generalized-variable 'documentation-property 'put "29.1") + (gv-define-setter face-background (x f &optional s) `(set-face-background ,f ,x ,s)) (gv-define-setter face-background-pixmap (x f &optional s) - `(set-face-background-pixmap ,f ,x ,s)) + `(set-face-stipple ,f ,x ,s)) +(make-obsolete-generalized-variable 'face-background-pixmap 'face-stipple "29.1") +(gv-define-setter face-stipple (x f &optional s) + `(set-face-stipple ,f ,x ,s)) (gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s)) (gv-define-setter face-foreground (x f &optional s) `(set-face-foreground ,f ,x ,s)) (gv-define-setter face-underline-p (x f &optional s) `(set-face-underline ,f ,x ,s)) (gv-define-simple-setter file-modes set-file-modes t) + (gv-define-setter frame-height (x &optional frame) `(set-frame-height (or ,frame (selected-frame)) ,x)) +(make-obsolete-generalized-variable 'frame-height 'set-frame-height "29.1") + (gv-define-simple-setter frame-parameters modify-frame-parameters t) (gv-define-simple-setter frame-visible-p cl--set-frame-visible-p) +(make-obsolete-generalized-variable 'frame-visible-p nil "29.1") + (gv-define-setter frame-width (x &optional frame) `(set-frame-width (or ,frame (selected-frame)) ,x)) +(make-obsolete-generalized-variable 'frame-width 'set-frame-width "29.1") + (gv-define-simple-setter getenv setenv t) (gv-define-simple-setter get-register set-register) + (gv-define-simple-setter global-key-binding global-set-key) +(make-obsolete-generalized-variable 'global-key-binding 'global-set-key "29.1") + (gv-define-simple-setter local-key-binding local-set-key) +(make-obsolete-generalized-variable 'local-key-binding 'local-set-key "29.1") + (gv-define-simple-setter mark set-mark t) +(make-obsolete-generalized-variable 'mark 'set-mark "29.1") + (gv-define-simple-setter mark-marker set-mark t) +(make-obsolete-generalized-variable 'mark-marker 'set-mark "29.1") + (gv-define-simple-setter marker-position set-marker t) +(make-obsolete-generalized-variable 'marker-position 'set-marker "29.1") + (gv-define-setter mouse-position (store scr) `(set-mouse-position ,scr (car ,store) (cadr ,store) (cddr ,store))) +(make-obsolete-generalized-variable 'mouse-position 'set-mouse-position "29.1") + (gv-define-simple-setter point goto-char) +(make-obsolete-generalized-variable 'point 'goto-char "29.1") + (gv-define-simple-setter point-marker goto-char t) +(make-obsolete-generalized-variable 'point-marker 'goto-char "29.1") + (gv-define-setter point-max (store) `(progn (narrow-to-region (point-min) ,store) ,store)) +(make-obsolete-generalized-variable 'point-max 'narrow-to-region "29.1") + (gv-define-setter point-min (store) `(progn (narrow-to-region ,store (point-max)) ,store)) +(make-obsolete-generalized-variable 'point-min 'narrow-to-region "29.1") + (gv-define-setter read-mouse-position (store scr) `(set-mouse-position ,scr (car ,store) (cdr ,store))) +(make-obsolete-generalized-variable + 'read-mouse-position 'set-mouse-position "29.1") + (gv-define-simple-setter screen-height set-screen-height t) +(make-obsolete-generalized-variable 'screen-height 'set-screen-height "29.1") + (gv-define-simple-setter screen-width set-screen-width t) +(make-obsolete-generalized-variable 'screen-width 'set-screen-width "29.1") + (gv-define-simple-setter selected-window select-window) +(make-obsolete-generalized-variable 'selected-window 'select-window "29.1") + (gv-define-simple-setter selected-screen select-screen) +(make-obsolete-generalized-variable 'selected-screen 'select-screen "29.1") + (gv-define-simple-setter selected-frame select-frame) +(make-obsolete-generalized-variable 'selected-frame 'select-frame "29.1") + (gv-define-simple-setter standard-case-table set-standard-case-table) +(make-obsolete-generalized-variable + 'standard-case-table 'set-standard-case-table "29.1") + (gv-define-simple-setter syntax-table set-syntax-table) +(make-obsolete-generalized-variable 'syntax-table 'set-syntax-table "29.1") + (gv-define-simple-setter visited-file-modtime set-visited-file-modtime t) +(make-obsolete-generalized-variable + 'visited-file-modtime 'set-visited-file-modtime "29.1") + (gv-define-setter window-height (store) `(progn (enlarge-window (- ,store (window-height))) ,store)) +(make-obsolete-generalized-variable 'window-height 'enlarge-window "29.1") + (gv-define-setter window-width (store) `(progn (enlarge-window (- ,store (window-width)) t) ,store)) +(make-obsolete-generalized-variable 'window-width 'enlarge-window "29.1") + (gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t) +(make-obsolete-generalized-variable + 'x-get-secondary-selection 'x-own-secondary-selection "29.1") + ;; More complex setf-methods. |