commit 16ec5f5f2ffd9e114262b0a3a717b772ee0350ae (HEAD, refs/remotes/origin/master) Author: Stefan Kangas Date: Mon Mar 9 02:24:55 2020 +0100 Remove XEmacs exclusive face from themes * etc/themes/deeper-blue-theme.el (class): * etc/themes/leuven-theme.el (class): * etc/themes/manoj-dark-theme.el (manoj-dark): * etc/themes/whiteboard-theme.el (class): Don't set XEmacs exclusive face 'font-lock-doc-string-face'. diff --git a/etc/themes/deeper-blue-theme.el b/etc/themes/deeper-blue-theme.el index 8dfe9e3617..58c22e403f 100644 --- a/etc/themes/deeper-blue-theme.el +++ b/etc/themes/deeper-blue-theme.el @@ -68,7 +68,6 @@ `(font-lock-comment-face ((,class (:foreground "gray50")))) `(font-lock-constant-face ((,class (:foreground "DarkOliveGreen3")))) `(font-lock-doc-face ((,class (:foreground "moccasin")))) - `(font-lock-doc-string-face ((,class (:foreground "moccasin")))) `(font-lock-function-name-face ((,class (:foreground "goldenrod")))) `(font-lock-keyword-face ((,class (:foreground "DeepSkyBlue1")))) `(font-lock-preprocessor-face ((,class (:foreground "gold")))) diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el index 4d8568b7d8..0d25ab9c5b 100644 --- a/etc/themes/leuven-theme.el +++ b/etc/themes/leuven-theme.el @@ -130,7 +130,6 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(font-lock-comment-face ((,class (:slant italic :foreground "#8D8D84")))) ; #696969 `(font-lock-constant-face ((,class (:foreground "#D0372D")))) `(font-lock-doc-face ((,class (:foreground "#036A07")))) - ;; `(font-lock-doc-string-face ((,class (:foreground "#008000")))) ; XEmacs only, but is used for HTML exports from org2html (and not interactively) `(font-lock-function-name-face ((,class (:weight normal :foreground "#006699")))) `(font-lock-keyword-face ((,class (:bold nil :foreground "#0000FF")))) ; #3654DC `(font-lock-preprocessor-face ((,class (:foreground "#808080")))) diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index 045d446284..337606674c 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -88,7 +88,6 @@ jarring angry fruit salad look to reduce eye fatigue.") '(font-lock-comment-face ((t (:italic t :slant oblique :foreground "chocolate1")))) '(font-lock-comment-delimiter-face ((t (:foreground "Salmon")))) '(font-lock-doc-face ((t (:italic t :slant oblique :foreground "LightCoral")))) - '(font-lock-doc-string-face ((t (:foreground "Plum")))) '(font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) '(cperl-array-face ((t (:foreground "LawnGreen" :background "Black" :bold t)))) diff --git a/etc/themes/whiteboard-theme.el b/etc/themes/whiteboard-theme.el index 853479fa9c..be6c67eff4 100644 --- a/etc/themes/whiteboard-theme.el +++ b/etc/themes/whiteboard-theme.el @@ -48,7 +48,6 @@ `(font-lock-comment-face ((,class (:foreground "gray50")))) `(font-lock-constant-face ((,class (:foreground "DarkOliveGreen4")))) `(font-lock-doc-face ((,class (:foreground "peru")))) - `(font-lock-doc-string-face ((,class (:foreground "peru")))) `(font-lock-function-name-face ((,class (:foreground "goldenrod3")))) `(font-lock-keyword-face ((,class (:foreground "DodgerBlue2")))) `(font-lock-preprocessor-face ((,class (:foreground "gold3")))) commit e003e90c41c0abb357c34eb30553f75148072949 Author: Stefan Kangas Date: Mon Mar 9 00:33:53 2020 +0100 Remove more XEmacs compat code from eshell * lisp/eshell/em-glob.el (eshell-extended-glob): * lisp/eshell/em-ls.el (eshell-do-ls): * lisp/eshell/em-unix.el (eshell/du, eshell-mvcpln-template): * lisp/eshell/esh-util.el (eshell-file-attributes): Remove more XEmacs compat code; no longer let-bind the unused variable ange-cache. diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 43483dcd50..a32a6abe29 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -232,8 +232,6 @@ resulting regular expression." (regexp-quote (substring pattern matched-in-pattern)) "\\'"))) -(defvar ange-cache) ; XEmacs? See esh-util - (defun eshell-extended-glob (glob) "Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY. This function almost fully supports zsh style filename generation @@ -252,7 +250,7 @@ the form: (INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))" (let ((paths (eshell-split-path glob)) - eshell-glob-matches message-shown ange-cache) + eshell-glob-matches message-shown) (unwind-protect (if (and (cdr paths) (file-name-absolute-p (car paths))) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 70b3ad611a..c1a022ee52 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -239,7 +239,6 @@ scope during the evaluation of TEST-SEXP." (defvar show-recursive) (defvar show-size) (defvar sort-method) -(defvar ange-cache) (defvar dired-flag) ;;; Functions: @@ -406,7 +405,7 @@ Sort entries alphabetically across.") (setq listing-style 'by-columns)) (unless args (setq args (list "."))) - (let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp) ange-cache) + (let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp)) (when ignore-pattern (unless (eshell-using-module 'eshell-glob) (error (concat "-I option requires that `eshell-glob'" diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 51699a7aa4..fbd3cfbb6f 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -469,8 +469,6 @@ Remove the DIRECTORY(ies), if they are empty.") (eshell-parse-command (format "tar %s %s" tar-args archive) args)))) -(defvar ange-cache) ; XEmacs? See esh-util - ;; this is to avoid duplicating code... (defmacro eshell-mvcpln-template (command action func query-var force-var &optional preserve) @@ -488,8 +486,7 @@ Remove the DIRECTORY(ies), if they are empty.") (or (not no-dereference) (not (file-symlink-p (car args))))))) (eshell-shorthand-tar-command ,command args) - (let ((target (car (last args))) - ange-cache) + (let ((target (car (last args)))) (setcdr (last args 2) nil) (eshell-shuffle-files ,command ,action args target ,func nil @@ -924,7 +921,7 @@ Summarize disk usage of each FILE, recursively for directories.") ;; filesystem support means nothing under Windows (if (eshell-under-windows-p) (setq only-one-filesystem nil)) - (let ((size 0.0) ange-cache) + (let ((size 0.0)) (while args (if only-one-filesystem (setq only-one-filesystem diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 0328c1f12f..ab030ede05 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -647,14 +647,8 @@ gid format. Valid values are `string' and `integer', defaulting to (let ((base (file-name-nondirectory file)) (dir (file-name-directory file))) (if (string-equal "" base) (setq base ".")) - (if (boundp 'ange-cache) - (setq entry (cdr (assoc base (cdr (assoc dir ange-cache)))))) (unless entry (setq entry (eshell-parse-ange-ls dir)) - (if (boundp 'ange-cache) - (setq ange-cache - (cons (cons dir entry) - ange-cache))) (if entry (let ((fentry (assoc base (cdr entry)))) (if fentry commit 0d6c51320d8066db867aae0e623d9731c69121ed Author: Stefan Monnier Date: Tue Mar 10 18:23:41 2020 -0400 * lisp/emacs-lisp/cl-macs.el: More care with `eval` and with `cl-typep` (cl-eval-when, cl--compile-time-too, cl-load-time-value): Obey lexical-binding. (cl-check-type): Prefer the predicate rather than the type in the error signal when it's easy to do (as is done outside of CL). (cl-deftype-satisfies): Add definitions for standard types. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ef3bc8548d..954731b06b 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -75,7 +75,7 @@ ;; one, you may want to amend the other, too. ;;;###autoload (define-obsolete-function-alias 'cl--compiler-macro-cXXr - 'internal--compiler-macro-cXXr "25.1") + #'internal--compiler-macro-cXXr "25.1") ;;; Some predicates for analyzing Lisp forms. ;; These are used by various @@ -714,9 +714,9 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) (cl--not-toplevel t)) (if (or (memq 'load when) (memq :load-toplevel when)) - (if comp (cons 'progn (mapcar 'cl--compile-time-too body)) + (if comp (cons 'progn (mapcar #'cl--compile-time-too body)) `(if nil nil ,@body)) - (progn (if comp (eval (cons 'progn body))) nil))) + (progn (if comp (eval (cons 'progn body) lexical-binding)) nil))) (and (or (memq 'eval when) (memq :execute when)) (cons 'progn body)))) @@ -725,13 +725,13 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. (setq form (macroexpand form (cons '(cl-eval-when) byte-compile-macro-environment)))) (cond ((eq (car-safe form) 'progn) - (cons 'progn (mapcar 'cl--compile-time-too (cdr form)))) + (cons 'progn (mapcar #'cl--compile-time-too (cdr form)))) ((eq (car-safe form) 'cl-eval-when) (let ((when (nth 1 form))) (if (or (memq 'eval when) (memq :execute when)) `(cl-eval-when (compile ,@when) ,@(cddr form)) form))) - (t (eval form) form))) + (t (eval form lexical-binding) form))) ;;;###autoload (defmacro cl-load-time-value (form &optional _read-only) @@ -757,7 +757,7 @@ The result of the body appears to the compiler as a quoted constant." ;; temp is set before we use it. (print set byte-compile--outbuffer)) temp) - `',(eval form))) + `',(eval form lexical-binding))) ;;; Conditional control structures. @@ -1495,8 +1495,8 @@ For more details, see Info node `(cl)Loop Facility'. (pop cl--loop-args)) (if (and ands loop-for-bindings) (push (nreverse loop-for-bindings) cl--loop-bindings) - (setq cl--loop-bindings (nconc (mapcar 'list loop-for-bindings) - cl--loop-bindings))) + (setq cl--loop-bindings (nconc (mapcar #'list loop-for-bindings) + cl--loop-bindings))) (if loop-for-sets (push `(progn ,(cl--loop-let (nreverse loop-for-sets) 'setq ands) @@ -1504,7 +1504,7 @@ For more details, see Info node `(cl)Loop Facility'. cl--loop-body)) (when loop-for-steps (push (cons (if ands 'cl-psetq 'setq) - (apply 'append (nreverse loop-for-steps))) + (apply #'append (nreverse loop-for-steps))) cl--loop-steps)))) ((eq word 'repeat) @@ -1697,7 +1697,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings." (push binding new)))) (if (eq body 'setq) (let ((set (cons (if par 'cl-psetq 'setq) - (apply 'nconc (nreverse new))))) + (apply #'nconc (nreverse new))))) (if temps `(let* ,(nreverse temps) ,set) set)) `(,(if par 'let 'let*) ,(nconc (nreverse temps) (nreverse new)) ,@body)))) @@ -1823,7 +1823,7 @@ For more details, see `cl-do*' description in Info node `(cl) Iteration'. (and sets (list (cons (if (or star (not (cdr sets))) 'setq 'cl-psetq) - (apply 'append sets)))))) + (apply #'append sets)))))) ,@(or (cdr endtest) '(nil))))) ;;;###autoload @@ -2468,7 +2468,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'. \(fn PLACE...)" (declare (debug (&rest place))) - (if (not (memq nil (mapcar 'symbolp args))) + (if (not (memq nil (mapcar #'symbolp args))) (and (cdr args) (let ((sets nil) (first (car args))) @@ -3128,13 +3128,27 @@ Of course, we really can't know that for sure, so it's just a heuristic." (or (cdr (assq sym byte-compile-function-environment)) (cdr (assq sym byte-compile-macro-environment)))))) -(put 'null 'cl-deftype-satisfies #'null) -(put 'atom 'cl-deftype-satisfies #'atom) -(put 'real 'cl-deftype-satisfies #'numberp) -(put 'fixnum 'cl-deftype-satisfies #'integerp) -(put 'base-char 'cl-deftype-satisfies #'characterp) -(put 'character 'cl-deftype-satisfies #'natnump) - +(pcase-dolist (`(,type . ,pred) + '((null . null) + (atom . atom) + (real . numberp) + (fixnum . integerp) + (base-char . characterp) + (character . natnump) + ;; "Obvious" mappings. + (string . stringp) + (list . listp) + (symbol . symbolp) + (function . functionp) + (integer . integerp) + (float . floatp) + (boolean . booleanp) + (vector . vectorp) + (array . arrayp) + ;; FIXME: Do we really want to consider this a type? + (integer-or-marker . integer-or-marker-p) + )) + (put type 'cl-deftype-satisfies pred)) ;;;###autoload (define-inline cl-typep (val type) @@ -3203,7 +3217,10 @@ STRING is an optional description of the desired type." (macroexp-let2 macroexp-copyable-p temp form `(progn (or (cl-typep ,temp ',type) (signal 'wrong-type-argument - (list ,(or string `',type) ,temp ',form))) + (list ,(or string `',(if (eq 'satisfies + (car-safe type)) + (cadr type) type)) + ,temp ',form))) nil)))) ;;;###autoload commit efe85a5b60b016eb3d11829c9590b54d935dd0c6 Author: Stefan Monnier Date: Tue Mar 10 18:08:54 2020 -0400 * lisp/emacs-lisp/cl-macs.el (cl--transform-lambda): Simplify result It used to return a pair (EXP . LAMBDA-CDR) but EXP was always nil, so just return the LAMBDA-CDR instead. (cl-defun, cl-iter-defun, cl-defmacro, cl-function, cl-macrolet): Adjust callers accordingly. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 4c2f58907d..ef3bc8548d 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -328,8 +328,7 @@ FORM is of the form (ARGS . BODY)." (setq cl--bind-lets (nreverse cl--bind-lets)) ;; (cl-assert (eq :dummy (nth 1 (car cl--bind-lets)))) (list '&rest (car (pop cl--bind-lets)))))))) - `(nil - (,@(nreverse simple-args) ,@rest-args) + `((,@(nreverse simple-args) ,@rest-args) ,@header ,(macroexp-let* cl--bind-lets (macroexp-progn @@ -366,9 +365,7 @@ more details. def-body)) (doc-string 3) (indent 2)) - (let* ((res (cl--transform-lambda (cons args body) name)) - (form `(defun ,name ,@(cdr res)))) - (if (car res) `(progn ,(car res) ,form) form))) + `(defun ,name ,@(cl--transform-lambda (cons args body) name))) ;;;###autoload (defmacro cl-iter-defun (name args &rest body) @@ -387,9 +384,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...). (doc-string 3) (indent 2)) (require 'generator) - (let* ((res (cl--transform-lambda (cons args body) name)) - (form `(iter-defun ,name ,@(cdr res)))) - (if (car res) `(progn ,(car res) ,form) form))) + `(iter-defun ,name ,@(cl--transform-lambda (cons args body) name))) ;; The lambda list for macros is different from that of normal lambdas. ;; Note that &environment is only allowed as first or last items in the @@ -455,9 +450,7 @@ more details. (&define name cl-macro-list cl-declarations-or-string def-body)) (doc-string 3) (indent 2)) - (let* ((res (cl--transform-lambda (cons args body) name)) - (form `(defmacro ,name ,@(cdr res)))) - (if (car res) `(progn ,(car res) ,form) form))) + `(defmacro ,name ,@(cl--transform-lambda (cons args body) name))) (def-edebug-spec cl-lambda-expr (&define ("lambda" cl-lambda-list @@ -480,9 +473,7 @@ Like normal `function', except that if argument is a lambda form, its argument list allows full Common Lisp conventions." (declare (debug (&or symbolp cl-lambda-expr))) (if (eq (car-safe func) 'lambda) - (let* ((res (cl--transform-lambda (cdr func) 'cl-none)) - (form `(function (lambda . ,(cdr res))))) - (if (car res) `(progn ,(car res) ,form) form)) + `(function (lambda . ,(cl--transform-lambda (cdr func) 'cl-none))) `(function ,func))) (defun cl--make-usage-var (x) @@ -2111,10 +2102,9 @@ This is like `cl-flet', but for macros instead of functions. (if (null bindings) (macroexp-progn body) (let* ((name (caar bindings)) (res (cl--transform-lambda (cdar bindings) name))) - (eval (car res)) (macroexpand-all (macroexp-progn body) (cons (cons name - (eval `(cl-function (lambda ,@(cdr res))) t)) + (eval `(function (lambda ,@res)) t)) macroexpand-all-environment)))))) (defun cl--sm-macroexpand (orig-fun exp &optional env) commit 9900b145f91395c50e5a4206550696df38a33253 Author: Stefan Monnier Date: Tue Mar 10 12:12:06 2020 -0400 * lisp/window.el: Avoid `called-interactively-p`. (other-window, delete-other-windows, next-buffer, previous-buffer): Use an `interactive` arg instead. diff --git a/lisp/window.el b/lisp/window.el index 5824b1cb84..fc1e7d4a76 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -3911,7 +3911,7 @@ TOP RIGHT BOTTOM) as returned by `window-edges'." (setq frame (window-normalize-frame frame)) (window--subtree (frame-root-window frame) t)) -(defun other-window (count &optional all-frames) +(defun other-window (count &optional all-frames interactive) "Select another window in cyclic ordering of windows. COUNT specifies the number of windows to skip, starting with the selected window, before making the selection. If COUNT is @@ -3931,7 +3931,7 @@ This function uses `next-window' for finding the window to select. The argument ALL-FRAMES has the same meaning as in `next-window', but the MINIBUF argument of `next-window' is always effectively nil." - (interactive "p") + (interactive "p\ni\np") (let* ((window (selected-window)) (original-window window) (function (and (not ignore-window-parameters) @@ -3977,7 +3977,8 @@ always effectively nil." (setq count (1+ count))))) (when (and (eq window original-window) - (called-interactively-p 'interactive)) + interactive + (not (or executing-kbd-macro noninteractive))) (message "No other window to select")) (select-window window) @@ -4192,7 +4193,7 @@ that is its frame's root window." ;; Always return nil. nil)))) -(defun delete-other-windows (&optional window) +(defun delete-other-windows (&optional window interactive) "Make WINDOW fill its frame. WINDOW must be a valid window and defaults to the selected one. Return nil. @@ -4209,7 +4210,7 @@ with the root of the atomic window as its argument. Signal an error if that root window is the root window of WINDOW's frame. Also signal an error if WINDOW is a side window. Do not delete any window whose `no-delete-other-windows' parameter is non-nil." - (interactive) + (interactive "i\np") (setq window (window-normalize-window window)) (let* ((frame (window-frame window)) (function (window-parameter window 'delete-other-windows)) @@ -4275,7 +4276,8 @@ any window whose `no-delete-other-windows' parameter is non-nil." (if (eq window main) ;; Give a message to the user if this has been called as a ;; command. - (when (called-interactively-p 'interactive) + (when (and interactive + (not (or executing-kbd-macro noninteractive))) (message "No other windows to delete")) (delete-other-windows-internal window main) (window--check frame)) @@ -4838,11 +4840,11 @@ displayed there." (interactive) (switch-to-buffer (last-buffer))) -(defun next-buffer (&optional arg) +(defun next-buffer (&optional arg interactive) "In selected window switch to ARGth next buffer. Call `switch-to-next-buffer' unless the selected window is the minibuffer window or is dedicated to its buffer." - (interactive "p") + (interactive "p\np") (cond ((window-minibuffer-p) (user-error "Cannot switch buffers in minibuffer window")) @@ -4851,14 +4853,15 @@ minibuffer window or is dedicated to its buffer." (t (dotimes (_ (or arg 1)) (when (and (not (switch-to-next-buffer)) - (called-interactively-p 'interactive)) + interactive + (not (or executing-kbd-macro noninteractive))) (user-error "No next buffer")))))) -(defun previous-buffer (&optional arg) +(defun previous-buffer (&optional arg interactive) "In selected window switch to ARGth previous buffer. Call `switch-to-prev-buffer' unless the selected window is the minibuffer window or is dedicated to its buffer." - (interactive "p") + (interactive "p\np") (cond ((window-minibuffer-p) (user-error "Cannot switch buffers in minibuffer window")) @@ -4867,7 +4870,8 @@ minibuffer window or is dedicated to its buffer." (t (dotimes (_ (or arg 1)) (when (and (not (switch-to-prev-buffer)) - (called-interactively-p 'interactive)) + interactive + (not (or executing-kbd-macro noninteractive))) (user-error "No previous buffer")))))) (defun delete-windows-on (&optional buffer-or-name frame) commit 317065c1034c019498d60abcf362b8581054af10 Author: Stefan Monnier Date: Tue Mar 10 12:03:11 2020 -0400 * lisp/ido.el: Remove redundant `:group`s diff --git a/lisp/ido.el b/lisp/ido.el index 7198649e5a..81883402ad 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -243,7 +243,7 @@ ;; current frame are put at the end of the list. A hook exists to ;; allow other functions to order the list. For example, if you add: ;; -;; (add-hook 'ido-make-buffer-list-hook 'ido-summary-buffers-to-end) +;; (add-hook 'ido-make-buffer-list-hook #'ido-summary-buffers-to-end) ;; ;; then all files matching "Summary" are moved to the end of the ;; list. (I find this handy for keeping the INBOX Summary and so on @@ -356,7 +356,7 @@ Setting this variable directly does not take effect; use either \\[customize] or the function `ido-mode'." :set #'(lambda (_symbol value) (ido-mode value)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :require 'ido :link '(emacs-commentary-link "ido.el") :set-after '(ido-save-directory-list-file @@ -366,13 +366,11 @@ use either \\[customize] or the function `ido-mode'." :type '(choice (const :tag "Turn on only buffer" buffer) (const :tag "Turn on only file" file) (const :tag "Turn on both buffer and file" both) - (const :tag "Switch off all" nil)) - :group 'ido) + (const :tag "Switch off all" nil))) (defcustom ido-case-fold case-fold-search "Non-nil if searching of buffer and file names should ignore case." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-ignore-buffers '("\\` ") @@ -380,8 +378,7 @@ use either \\[customize] or the function `ido-mode'." For example, traditional behavior is not to list buffers whose names begin with a space, for which the regexp is `\\\\=` '. See the source file for example functions that filter buffer names." - :type '(repeat (choice regexp function)) - :group 'ido) + :type '(repeat (choice regexp function))) (defcustom ido-ignore-files '("\\`CVS/" "\\`#" "\\`.#" "\\`\\.\\./" "\\`\\./") @@ -389,19 +386,16 @@ example functions that filter buffer names." For example, traditional behavior is not to list files whose names begin with a #, for which the regexp is `\\\\=`#'. See the source file for example functions that filter filenames." - :type '(repeat (choice regexp function)) - :group 'ido) + :type '(repeat (choice regexp function))) (defcustom ido-ignore-extensions t "Non-nil means ignore files in `completion-ignored-extensions' list." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-show-dot-for-dired nil "Non-nil means to always put . as the first item in file name lists. This allows the current directory to be opened immediately with `dired'." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-file-extensions-order nil "List of file extensions specifying preferred order of file selections. @@ -409,21 +403,18 @@ Each element is either a string with `.' as the first char, an empty string matching files without extension, or t which is the default order for files with an unlisted file extension." :type '(repeat (choice string - (const :tag "Default order" t))) - :group 'ido) + (const :tag "Default order" t)))) (defcustom ido-ignore-directories '("\\`CVS/" "\\`\\.\\./" "\\`\\./") "List of regexps or functions matching sub-directory names to ignore." - :type '(repeat (choice regexp function)) - :group 'ido) + :type '(repeat (choice regexp function))) (defcustom ido-ignore-directories-merge nil "List of regexps or functions matching directory names to ignore during merge. Directory names matched by one of the regexps in this list are not inserted in merged file and directory lists." - :type '(repeat (choice regexp function)) - :group 'ido) + :type '(repeat (choice regexp function))) ;; Examples for setting the value of ido-ignore-buffers ;;(defun ido-ignore-c-mode (name) @@ -453,8 +444,7 @@ Possible values: (const :tag "Display (no select) in other window" display) (const :tag "Visit in other frame" other-frame) (const :tag "Ask to visit in other frame" maybe-frame) - (const :tag "Raise frame if already visited" raise-frame)) - :group 'ido) + (const :tag "Raise frame if already visited" raise-frame))) (defcustom ido-default-buffer-method 'raise-frame "How to switch to new buffer when using `ido-switch-buffer'. @@ -464,38 +454,33 @@ See `ido-default-file-method' for details." (const :tag "Display (no select) in other window" display) (const :tag "Show in other frame" other-frame) (const :tag "Ask to show in other frame" maybe-frame) - (const :tag "Raise frame if already shown" raise-frame)) - :group 'ido) + (const :tag "Raise frame if already shown" raise-frame))) (defcustom ido-enable-flex-matching nil "Non-nil means that Ido will do flexible string matching. Flexible matching means that if the entered string does not match any item, any item containing the entered characters in the given sequence will match." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-enable-regexp nil "Non-nil means that Ido will do regexp matching. Value can be toggled within Ido using `ido-toggle-regexp'." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-enable-prefix nil "Non-nil means only match if the entered text is a prefix of file name. This behavior is like the standard Emacs completion. If nil, match if the entered text is an arbitrary substring. Value can be toggled within Ido using `ido-toggle-prefix'." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-enable-dot-prefix nil "Non-nil means to match leading dot as prefix. I.e. hidden files and buffers will match only if you type a dot as first char even if `ido-enable-prefix' is nil." - :type 'boolean - :group 'ido) + :type 'boolean) ;; See https://debbugs.gnu.org/2042 for more info. (defcustom ido-buffer-disable-smart-matches t @@ -506,30 +491,26 @@ By default, Ido arranges matches in the following order: which can get in the way for buffer switching." :version "24.3" - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-confirm-unique-completion nil "Non-nil means that even a unique completion must be confirmed. This means that \\[ido-complete] must always be followed by \\[ido-exit-minibuffer] even when there is only one unique completion." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-cannot-complete-command 'ido-completion-help "Command run when `ido-complete' can't complete any more. The most useful values are `ido-completion-help', which pops up a window with completion alternatives, or `ido-next-match' or `ido-prev-match', which cycle the buffer list." - :type 'function - :group 'ido) + :type 'function) (defcustom ido-record-commands t "Non-nil means that Ido will record commands in command history. Note that the non-Ido equivalent command is recorded." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-max-prospects 12 "Upper limit of the prospect list if non-zero. @@ -537,8 +518,7 @@ Zero means no limit for the prospect list. For a long list of prospects, building the full list for the minibuffer can take a non-negligible amount of time; setting this variable reduces that time." - :type 'integer - :group 'ido) + :type 'integer) (defcustom ido-max-file-prompt-width 0.35 "Upper limit of the prompt string. @@ -550,8 +530,7 @@ the frame width." (integer :tag "Characters" :value 20) (restricted-sexp :tag "Fraction of frame width" :value 0.35 - :match-alternatives (ido-fractionp))) - :group 'ido) + :match-alternatives (ido-fractionp)))) (defcustom ido-max-window-height nil "Non-nil specifies a value to override `max-mini-window-height'." @@ -561,28 +540,24 @@ the frame width." (restricted-sexp :tag "Fraction of window height" :value 0.25 - :match-alternatives (ido-fractionp))) - :group 'ido) + :match-alternatives (ido-fractionp)))) (defcustom ido-enable-last-directory-history t "Non-nil means that Ido will remember latest selected directory names. See `ido-last-directory-list' and `ido-save-directory-list-file'." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-max-work-directory-list 50 "Maximum number of working directories to record. This is the list of directories where files have most recently been opened. See `ido-work-directory-list' and `ido-save-directory-list-file'." - :type 'integer - :group 'ido) + :type 'integer) (defcustom ido-work-directory-list-ignore-regexps nil "List of regexps matching directories which should not be recorded. Directory names matched by one of the regexps in this list are not inserted in the `ido-work-directory-list' list." - :type '(repeat regexp) - :group 'ido) + :type '(repeat regexp)) (defcustom ido-use-filename-at-point nil @@ -592,52 +567,44 @@ If found, use that as the starting point for filename selection." :type '(choice (const :tag "Disabled" nil) (const :tag "Guess filename" guess) - (other :tag "Use literal filename" t)) - :group 'ido) + (other :tag "Use literal filename" t))) (defcustom ido-use-url-at-point nil "Non-nil means that ido shall look for a URL at point. If found, call `find-file-at-point' to visit it." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-enable-tramp-completion t "Non-nil means that Ido shall perform tramp method and server name completion. A tramp file name uses the following syntax: /method:user@host:filename." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-record-ftp-work-directories t "Non-nil means record FTP file names in the work directory list." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-merge-ftp-work-directories nil "If nil, merging ignores FTP file names in the work directory list." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-cache-ftp-work-directory-time 1.0 "Maximum time to cache contents of an FTP directory (in hours). \\ Use \\[ido-reread-directory] in prompt to refresh list. If zero, FTP directories are not cached." - :type 'number - :group 'ido) + :type 'number) (defcustom ido-slow-ftp-hosts nil "List of slow FTP hosts where Ido prompting should not be used. If an FTP host is on this list, Ido automatically switches to the non-Ido equivalent function, e.g. `find-file' rather than `ido-find-file'." - :type '(repeat string) - :group 'ido) + :type '(repeat string)) (defcustom ido-slow-ftp-host-regexps nil "List of regexps matching slow FTP hosts (see `ido-slow-ftp-hosts')." - :type '(repeat regexp) - :group 'ido) + :type '(repeat regexp)) (defvar ido-unc-hosts-cache t "Cached value from the function `ido-unc-hosts'.") @@ -652,66 +619,56 @@ hosts on first use of UNC path." (function :tag "Your own function")) :set #'(lambda (symbol value) (set symbol value) - (setq ido-unc-hosts-cache t)) - :group 'ido) + (setq ido-unc-hosts-cache t))) (defcustom ido-downcase-unc-hosts t "Non-nil if UNC host names should be downcased." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-ignore-unc-host-regexps nil "List of regexps matching UNC hosts to ignore. Case is ignored if `ido-downcase-unc-hosts' is set." - :type '(repeat regexp) - :group 'ido) + :type '(repeat regexp)) (defcustom ido-cache-unc-host-shares-time 8.0 "Maximum time to cache shares of an UNC host (in hours). \\ Use \\[ido-reread-directory] in prompt to refresh list. If zero, UNC host shares are not cached." - :type 'number - :group 'ido) + :type 'number) (defcustom ido-max-work-file-list 10 "Maximum number of names of recently opened files to record. This is the list of the file names (sans directory) which have most recently been opened. See `ido-work-file-list' and `ido-save-directory-list-file'." - :type 'integer - :group 'ido) + :type 'integer) (defcustom ido-work-directory-match-only t "Non-nil means to skip non-matching directories in the directory history. When some text is already entered at the `ido-find-file' prompt, using \\[ido-prev-work-directory] or \\[ido-next-work-directory] will skip directories without any matching entries." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-auto-merge-work-directories-length 0 "Automatically switch to merged work directories during file name input. The value is number of characters to type before switching to merged mode. If zero, the switch happens when no matches are found in the current directory. Automatic merging is disabled if the value is negative." - :type 'integer - :group 'ido) + :type 'integer) (defcustom ido-auto-merge-delay-time 0.70 "Delay in seconds to wait for more input before doing auto merge." - :type 'number - :group 'ido) + :type 'number) (defcustom ido-auto-merge-inhibit-characters-regexp "[][*?~]" "Regexp matching characters which should inhibit automatic merging. When a (partial) file name matches this regexp, merging is inhibited." - :type 'regexp - :group 'ido) + :type 'regexp) (defcustom ido-merged-indicator "^" "The string appended to first choice if it has multiple directory choices." - :type 'string - :group 'ido) + :type 'string) (defcustom ido-max-dir-file-cache 100 "Maximum number of working directories to be cached. @@ -723,8 +680,7 @@ modification times, so you may choose to disable caching on such systems, or explicitly refresh the cache contents using the command `ido-reread-directory' command (\\[ido-reread-directory]) in the minibuffer. See also `ido-dir-file-cache' and `ido-save-directory-list-file'." - :type 'integer - :group 'ido) + :type 'integer) (defcustom ido-max-directory-size nil "Maximum size (in bytes) for directories to use Ido completion. @@ -732,21 +688,18 @@ See also `ido-dir-file-cache' and `ido-save-directory-list-file'." If you enter a directory with a size larger than this size, Ido will not provide the normal completion. To show the completions, use \\[ido-toggle-ignore]." :type '(choice (const :tag "No limit" nil) - (integer :tag "Size in bytes" 30000)) - :group 'ido) + (integer :tag "Size in bytes" 30000))) (defcustom ido-big-directories nil "List of directory pattern strings that should be considered big. Ido won't attempt to list the contents of directories matching any of these regular expressions when completing file names." :type '(repeat regexp) - :group 'ido :version "27.1") (defcustom ido-rotate-file-list-default nil "Non-nil means that Ido will always rotate file list to get default in front." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-enter-matching-directory 'only "Additional methods to enter sub-directory of first/only matching item. @@ -758,8 +711,7 @@ matching item, even without typing a slash." :type '(choice (const :tag "Never" nil) (const :tag "Slash enters first directory" first) (const :tag "Slash enters first and only directory" only) - (other :tag "Always enter unique directory" t)) - :group 'ido) + (other :tag "Always enter unique directory" t))) (defcustom ido-create-new-buffer 'prompt "Specify whether a new buffer is created if no buffer matches substring. @@ -767,21 +719,18 @@ Choices are `always' to create new buffers unconditionally, `prompt' to ask user whether to create buffer, or `never' to never create new buffer." :type '(choice (const always) (const prompt) - (const never)) - :group 'ido) + (const never))) (defcustom ido-setup-hook nil "Hook run after the Ido variables and keymap have been setup. The dynamic variable `ido-cur-item' contains the current type of item that is read by Ido; possible values are file, dir, buffer, and list. Additional keys can be defined in `ido-completion-map'." - :type 'hook - :group 'ido) + :type 'hook) (defcustom ido-separator nil "String used by Ido to separate the alternatives in the minibuffer." - :type '(choice string (const nil)) - :group 'ido) + :type '(choice string (const nil))) (make-obsolete-variable 'ido-separator "set 3rd element of `ido-decorations' instead." nil) @@ -802,8 +751,7 @@ can be completed using TAB, 11th element is displayed to confirm creating new file or buffer. 12th and 13th elements (if present) are used as brackets around the sole remaining completion. If absent, elements 5 and 6 are used instead." - :type '(repeat string) - :group 'ido) + :type '(repeat string)) (defcustom ido-use-virtual-buffers nil "If non-nil, refer to past (\"virtual\") buffers as well as existing ones. @@ -827,71 +775,60 @@ enabled if this variable is configured to a non-nil value." :version "24.1" :type '(choice (const :tag "Always" t) (const :tag "Automatic" auto) - (const :tag "Never" nil)) - :group 'ido) + (const :tag "Never" nil))) (defcustom ido-use-faces t "Non-nil means use Ido faces to highlighting first match, only match and subdirs in the alternatives." - :type 'boolean - :group 'ido) + :type 'boolean) (defface ido-first-match '((t :weight bold)) - "Face used by Ido for highlighting first match." - :group 'ido) + "Face used by Ido for highlighting first match.") (defface ido-only-match '((((class color)) :foreground "ForestGreen") (t :slant italic)) - "Face used by Ido for highlighting only match." - :group 'ido) + "Face used by Ido for highlighting only match.") (defface ido-subdir '((((min-colors 88) (class color)) :foreground "red1") (((class color)) :foreground "red") (t :underline t)) - "Face used by Ido for highlighting subdirs in the alternatives." - :group 'ido) + "Face used by Ido for highlighting subdirs in the alternatives.") (defface ido-virtual '((t :inherit font-lock-builtin-face)) "Face used by Ido for matching virtual buffer names." - :version "24.1" - :group 'ido) + :version "24.1") (defface ido-indicator '((((min-colors 88) (class color)) :foreground "yellow1" :background "red1" :width condensed) (((class color)) :foreground "yellow" :background "red" :width condensed) (t :inverse-video t)) - "Face used by Ido for highlighting its indicators." - :group 'ido) + "Face used by Ido for highlighting its indicators.") (defface ido-incomplete-regexp '((t :inherit font-lock-warning-face)) - "Ido face for indicating incomplete regexps." - :group 'ido) + "Ido face for indicating incomplete regexps.") (defcustom ido-make-file-list-hook nil "List of functions to run when the list of matching files is created. Each function on the list may modify the dynamically bound variable `ido-temp-list' which contains the current list of matching files." - :type 'hook - :group 'ido) + :type 'hook) (defcustom ido-make-dir-list-hook nil "List of functions to run when the list of matching directories is created. Each function on the list may modify the dynamically bound variable `ido-temp-list' which contains the current list of matching directories." - :type 'hook - :group 'ido) + :type 'hook) (defcustom ido-make-buffer-list-hook nil "List of functions to run when the list of matching buffers is created. Each function on the list may modify the dynamically bound variable `ido-temp-list' which contains the current list of matching buffer names." - :type 'hook - :group 'ido) + :type 'hook) (defcustom ido-rewrite-file-prompt-functions nil "List of functions to run when the find-file prompt is created. @@ -908,8 +845,7 @@ variables: The following variables are available, but should not be changed: `ido-current-directory' - the unabbreviated directory name item - equals `file' or `dir' depending on the current mode." - :type 'hook - :group 'ido) + :type 'hook) (defvar ido-rewrite-file-prompt-rules nil "Alist of rewriting rules for directory names in Ido prompts. @@ -924,14 +860,12 @@ also modify the dynamic variables described for the variable (defcustom ido-completion-buffer "*Ido Completions*" "Name of completion buffer used by Ido. Set to nil to disable completion buffers popping up." - :type 'string - :group 'ido) + :type 'string) (defcustom ido-completion-buffer-all-completions nil "Non-nil means to show all completions in completion buffer. Otherwise, only the current list of matches is shown." - :type 'boolean - :group 'ido) + :type 'boolean) (defcustom ido-all-frames 'visible "Argument to pass to `walk-windows' when Ido is finding buffers. @@ -939,8 +873,7 @@ See documentation of `walk-windows' for useful values." :type '(choice (const :tag "Selected frame only" nil) (const :tag "All existing frames" t) (const :tag "All visible frames" visible) - (const :tag "All frames on this terminal" 0)) - :group 'ido) + (const :tag "All frames on this terminal" 0))) (defcustom ido-minibuffer-setup-hook nil "Ido-specific customization of minibuffer setup. @@ -954,8 +887,7 @@ with other packages. For instance: will constrain Emacs to a maximum minibuffer height of 3 lines when Ido is running. Copied from `icomplete-minibuffer-setup-hook'." - :type 'hook - :group 'ido) + :type 'hook) (defcustom ido-save-directory-list-file (locate-user-emacs-file "ido.last" ".ido.last") @@ -964,28 +896,24 @@ Variables stored are: `ido-last-directory-list', `ido-work-directory-list', `ido-work-file-list', and `ido-dir-file-cache'. Must be set before enabling Ido mode." :version "24.4" ; added locate-user-emacs-file - :type 'string - :group 'ido) + :type 'string) (defcustom ido-read-file-name-as-directory-commands '() "List of commands which use `read-file-name' to read a directory name. When `ido-everywhere' is non-nil, the commands in this list will read the directory using `ido-read-directory-name'." - :type '(repeat symbol) - :group 'ido) + :type '(repeat symbol)) (defcustom ido-read-file-name-non-ido '() "List of commands which shall not read file names the Ido way. When `ido-everywhere' is non-nil, the commands in this list will read the file name using normal `read-file-name' style." - :type '(repeat symbol) - :group 'ido) + :type '(repeat symbol)) (defcustom ido-before-fallback-functions '() "List of functions to call before calling a fallback command. The fallback command is passed as an argument to the functions." - :type 'hook - :group 'ido) + :type 'hook) ;;;; Keymaps @@ -1071,10 +999,10 @@ The fallback command is passed as an argument to the functions." ;;;; Persistent variables -(defvar ido-file-history nil +(defvar ido-file-history nil "History of files selected using `ido-find-file'.") -(defvar ido-buffer-history nil +(defvar ido-buffer-history nil "History of buffers selected using `ido-switch-buffer'.") (defvar ido-last-directory-list nil @@ -1583,13 +1511,12 @@ Removes badly formatted data and ignored directories." (ido-save-history)) (defun ido-common-initialization () - (add-hook 'minibuffer-setup-hook 'ido-minibuffer-setup) - (add-hook 'choose-completion-string-functions 'ido-choose-completion-string)) + (add-hook 'minibuffer-setup-hook #'ido-minibuffer-setup) + (add-hook 'choose-completion-string-functions #'ido-choose-completion-string)) (define-minor-mode ido-everywhere "Toggle use of Ido for all buffer/file reading." :global t - :group 'ido (remove-function read-file-name-function #'ido-read-file-name) (remove-function read-buffer-function #'ido-read-buffer) (when ido-everywhere @@ -1625,7 +1552,7 @@ This function also adds a hook to the minibuffer." (ido-common-initialization) (ido-load-history) - (add-hook 'kill-emacs-hook 'ido-kill-emacs-hook) + (add-hook 'kill-emacs-hook #'ido-kill-emacs-hook) (let ((map (make-sparse-keymap))) (when (memq ido-mode '(file both)) @@ -2445,9 +2372,9 @@ If cursor is not at the end of the user input, move to end of input." nil ido-text 'ido-enter-insert-file)) ((eq ido-exit 'dired) - (funcall (cond ((eq method 'other-window) 'dired-other-window) - ((eq method 'other-frame) 'dired-other-frame) - (t 'dired)) + (funcall (cond ((eq method 'other-window) #'dired-other-window) + ((eq method 'other-frame) #'dired-other-frame) + (t #'dired)) (concat ido-current-directory (or ido-text "")))) ((eq ido-exit 'ffap) @@ -3598,7 +3525,7 @@ it is put to the start of the list." ;; tramp-ftp-file-name-p is available only when tramp ;; has been loaded. (fboundp 'tramp-ftp-file-name-p) - (funcall 'tramp-ftp-file-name-p dir) + (tramp-ftp-file-name-p dir) (string-match ":\\'" dir) (file-name-all-completions "" (concat dir "./")))))) (if (and compl @@ -3698,7 +3625,8 @@ in this list." (not (ido-local-file-exists-p x))) (and (not (ido-final-slash x)) (let (file-name-handler-alist) - (get-file-buffer x)))) x)) + (get-file-buffer x)))) + x)) ido-temp-list))))) (ido-to-end ;; move . files to end (delq nil (mapcar @@ -3731,7 +3659,8 @@ If MERGED is non-nil, each subdir is cons'ed with DIR." (delq nil (mapcar (lambda (name) - (and (ido-final-slash name) (not (ido-ignore-item-p name ido-ignore-directories)) + (and (ido-final-slash name) + (not (ido-ignore-item-p name ido-ignore-directories)) (if merged (cons name dir) name))) (ido-file-name-all-completions dir))))) @@ -4041,7 +3970,7 @@ If `ido-change-word-sub' cannot be found in WORD, return nil." (t (copy-sequence (or ido-matches ido-cur-list)))) #'ido-file-lessp))) - ;;(add-hook 'completion-setup-hook 'completion-setup-function) + ;;(add-hook 'completion-setup-hook #'completion-setup-function) (display-completion-list completion-list)))))) ;;; KILL CURRENT BUFFER @@ -4707,7 +4636,9 @@ For details of keybindings, see `ido-find-file'." (not (input-pending-p))) (ido-trace "\n*start timer*") (setq ido-auto-merge-timer - (run-with-timer ido-auto-merge-delay-time nil 'ido-initiate-auto-merge (current-buffer)))))) + (run-with-timer ido-auto-merge-delay-time nil + #'ido-initiate-auto-merge + (current-buffer)))))) (setq ido-rescan t) @@ -4830,8 +4761,8 @@ Modified from `icomplete-completions'." "Minibuffer setup hook for Ido." ;; Copied from `icomplete-minibuffer-setup-hook'. (when (ido-active) - (add-hook 'pre-command-hook 'ido-tidy nil t) - (add-hook 'post-command-hook 'ido-exhibit nil t) + (add-hook 'pre-command-hook #'ido-tidy nil t) + (add-hook 'post-command-hook #'ido-exhibit nil t) (run-hooks 'ido-minibuffer-setup-hook) (when ido-initial-position (goto-char (+ (minibuffer-prompt-end) ido-initial-position)) commit 297d3d2e0e17185387c47ad5a0ce4dd448ef7a29 Author: Stefan Monnier Date: Tue Mar 10 12:00:51 2020 -0400 * lisp/subr.el (dlet): New macro * lisp/calendar/calendar.el (calendar-dlet*): Use it. diff --git a/etc/NEWS b/etc/NEWS index 52ba1f6d35..87e634f2c1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -216,6 +216,8 @@ This is no longer supported, and setting this variable has no effect. * Lisp Changes in Emacs 28.1 +** New macro 'dlet' to dynamically bind variables + ** The variable 'force-new-style-backquotes' has been removed. This removes the final remaining trace of old-style backquotes. diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 1ae3944568..1d5b9479e2 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -136,14 +136,13 @@ ;; - whatever is passed to diary-remind (defmacro calendar-dlet* (binders &rest body) - "Like `let*' but using dynamic scoping." + "Like `dlet' but without warnings about non-prefixed var names." (declare (indent 1) (debug let)) - `(progn - (with-no-warnings ;Silence "lacks a prefix" warnings! - ,@(mapcar (lambda (binder) - `(defvar ,(if (consp binder) (car binder) binder))) - binders)) - (let* ,binders ,@body))) + (let ((vars (mapcar (lambda (binder) + (if (consp binder) (car binder) binder)) + binders))) + `(with-suppressed-warnings ((lexical ,@vars)) + (dlet ,binders ,@body)))) ;; Avoid recursive load of calendar when loading cal-menu. Yuck. (provide 'calendar) diff --git a/lisp/subr.el b/lisp/subr.el index 13515ca7da..359f51c0d0 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1777,6 +1777,21 @@ all symbols are bound before any of the VALUEFORMs are evalled." ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) ,@body)) +(defmacro dlet (binders &rest body) + "Like `let*' but using dynamic scoping." + (declare (indent 1) (debug let)) + ;; (defvar FOO) only affects the current scope, but in order for + ;; this not to affect code after the `let*' we need to create a new scope, + ;; which is what the surrounding `let' is for. + ;; FIXME: (let () ...) currently doesn't actually create a new scope, + ;; which is why we use (let (_) ...). + `(let (_) + ,@(mapcar (lambda (binder) + `(defvar ,(if (consp binder) (car binder) binder))) + binders) + (let* ,binders ,@body))) + + (defmacro with-wrapper-hook (hook args &rest body) "Run BODY, using wrapper functions from HOOK with additional ARGS. HOOK is an abnormal hook. Each hook function in HOOK \"wraps\" @@ -2972,13 +2987,14 @@ This finishes the change group by reverting all of its changes." ;; the body of `atomic-change-group' all changes can be undone. (widen) (let ((old-car (car-safe elt)) - (old-cdr (cdr-safe elt))) + (old-cdr (cdr-safe elt)) + (start-pul pending-undo-list)) (unwind-protect (progn ;; Temporarily truncate the undo log at ELT. (when (consp elt) (setcar elt nil) (setcdr elt nil)) - (unless (eq last-command 'undo) (undo-start)) + (setq pending-undo-list buffer-undo-list) ;; Make sure there's no confusion. (when (and (consp elt) (not (eq elt (last pending-undo-list)))) (error "Undoing to some unrelated state")) @@ -2991,7 +3007,13 @@ This finishes the change group by reverting all of its changes." ;; Reset the modified cons cell ELT to its original content. (when (consp elt) (setcar elt old-car) - (setcdr elt old-cdr)))))))) + (setcdr elt old-cdr))) + ;; Let's not break a sequence of undos just because we + ;; tried to make a change and then undid it: preserve + ;; the original `pending-undo-list' if it's still valid. + (if (eq (undo--last-change-was-undo-p buffer-undo-list) + start-pul) + (setq pending-undo-list start-pul))))))) ;;;; Display-related functions. @@ -3970,7 +3992,7 @@ the function `undo--wrap-and-run-primitive-undo'." (let (;; (inhibit-modification-hooks t) (before-change-functions ;; Ugly Hack: if the body uses syntax-ppss/syntax-propertize - ;; (e.g. via a regexp-search or sexp-movement trigerring + ;; (e.g. via a regexp-search or sexp-movement triggering ;; on-the-fly syntax-propertize), make sure that this gets ;; properly refreshed after subsequent changes. (if (memq #'syntax-ppss-flush-cache before-change-functions)