commit d22aacd930292e998df1225b2321b4213915cecf (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Sat Sep 10 08:20:31 2022 +0200 Make wdired match dired with symlink permissions * lisp/wdired.el (wdired-do-perm-changes): Do not follow symlinks, to be consistent with plain dired (bug#50189). diff --git a/lisp/wdired.el b/lisp/wdired.el index 33e0b96f0f..6904bac4d0 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -1024,7 +1024,8 @@ Like original function but it skips read-only words." (setq filename (wdired-get-filename nil t)) (if (= (length perms-new) 10) (condition-case nil - (set-file-modes filename (wdired-perms-to-number perms-new)) + (set-file-modes filename (wdired-perms-to-number perms-new) + 'nofollow) (error (setq errors (1+ errors)) (dired-log "Setting mode of `%s' to `%s' failed\n\n" commit 3062baf609baf49ea3742f224d522ca8d793cdb5 Author: Lars Ingebrigtsen Date: Sat Sep 10 08:13:21 2022 +0200 Make `format-prompt' use `substitute-command-keys' * doc/lispref/minibuf.texi (Text from Minibuffer): Mention it. * lisp/minibuffer.el (format-prompt): Run through `substitute-command-keys' (bug#51040). diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index f2adc01c8f..089ae41f32 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -490,6 +490,9 @@ If @var{default} is @code{nil}, there is no default value, and therefore no ``default value'' string is included in the result value. If @var{default} is a non-@code{nil} list, the first element of the list is used in the prompt. + +Both @var{prompt} and @code{minibuffer-default-prompt-format} are run +through @code{substitute-command-keys} (@pxref{Keys in Documentation}). @end defun @defvar read-minibuffer-restore-windows diff --git a/etc/NEWS b/etc/NEWS index ba2f57772c..2f52e9bc37 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2450,6 +2450,11 @@ when visiting JSON files. * Incompatible Lisp Changes in Emacs 29.1 ++++ +** 'format-prompt' now uses 'substitute-command-keys'. +This means that both the prompt and 'minibuffer-default-prompt-format' +will have key definitions and single quotes handled specially. + --- ** 'find-image' now uses 'create-image'. This means that images found through 'find-image' also have diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 3daab8a1e8..9dbada87cb 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4461,6 +4461,11 @@ FORMAT-ARGS is non-nil, PROMPT is used as a format control string, and FORMAT-ARGS are the arguments to be substituted into it. See `format' for details. +Both PROMTP and `minibuffer-default-prompt-format' are run +through `substitute-command-keys' (which see). In particular, +this means that single quotes may be adjusted for the current +terminal. + If DEFAULT is a list, the first element is used as the default. If not, the element is used as is. @@ -4468,12 +4473,12 @@ If DEFAULT is nil or an empty string, no \"default value\" string is included in the return value." (concat (if (null format-args) - prompt - (apply #'format prompt format-args)) + (substitute-command-keys prompt) + (apply #'format (substitute-command-keys prompt) format-args)) (and default (or (not (stringp default)) (length> default 0)) - (format minibuffer-default-prompt-format + (format (substitute-command-keys minibuffer-default-prompt-format) (if (consp default) (car default) default))) commit 0fd24ebc957ef4f64676a74e32959337f4f23610 Author: Lars Ingebrigtsen Date: Sat Sep 10 08:01:55 2022 +0200 Fix diff-mode.el compilation warnings * lisp/vc/diff-mode.el (diff-auto-refine-mode): Suppress byte-compile warnings. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 4b5c21973b..d9eb9bba60 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -279,20 +279,21 @@ and hunk-based syntax highlighting otherwise as a fallback." :doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'." (key-description diff-minor-mode-prefix) diff-mode-shared-map) -(define-minor-mode diff-auto-refine-mode - "Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode). +(with-suppressed-warnings ((obsolete diff-auto-refine-mode)) + (define-minor-mode diff-auto-refine-mode + "Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode). Diff Auto Refine mode is a buffer-local minor mode used with `diff-mode'. When enabled, Emacs automatically highlights changes in detail as the user visits hunks. When transitioning from disabled to enabled, it tries to refine the current hunk, as well." - :group 'diff-mode :init-value nil :lighter nil ;; " Auto-Refine" - (if diff-auto-refine-mode - (progn - (customize-set-variable 'diff-refine 'navigation) - (condition-case-unless-debug nil (diff-refine-hunk) (error nil))) - (customize-set-variable 'diff-refine nil))) + :group 'diff-mode :init-value nil :lighter nil ;; " Auto-Refine" + (if diff-auto-refine-mode + (progn + (customize-set-variable 'diff-refine 'navigation) + (condition-case-unless-debug nil (diff-refine-hunk) (error nil))) + (customize-set-variable 'diff-refine nil)))) (make-obsolete 'diff-auto-refine-mode "set `diff-refine' instead." "27.1") (make-obsolete-variable 'diff-auto-refine-mode "set `diff-refine' instead." "27.1") commit 6cd9e586cc065f02d69c97b23163ec91ccc2b5dd Author: Stefan Kangas Date: Sat Sep 10 07:37:36 2022 +0200 New function substitute-quotes * lisp/help.el (substitute-quotes): New function. (Bug#51040) * doc/lispref/help.texi (Keys in Documentation): Document substitute-quotes. * test/lisp/help-tests.el (help-tests-substitute-quotes): New test. * lisp/cedet/srecode/srt-mode.el (srecode-macro-help): * lisp/cus-theme.el (describe-theme-1): * lisp/emacs-lisp/cl-extra.el (cl--describe-class): * lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor): * lisp/emacs-lisp/package.el (describe-package-1): * lisp/help-fns.el (help-fns--parent-mode, help-fns--var-risky) (help-fns--var-file-local, help-fns--var-bufferlocal) (describe-face): * lisp/help.el (substitute-command-keys): * lisp/progmodes/octave.el (octave-help): Use the new function instead of 'substitute-command-keys'. diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index ac284f745f..154a7abeb6 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -384,6 +384,11 @@ given a special face @code{help-key-binding}, but if the optional argument @var{no-face} is non-@code{nil}, the function doesn't add this face to the produced string. +@defun substitute-quotes string +This function works like @code{substitute-command-keys}, but only +replaces quote characters. +@end defun + @cindex advertised binding If a command has multiple bindings, this function normally uses the first one it finds. You can specify one particular key binding by diff --git a/etc/NEWS b/etc/NEWS index 35b74aa7de..ba2f57772c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -144,6 +144,11 @@ and then execute the rest of the script file as Emacs Lisp. When it reaches the end of the script, Emacs will exit with an exit code from the value of the final form. ++++ +** New function 'substitute-quotes'. +This function works like 'substitute-command-keys' but only +substitutes quote characters. + +++ ** Emacs now supports setting 'user-emacs-directory' via '--init-directory'. diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index 724a6e0a94..56b482e100 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -260,9 +260,9 @@ we can tell font lock about them.") (when (class-abstract-p C) (throw 'skip nil)) - (princ (substitute-command-keys "`")) + (princ (substitute-quotes "`")) (princ name) - (princ (substitute-command-keys "'")) + (princ (substitute-quotes "'")) (when (slot-exists-p C 'key) (when key (princ " - Character Key: ") diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 69ec837db8..90680ff68f 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -496,7 +496,7 @@ It includes all faces in list FACES." (princ (substitute-command-keys " in `")) (help-insert-xref-button (file-name-nondirectory fn) 'help-theme-def fn) - (princ (substitute-command-keys "'"))) + (princ (substitute-quotes "'"))) (princ ".\n") (if (custom-theme-p theme) (progn diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 607810ee14..7c7f027d77 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -772,7 +772,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (help-insert-xref-button (help-fns-short-filename location) 'cl-type-definition type location 'define-type) - (insert (substitute-command-keys "'"))) + (insert (substitute-quotes "'"))) (insert ".\n") ;; Parents. @@ -782,7 +782,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (insert " Inherits from ") (while (setq cur (pop pl)) (setq cur (cl--class-name cur)) - (insert (substitute-command-keys "`")) + (insert (substitute-quotes "`")) (help-insert-xref-button (symbol-name cur) 'cl-help-type cur) (insert (substitute-command-keys (if pl "', " "'")))) @@ -796,7 +796,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (when ch (insert " Children ") (while (setq cur (pop ch)) - (insert (substitute-command-keys "`")) + (insert (substitute-quotes "`")) (help-insert-xref-button (symbol-name cur) 'cl-help-type cur) (insert (substitute-command-keys (if ch "', " "'")))) @@ -815,10 +815,10 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (when generics (insert (propertize "Specialized Methods:\n\n" 'face 'bold)) (dolist (generic generics) - (insert (substitute-command-keys "`")) + (insert (substitute-quotes "`")) (help-insert-xref-button (symbol-name generic) 'help-function generic) - (insert (substitute-command-keys "'")) + (insert (substitute-quotes "'")) (pcase-dolist (`(,qualifiers ,args ,doc) (cl--generic-method-documentation generic type)) (insert (format " %s%S\n" qualifiers args) diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 5f67263f17..b599aabb7f 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -153,7 +153,7 @@ are not abstract." (help-insert-xref-button (help-fns-short-filename location) 'cl-type-definition ctr location 'define-type) - (insert (substitute-command-keys "'"))) + (insert (substitute-quotes "'"))) (insert ".\nCreates an object of class " (symbol-name ctr) ".") (goto-char (point-max)) (if (autoloadp def) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index ed23ee5f22..bf71447681 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2648,7 +2648,7 @@ Helper function for `describe-package'." "',\n shadowing a ") (propertize "built-in package" 'font-lock-face 'package-status-built-in)) - (insert (substitute-command-keys "'"))) + (insert (substitute-quotes "'"))) (if signed (insert ".") (insert " (unsigned).")) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index dac4a03cd9..d5b576de28 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -712,13 +712,13 @@ the C sources, too." (get function 'derived-mode-parent)))) (when parent-mode - (insert (substitute-command-keys " Parent mode: `")) + (insert (substitute-quotes " Parent mode: `")) (let ((beg (point))) (insert (format "%s" parent-mode)) (make-text-button beg (point) 'type 'help-function 'help-args (list parent-mode))) - (insert (substitute-command-keys "'.\n"))))) + (insert (substitute-quotes "'.\n"))))) (defun help-fns--obsolete (function) ;; Ignore lambda constructs, keyboard macros, etc. @@ -1559,7 +1559,7 @@ This cancels value editing without updating the value." (princ " This variable may be risky if used as a \ file-local variable.\n") (when (assq variable safe-local-variable-values) - (princ (substitute-command-keys + (princ (substitute-quotes " However, you have added it to \ `safe-local-variable-values'.\n"))))) @@ -1609,8 +1609,8 @@ variable.\n"))) (insert-text-button file 'type 'help-dir-local-var-def 'help-args (list variable file))) - (princ (substitute-command-keys "'.\n")))) - (princ (substitute-command-keys + (princ (substitute-quotes "'.\n")))) + (princ (substitute-quotes " This variable's value is file-local.\n"))))))) (add-hook 'help-fns-describe-variable-functions #'help-fns--var-watchpoints) @@ -1690,10 +1690,10 @@ variable.\n"))) ((not permanent-local)) ((bufferp locus) (princ - (substitute-command-keys + (substitute-quotes " This variable's buffer-local value is permanent.\n"))) (t - (princ (substitute-command-keys + (princ (substitute-quotes " This variable's value is permanent \ if it is given a local binding.\n")))))) @@ -1770,9 +1770,9 @@ If FRAME is omitted or nil, use the selected frame." (setq help-mode--current-data (list :symbol f)) (setq help-mode--current-data (list :symbol f :file file-name)) - (princ (substitute-command-keys "Defined in `")) + (princ (substitute-quotes "Defined in `")) (princ (help-fns-short-filename file-name)) - (princ (substitute-command-keys "'")) + (princ (substitute-quotes "'")) ;; Make a hyperlink to the library. (save-excursion (re-search-backward diff --git a/lisp/help.el b/lisp/help.el index 15ab3192ad..92b87cf799 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1260,9 +1260,9 @@ Otherwise, return a new string." (cond ((null this-keymap) (insert "\nUses keymap " - (substitute-command-keys "`") + (substitute-quotes "`") (symbol-name name) - (substitute-command-keys "'") + (substitute-quotes "'") ", which is not currently defined.\n") (unless generate-summary (setq keymap nil))) @@ -1291,6 +1291,18 @@ Otherwise, return a new string." (t (forward-char 1))))) (buffer-string))))) +(defun substitute-quotes (string) + "Substitute quote characters for display. +Each grave accent \\=` is replaced by left quote, and each +apostrophe \\=' is replaced by right quote. Left and right quote +characters are specified by `text-quoting-style'." + (cond ((eq (text-quoting-style) 'curve) + (string-replace "`" "‘" + (string-replace "'" "’" string))) + ((eq (text-quoting-style) 'straight) + (string-replace "`" "'" string)) + (t string))) + (defvar help--keymaps-seen nil) (defun describe-map-tree (startmap &optional partial shadow prefix title no-menu transl always-title mention-shadow diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 721dfa51ad..18b9899169 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -1722,12 +1722,12 @@ code line." (dir (file-name-directory (directory-file-name (file-name-directory file))))) (replace-match "" nil nil nil 1) - (insert (substitute-command-keys "`")) + (insert (substitute-quotes "`")) ;; Include the parent directory which may be regarded as ;; the category for the FN. (help-insert-xref-button (file-relative-name file dir) 'octave-help-file fn) - (insert (substitute-command-keys "'")))) + (insert (substitute-quotes "'")))) ;; Make 'See also' clickable. (with-syntax-table octave-mode-syntax-table (when (re-search-forward "^\\s-*See also:" nil t) diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 833c32ffb2..6f1dcfa5b6 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -200,25 +200,45 @@ M-g M-c switch-to-completions "\nUses keymap [`'‘]foobar-map['’], which is not currently defined.\n"))) (ert-deftest help-tests-substitute-command-keys/quotes () - (with-substitute-command-keys-test + (with-substitute-command-keys-test + (let ((text-quoting-style 'curve)) + (test "quotes ‘like this’" "quotes ‘like this’") + (test "`x'" "‘x’") + (test "`" "‘") + (test "'" "’") + (test "\\`" "\\‘")) + (let ((text-quoting-style 'straight)) + (test "quotes `like this'" "quotes 'like this'") + (test "`x'" "'x'") + (test "`" "'") + (test "'" "'") + (test "\\`" "\\'")) + (let ((text-quoting-style 'grave)) + (test "quotes `like this'" "quotes `like this'") + (test "`x'" "`x'") + (test "`" "`") + (test "'" "'") + (test "\\`" "\\`")))) + +(ert-deftest help-tests-substitute-quotes () (let ((text-quoting-style 'curve)) - (test "quotes ‘like this’" "quotes ‘like this’") - (test "`x'" "‘x’") - (test "`" "‘") - (test "'" "’") - (test "\\`" "\\‘")) + (should (string= (substitute-quotes "quotes ‘like this’") "quotes ‘like this’")) + (should (string= (substitute-quotes "`x'") "‘x’")) + (should (string= (substitute-quotes "`") "‘")) + (should (string= (substitute-quotes "'") "’")) + (should (string= (substitute-quotes "\\`") "\\‘"))) (let ((text-quoting-style 'straight)) - (test "quotes `like this'" "quotes 'like this'") - (test "`x'" "'x'") - (test "`" "'") - (test "'" "'") - (test "\\`" "\\'")) + (should (string= (substitute-quotes "quotes `like this'") "quotes 'like this'")) + (should (string= (substitute-quotes "`x'") "'x'")) + (should (string= (substitute-quotes "`") "'")) + (should (string= (substitute-quotes "'") "'")) + (should (string= (substitute-quotes "\\`") "\\'"))) (let ((text-quoting-style 'grave)) - (test "quotes `like this'" "quotes `like this'") - (test "`x'" "`x'") - (test "`" "`") - (test "'" "'") - (test "\\`" "\\`")))) + (should (string= (substitute-quotes "quotes `like this'") "quotes `like this'")) + (should (string= (substitute-quotes "`x'") "`x'")) + (should (string= (substitute-quotes "`") "`")) + (should (string= (substitute-quotes "'") "'")) + (should (string= (substitute-quotes "\\`") "\\`")))) (ert-deftest help-tests-substitute-command-keys/literals () (with-substitute-command-keys-test commit 54c3794899ef2d4d88812fb445b6e2acc85a2720 Author: Stefan Kangas Date: Sat Sep 10 07:29:48 2022 +0200 Doc fixes for 'text-quoting-style' * doc/lispref/help.texi (Keys in Documentation): Remove duplicate entry for 'text-quoting-style'. Document the function with the same name instead. * src/doc.c (Ftext_quoting_style): Doc fix: clarify the return values. (syms_of_doc) : Doc fix: clarify that you should not read the value of this variable directly; use Ftext_quoting_style instead (bug#51040). diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 463039c5a0..ac284f745f 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -374,25 +374,6 @@ as link in the @file{*Help*} buffer. @strong{Please note:} Each @samp{\} must be doubled when written in a string in Emacs Lisp. -@defopt text-quoting-style -@cindex curved quotes -@cindex curly quotes -The value of this variable is a symbol that specifies the style Emacs -should use for single quotes in the wording of help and messages. If -the variable's value is @code{curve}, the style is @t{‘like this’} -with curved single quotes. If the value is @code{straight}, the style -is @t{'like this'} with straight apostrophes. If the value is -@code{grave}, quotes are not translated and the style is @t{`like -this'} with grave accent and apostrophe, the standard style before -Emacs version 25. The default value @code{nil} acts like @code{curve} -if curved single quotes seem to be displayable, and like @code{grave} -otherwise. - -This option is useful on platforms that have problems with curved -quotes. You can customize it freely according to your personal -preference. -@end defopt - @defun substitute-command-keys string &optional no-face include-menus @vindex help-key-binding@r{ (face)} This function scans @var{string} for the above special sequences and @@ -505,6 +486,13 @@ quotes. You can customize it freely according to your personal preference. @end defopt +@defun text-quoting-style +You should not read the value of the variable +@code{text-quoting-style} directly. Instead, use this function with +the same name to dynamically compute the correct quoting style on the +current terminal in the @code{nil} case described above. +@end defun + @node Describing Characters @section Describing Characters for Help Messages @cindex describe characters and events diff --git a/src/doc.c b/src/doc.c index 34b80d03aa..d98d121ebd 100644 --- a/src/doc.c +++ b/src/doc.c @@ -643,7 +643,14 @@ default_to_grave_quoting_style (void) DEFUN ("text-quoting-style", Ftext_quoting_style, Stext_quoting_style, 0, 0, 0, doc: /* Return the current effective text quoting style. -See variable `text-quoting-style'. */) +If the variable `text-quoting-style' is `grave', `straight' or +`curve', just return that value. If it is nil (the default), return +`grave' if curved quotes cannot be displayed (for instance, on a +terminal with no support for these characters), otherwise return +`quote'. Any other value is treated as `grave'. + +Note that in contrast to the variable `text-quoting-style', this +function will never return nil. */) (void) { /* Use grave accent and apostrophe `like this'. */ @@ -694,7 +701,11 @@ The value should be one of these symbols: `grave': quote with grave accent and apostrophe \\=`like this\\='; i.e., do not alter the original quote marks. nil: like `curve' if curved single quotes are displayable, - and like `grave' otherwise. This is the default. */); + and like `grave' otherwise. This is the default. + +You should never read the value of this variable directly from a Lisp +program. Use the function `text-quoting-style' instead, as that will +compute the correct value for the current terminal in the nil case. */); Vtext_quoting_style = Qnil; DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag, commit ce4f354defd5f888dfc0bc8feba0396d734ee87f Author: Lars Ingebrigtsen Date: Sat Sep 10 06:52:39 2022 +0200 Make a flymake.texi code example more resilient * doc/misc/flymake.texi (An annotated example backend): Make the example code resilient wrt. narrowed buffers (bug#51437). diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index b4e7f3a41f..7406557623 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -801,6 +801,7 @@ Binding,,, elisp, The Emacs Lisp Reference Manual}) to be active. for type = (if (string-match "^warning" msg) :warning :error) + when (and beg end) collect (flymake-make-diagnostic source beg end commit 72daa8b95aff464e204cc9498b7bed8aecd05661 Author: Stefan Kangas Date: Sat Sep 10 05:29:54 2022 +0200 * src/w32image.c (w32_can_use_native_image_api): Fix comment. diff --git a/src/w32image.c b/src/w32image.c index da748b8dab..af10d2bd26 100644 --- a/src/w32image.c +++ b/src/w32image.c @@ -256,7 +256,7 @@ w32_can_use_native_image_api (Lisp_Object type) || EQ (type, Qbmp) || EQ (type, Qnative_image))) { - /* GDI+ can also display BMP, Exif, ICON, WMF, and EMF images. + /* GDI+ can also display Exif, ICON, WMF, and EMF images. But we don't yet support these in image.c. */ return false; } commit 1e021ac45b352bb99e14cc9b30fa1e73ad2c267f Author: Stefan Kangas Date: Sat Sep 10 05:03:58 2022 +0200 Support outline-minor-mode in emacs-authors-mode * lisp/textmodes/emacs-authors-mode.el (emacs-authors-mode): Support and enable outline-minor-mode. diff --git a/lisp/textmodes/emacs-authors-mode.el b/lisp/textmodes/emacs-authors-mode.el index 866822c103..3eba8e0e45 100644 --- a/lisp/textmodes/emacs-authors-mode.el +++ b/lisp/textmodes/emacs-authors-mode.el @@ -130,7 +130,20 @@ Provides some basic font locking and not much else." '(emacs-authors-mode-font-lock-keywords nil nil ((?_ . "w")))) (setq font-lock-multiline nil) (setq imenu-generic-expression emacs-authors-imenu-generic-expression) - (emacs-etc--hide-local-variables)) + (emacs-etc--hide-local-variables) + (setq-local outline-regexp (rx (+ (not (any ":\n"))) ": " + (or "changed" "co-wrote" "wrote") " ") + outline-minor-mode-cycle t + outline-level + (lambda () + (if (looking-at (rx bol + (or (or " " + (seq "and " (or "co-wrote" + "changed"))) + eol))) + 2 + 1))) + (outline-minor-mode)) (define-obsolete-face-alias 'etc-authors-default 'emacs-authors-default "29.1") (define-obsolete-face-alias 'etc-authors-author 'emacs-authors-author "29.1") commit 7008fa9fd95262032455bf397a1dc1c48b0c2758 Author: Po Lu Date: Sat Sep 10 09:39:14 2022 +0800 ; * src/alloc.c (check_pure_size): Fix last change. diff --git a/src/alloc.c b/src/alloc.c index 7183c9ffa8..419c5e558b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5368,7 +5368,7 @@ void check_pure_size (void) { if (pure_bytes_used_before_overflow) - message (("emacs:0:Pure Lisp storage overflow (approx. %"pD"d" + message (("emacs:0:Pure Lisp storage overflow (approx. %jd" " bytes needed)"), pure_bytes_used + pure_bytes_used_before_overflow); } commit a1f1072975cdb7b3f80d1d0e0030f2b28171d0ed Author: Po Lu Date: Sat Sep 10 09:35:49 2022 +0800 Fix several printfs for 32 bit systems * lib-src/emacsclient.c (main): Use right length modifier when printing uintmax_t. * src/alloc.c (check_pure_size): Use right length modifier when printing ptrdiff_t. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 88800b9b2e..425db8cfac 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -2161,7 +2161,7 @@ main (int argc, char **argv) if (timeout > 0) { /* Don't retry if we were given a --timeout flag. */ - fprintf (stderr, "\nServer not responding; timed out after %lu seconds", + fprintf (stderr, "\nServer not responding; timed out after %ju seconds", timeout); retry = false; } diff --git a/src/alloc.c b/src/alloc.c index 34bedac36b..7183c9ffa8 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5368,7 +5368,7 @@ void check_pure_size (void) { if (pure_bytes_used_before_overflow) - message (("emacs:0:Pure Lisp storage overflow (approx. %"pI"d" + message (("emacs:0:Pure Lisp storage overflow (approx. %"pD"d" " bytes needed)"), pure_bytes_used + pure_bytes_used_before_overflow); } commit e6dc0cf2d399c907f345e11eeaa4e5d08fc4d7b6 Author: Stefan Kangas Date: Fri Sep 9 23:51:05 2022 +0200 * lisp/subr.el (string-split): New alias for split-string. diff --git a/etc/NEWS b/etc/NEWS index 97a476ae08..35b74aa7de 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3679,6 +3679,8 @@ to preserve the old behavior, apply '(take N LIST)' returns the first N elements of LIST; 'ntake' does the same but works by modifying LIST destructively. +--- +** 'string-split' is now an alias for 'split-string'. * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/lisp/subr.el b/lisp/subr.el index f4b457556d..686189e69b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5204,6 +5204,8 @@ Modifies the match data; use `save-match-data' if necessary." (nreverse list))) +(defalias 'string-split #'split-string) + (defun combine-and-quote-strings (strings &optional separator) "Concatenate the STRINGS, adding the SEPARATOR (default \" \"). This tries to quote the strings to avoid ambiguity such that commit 3ddf1a920d267794fff8d311aead43525167bab4 Author: Stefan Kangas Date: Fri Sep 9 23:39:24 2022 +0200 Set vc-git-annotate-switches to "-w" in .dir-locals.el * .dir-locals.el: Set vc-git-annotate-switches to "-w". Ref: https://lists.gnu.org/r/emacs-devel/2022-09/msg00453.html diff --git a/.dir-locals.el b/.dir-locals.el index d0cbcdfd39..84617a7980 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -5,6 +5,7 @@ (sentence-end-double-space . t) (fill-column . 70) (emacs-lisp-docstring-fill-column . 65) + (vc-git-annotate-switches . "-w") (bug-reference-url-format . "https://debbugs.gnu.org/%s") (diff-add-log-use-relative-names . t))) (c-mode . ((c-file-style . "GNU") commit 1c1ff3bfd12161d14f791658e22481acf9549109 Author: Stefan Kangas Date: Fri Sep 9 23:56:24 2022 +0200 Accept "-w" as safe value for vc-git-annotate-switches * lisp/vc/vc-git.el (vc-git-annotate-switches-safe-p): New predicate function. (vc-git-annotate-switches): Use above new predicate function to check if it's :safe. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 9dfdd9e7b1..2941cc75be 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -119,6 +119,14 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (repeat :tag "Argument List" :value ("") string)) :version "23.1") +;;;###autoload +(defun vc-git-annotate-switches-safe-p (switches) + "Check if local value of `vc-git-annotate-switches' is safe. +Currently only \"-w\" (ignore whitespace) is considered safe, but +this list might be extended in the future." + ;; TODO: Probably most options are perfectly safe. + (equal switches "-w")) + (defcustom vc-git-annotate-switches nil "String or list of strings specifying switches for Git blame under VC. If nil, use the value of `vc-annotate-switches'. If t, use no switches." @@ -127,6 +135,7 @@ If nil, use the value of `vc-annotate-switches'. If t, use no switches." (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) :version "25.1") +;;;###autoload(put 'vc-git-annotate-switches 'safe-local-variable #'vc-git-annotate-switches-safe-p) (defcustom vc-git-log-switches nil "String or list of strings specifying switches for Git log under VC." commit fa993926181f8c607fbb1e86c3fe1f7e7bacf5e9 Author: Paul Eggert Date: Fri Sep 9 15:22:16 2022 -0500 Fix problem with Glib 2.73.2+ and SIGCHLD handler This code fix is by Stefan Monnier (Bug#57699). * src/process.c (init_process_emacs) [HAVE_GLIB && !WINDOWSNT]: Adjust to Glib 2.73.2 behavior change on Linux kernel 5.3+. diff --git a/src/process.c b/src/process.c index 7a133cda00..358899cded 100644 --- a/src/process.c +++ b/src/process.c @@ -7391,7 +7391,8 @@ child_signal_notify (void) } /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing - its own SIGCHLD handling. On POSIXish systems, glib needs this to + its own SIGCHLD handling. On POSIXish systems lacking + pidfd_open+waitid or using Glib 2.73.1-, Glib needs this to keep track of its own children. GNUstep is similar. */ static void dummy_handler (int sig) {} @@ -8358,7 +8359,7 @@ DEFUN ("signal-names", Fsignal_names, Ssignal_names, 0, 0, 0, #ifdef subprocesses /* Arrange to catch SIGCHLD if this hasn't already been arranged. - Invoke this after init_process_emacs, and after glib and/or GNUstep + Invoke this after init_process_emacs, and after Glib and/or GNUstep futz with the SIGCHLD handler, but before Emacs forks any children. This function's caller should block SIGCHLD. */ @@ -8423,26 +8424,35 @@ init_process_emacs (int sockfd) if (!will_dump_with_unexec_p ()) { #if defined HAVE_GLIB && !defined WINDOWSNT - /* Tickle glib's child-handling code. Ask glib to install a + /* Tickle Glib's child-handling code. Ask Glib to install a watch source for Emacs itself which will initialize glib's private SIGCHLD handler, allowing catch_child_signal to copy - it into lib_child_handler. + it into lib_child_handler. This is a hacky workaround to get + glib's g_unix_signal_handler into lib_child_handler. - Unfortunately in glib commit 2e471acf, the behavior changed to + In Glib 2.37.5 (2013), commit 2e471acf changed Glib to always install a signal handler when g_child_watch_source_new - is called and not just the first time it's called. Glib also - now resets signal handlers to SIG_DFL when it no longer has a - watcher on that signal. This is a hackey work around to get - glib's g_unix_signal_handler into lib_child_handler. */ + is called and not just the first time it's called, and to + reset signal handlers to SIG_DFL when it no longer has a + watcher on that signal. Arrange for Emacs's signal handler + to be reinstalled even if this happens. + + In Glib 2.73.2 (2022), commit f615eef4 changed Glib again, + to not install a signal handler if the system supports + pidfd_open and waitid (as in Linux kernel 5.3+). The hacky + workaround is not needed in this case. */ GSource *source = g_child_watch_source_new (getpid ()); catch_child_signal (); g_source_unref (source); - eassert (lib_child_handler != dummy_handler); - signal_handler_t lib_child_handler_glib = lib_child_handler; - catch_child_signal (); - eassert (lib_child_handler == dummy_handler); - lib_child_handler = lib_child_handler_glib; + if (lib_child_handler != dummy_handler) + { + /* The hacky workaround is needed on this platform. */ + signal_handler_t lib_child_handler_glib = lib_child_handler; + catch_child_signal (); + eassert (lib_child_handler == dummy_handler); + lib_child_handler = lib_child_handler_glib; + } #else catch_child_signal (); #endif commit 9189ad45612141cc9db5c3e98de5e44e07e6f9b0 Author: Eli Zaretskii Date: Fri Sep 9 22:10:00 2022 +0300 ; Fix doc strings in shell.el * lisp/shell.el (shell-highlight-undef-defined-face) (shell-highlight-undef-remote-file-name-inhibit-cache) (shell--highlight-undef-exec-cache): Fix wording and typos. diff --git a/lisp/shell.el b/lisp/shell.el index b65792e10a..eccac66376 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1553,7 +1553,7 @@ Returns t if successful." (defface shell-highlight-undef-defined-face '((t :inherit 'font-lock-function-name-face)) - "Face used for existent shell commands." + "Face used for existing shell commands." :group 'shell :version "29.1") @@ -1570,12 +1570,12 @@ Returns t if successful." :version "29.1") (defcustom shell-highlight-undef-remote-file-name-inhibit-cache nil - "Whether to use cache to determine fontification a shell command. -When fontification of non-existent commands is enabled on a -remote shell buffer, use cache to speed up searching for + "Whether to inhibit cache for fontifying shell commands in remote buffers. +When fontification of non-existent commands is enabled in a +remote shell buffer, use a cache to speed up searching for executable files on the remote machine. This options is used to -control expiry of this cache. See -`remote-file-name-inhibit-cache' for description." +control expiry of this cache. See `remote-file-name-inhibit-cache' +for description." :group 'faces :type '(choice (const :tag "Do not inhibit file name cache" nil) @@ -1589,7 +1589,7 @@ control expiry of this cache. See "Cache of executable files found in `exec-path'. An alist, whose elements are of the form \(REMOTE TIME EXECUTABLES), where REMOTE is a string, returned by -`file-remote-p', TIME is the return value of `float-time' end +`file-remote-p', TIME is the return value of `float-time', and EXECUTABLES is a hash table with keys being the base-names of executable files. commit 3b105e978c42973fb5810a74681f263889fc23c0 Author: Miha Rihtaršič Date: Fri Sep 9 20:13:13 2022 +0200 Input indentation for M-x shell * lisp/comint.el (comint-indent-input-line): (comint-indent-input-line-default): (comint-indent-input-region): (comint-indent-input-region-default): New functions that implement a general mechanism for input indentation through an indirect buffer in comint derived major modes. * lisp/shell.el (shell-mode): Set up input indentation according to sh-mode (bug#51940). diff --git a/lisp/comint.el b/lisp/comint.el index 4fcfb500e1..751e561d3e 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -4012,21 +4012,21 @@ This function is intended to be included as an entry of (cons (point-marker) (match-string-no-properties 1 text))))) -;;; Input fontification through an indirect buffer +;;; Input fontification and indentation through an indirect buffer ;;============================================================================ ;; -;; Modes derived from `comint-mode' can set up fontification input -;; text with the help of an indirect buffer whose major mode and -;; font-lock settings are set accordingly. +;; Modes derived from `comint-mode' can set up fontification and +;; indentation of input text with the help of an indirect buffer whose +;; major mode and font-lock settings are set accordingly. (defvar-local comint-indirect-setup-function nil "Function to set up an indirect comint fontification buffer. This function is called by `comint-indirect-buffer' with zero arguments after making an indirect buffer. It is usually set to -a major-mode command whose font-locking is desired for input -text. In order to prevent possible mode hooks from running, the -variable `delay-mode-hooks' is set to t prior to calling this -function and `change-major-mode-hook' along with +a major-mode command whose font-locking and indentation are +desired for input text. In order to prevent possible mode hooks +from running, the variable `delay-mode-hooks' is set to t prior +to calling this function and `change-major-mode-hook' along with `after-change-major-mode-hook' are bound to nil.") (defcustom comint-indirect-setup-hook nil @@ -4191,6 +4191,83 @@ function called, or nil, if no function was called (if BEG = END)." (when return-beg (cons (car return-beg) (car return-end))))) +(defun comint-indent-input-line (fun) + "Indent current line from comint process output or input. +If point is on output, call FUN, otherwise indent the current +line in the indirect buffer created by `comint-indirect-buffer', +which see." + (if (or comint-use-prompt-regexp + (eq (get-text-property (point) 'field) 'output)) + (funcall fun) + (let ((point (point)) + (min (point-min)) + (max (point-max))) + (unwind-protect + (with-current-buffer (comint-indirect-buffer) + (narrow-to-region min max) + (goto-char point) + (narrow-to-region (field-beginning) (field-end)) + (unwind-protect (funcall indent-line-function) + (setq point (point)))) + (goto-char point))))) + +(defun comint-indent-input-region (fun start end) + "Indent comint process output and input between START and END. +Output text between START and END is indented with FUN and input +text is indented in the indirect buffer created by +`comint-indirect-buffer', which see." + (if comint-use-prompt-regexp + (funcall fun start end) + (let ((opoint (copy-marker (point))) + final-point) + (unwind-protect + (comint--intersect-regions + (lambda (start end) + (goto-char opoint) + (if (= opoint (point)) + (unwind-protect (funcall fun start end) + (setq final-point (copy-marker (point)))) + (funcall fun start end))) + (lambda (start end) + (let ((min (point-min)) + (max (point-max)) + (final-point1 nil)) + (unwind-protect + (with-current-buffer (comint-indirect-buffer) + (narrow-to-region min max) + (goto-char opoint) + (if (= opoint (point)) + (unwind-protect + (funcall indent-region-function start end) + (setq final-point1 (point))) + (funcall indent-region-function start end))) + (when final-point1 + (setq final-point (copy-marker final-point1)))))) + start end) + (if final-point + (progn + (goto-char final-point) + (set-marker final-point nil)) + (goto-char opoint)) + (set-marker opoint nil))))) + +(defun comint-indent-input-line-default () + "Indent current line from comint process output or input. +If point is on output, indent the current line according to the +default value of `indent-line-function', otherwise indent the +current line in the indirect buffer created by +`comint-indirect-buffer', which see." + (comint-indent-input-line (default-value 'indent-line-function))) + +(defun comint-indent-input-region-default (start end) + "Indent comint process output and input between START and END. +Output text between START and END is indented according to the +default value of `indent-region-function' and input text is +indented in the indirect buffer created by +`comint-indirect-buffer', which see." + (comint-indent-input-region (default-value 'indent-line-function) + start end)) + (defun comint-indirect-buffer (&optional no-create) "Return an indirect comint fontification buffer. If an indirect buffer for the current buffer already exists, diff --git a/lisp/shell.el b/lisp/shell.el index e8ae1c9738..b65792e10a 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -653,6 +653,10 @@ command." (message-log-max nil)) (sh-mode))))) + (setq-local indent-line-function #'comint-indent-input-line-default) + (setq-local indent-region-function + #'comint-indent-input-region-default) + ;; This is not really correct, since the shell buffer does not really ;; edit this directory. But it is useful in the buffer list and menus. (setq list-buffers-directory (expand-file-name default-directory)) commit c7ebe5a798c3b5663d37212cc2de0a8589d2bbf3 Author: Miha Rihtaršič Date: Fri Sep 9 20:12:26 2022 +0200 Highlight non-existent commands in M-x shell * lisp/shell.el (shell-mode): Enable highlighting of non-existent commands if requested. (shell-highlight-undef-aliases): (shell-highlight-undef-remote-file-name-inhibit-cache): New user options. (shell-highlight-undef-mode): New minor mode. (shell-highlight-undef-defined-face): (shell-highlight-undef-undefined-face): (shell-highlight-undef-alias-face): New faces. (shell-highlight-undef--exec-cache): (shell-highlight-undef--face): (shell-highlight-undef-keywords): (shell-highlight-undef-regexp): (shell-highlight-undef--executable-find): (shell-highlight-undef-matcher): (shell-highlight-undef--indirect): (shell-highlight--setup): (shell-highlight-undef-reset-mode): New functions and buffer local variables (bug#51940). diff --git a/lisp/shell.el b/lisp/shell.el index 4b11b0ac59..e8ae1c9738 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -324,6 +324,16 @@ command `comint-fl-mode' to toggle highlighting of input." :safe 'booleanp :version "29.1") +(defcustom shell-highlight-undef-enable nil + "Enable highlighting of undefined commands in shell buffers. +This variable only has effect when the shell is started. Use the +command `shell-highlight-undef-mode' to toggle highlighting of +undefined commands." + :type 'boolean + :group 'shell + :safe 'booleanp + :version "29.1") + (defvar shell-dirstack nil "List of directories saved by pushd in this buffer's shell. Thus, this does not include the shell's current directory.") @@ -605,9 +615,11 @@ whenever it receives the bell character in output from a command." :interactive nil :after-hook - (and (null comint-use-prompt-regexp) - shell-comint-fl-enable - (comint-fl-mode)) + (unless comint-use-prompt-regexp + (if shell-comint-fl-enable + (comint-fl-mode)) + (if shell-highlight-undef-enable + (shell-highlight-undef-mode))) (setq comint-prompt-regexp shell-prompt-pattern) (shell-completion-vars) @@ -1523,6 +1535,218 @@ Returns t if successful." ;; Remove the prompt. (replace-regexp-in-string "\n.*\\'" "\n" result))) +;;; Highlight undefined commands +;; +;; To highlight non-existent shell commands, customize +;; `shell-highlight-undef-enable' to t. To highlight some shell +;; commands as aliases, add them to `shell-highlight-undef-aliases'. + +(defcustom shell-highlight-undef-aliases nil + "List of shell commands to highlight as a command alias." + :group 'shell + :type '(repeat string) + :version "29.1") + +(defface shell-highlight-undef-defined-face + '((t :inherit 'font-lock-function-name-face)) + "Face used for existent shell commands." + :group 'shell + :version "29.1") + +(defface shell-highlight-undef-undefined-face + '((t :inherit 'font-lock-warning-face)) + "Face used for non-existent shell commands." + :group 'shell + :version "29.1") + +(defface shell-highlight-undef-alias-face + '((t :inherit 'font-lock-variable-name-face)) + "Face used for shell command aliases." + :group 'shell + :version "29.1") + +(defcustom shell-highlight-undef-remote-file-name-inhibit-cache nil + "Whether to use cache to determine fontification a shell command. +When fontification of non-existent commands is enabled on a +remote shell buffer, use cache to speed up searching for +executable files on the remote machine. This options is used to +control expiry of this cache. See +`remote-file-name-inhibit-cache' for description." + :group 'faces + :type '(choice + (const :tag "Do not inhibit file name cache" nil) + (const :tag "Do not use file name cache" t) + (integer :tag "Do not use file name cache" + :format "Do not use file name cache older than %v seconds" + :value 10)) + :version "29.1") + +(defvar shell--highlight-undef-exec-cache nil + "Cache of executable files found in `exec-path'. +An alist, whose elements are of the form +\(REMOTE TIME EXECUTABLES), where REMOTE is a string, returned by +`file-remote-p', TIME is the return value of `float-time' end +EXECUTABLES is a hash table with keys being the base-names of +executable files. + +Cache expiry is controlled by the user option +`remote-file-name-inhibit-cache'.") + +(defvar shell--highlight-undef-face 'shell-highlight-undef-defined-face) + +(defvar shell-highlight-undef-keywords + `((,#'shell-highlight-undef-matcher 6 shell--highlight-undef-face))) + +(defvar-local shell-highlight-undef-regexp regexp-unmatchable) + +(defun shell--highlight-undef-executable-find (command) + "Return non-nil if COMMAND is found in `exec-path'. +Similar to `executable-find', but use cache stored in +`shell--highlight-undef-exec-cache'." + (let ((remote (file-remote-p default-directory)) + as ret found-in-cache delta-time) + (if (null remote) + (executable-find command) + + (setq delta-time + shell-highlight-undef-remote-file-name-inhibit-cache) + + (pcase (setq as (assoc remote shell--highlight-undef-exec-cache)) + (`(,_ ,time ,hash) + (when (pcase delta-time + ((pred numberp) (<= (float-time) (+ time delta-time))) + ('t nil) + ('nil t)) + (setq ret (gethash command hash)) + (setq found-in-cache t))) + (_ (setq as (list remote 0 (make-hash-table :test #'equal))) + (push as shell--highlight-undef-exec-cache))) + + (if found-in-cache + ret + ;; Build cache + (setcar (cdr as) (float-time)) + (let ((hash (clrhash (caddr as)))) + (dolist (dir (exec-path)) + (pcase-dolist (`(,f . ,attr) + (condition-case nil + (directory-files-and-attributes + (concat remote dir) nil nil 'nosort 'integer) + (file-error nil))) + ;; Approximation. Assume every non-directory file in $PATH is an + ;; executable. Alternatively, we could check + ;; `file-executable-p', but doing so for every file in $PATH is + ;; slow on remote machines. + (unless (eq t (file-attribute-type attr)) + (puthash f t hash)))) + (gethash command hash)))))) + +(defun shell-highlight-undef-matcher (end) + "Matcher used to highlight shell commands up to END." + (when (re-search-forward shell-highlight-undef-regexp end t) + (save-match-data + (let ((cmd (match-string 6)) + (beg (match-beginning 6))) + (setq shell--highlight-undef-face + (let* ((buf (buffer-base-buffer)) + (default-directory + (if buf (buffer-local-value 'default-directory buf) + default-directory))) + (cond + ;; Don't highlight command output. Mostly useful if + ;; `comint-fl-mode' is disabled. + ((text-property-any beg (point) 'field 'output) + nil) + ((member cmd shell-highlight-undef-aliases) + 'shell-highlight-undef-alias-face) + ;; Check if it contains a directory separator + ((file-name-directory cmd) + (when (file-name-absolute-p cmd) + (setq cmd (concat + (or (bound-and-true-p comint-file-name-prefix) + (file-remote-p default-directory)) + cmd))) + (if (or (file-executable-p cmd) + (file-directory-p cmd)) + 'shell-highlight-undef-defined-face + 'shell-highlight-undef-undefined-face)) + ((shell--highlight-undef-executable-find cmd) + 'shell-highlight-undef-defined-face) + (t 'shell-highlight-undef-undefined-face)))))) + t)) + +(defvar-local shell--highlight-undef-indirect nil + "t if shell commands are fontified in `comint-indirect-buffer'.") + +(declare-function sh-feature "sh-script" (alist &optional function)) +(defvar sh-leading-keywords) +(defvar sh-other-keywords) + +(define-minor-mode shell-highlight-undef-mode + "Highlight undefined shell commands and aliases. +This minor mode is mostly useful in `shell-mode' buffers and +works better if `comint-fl-mode' is enabled." + :init-value nil + (if shell--highlight-undef-indirect + (progn + (remove-hook 'comint-indirect-setup-hook shell--highlight-undef-indirect t) + (setq shell--highlight-undef-indirect nil) + (when-let ((buf (comint-indirect-buffer t))) + (with-current-buffer buf + (font-lock-remove-keywords nil shell-highlight-undef-keywords)))) + (font-lock-remove-keywords nil shell-highlight-undef-keywords)) + (remove-hook 'comint-fl-mode-hook + #'shell-highlight-undef-reset-mode t) + + (when shell-highlight-undef-mode + (when comint-use-prompt-regexp + (setq shell-highlight-undef-mode nil) + (error + "`shell-highlight-undef-mode' is incompatible with `comint-use-prompt-regexp'")) + + (require 'sh-script) + + (let* ((regexp + ;; Adapted from `sh-font-lock-keywords-1' + (concat + "\\(" + "[;(){}`|&]" + (if comint-fl-mode + ;; `comint-fl-mode' already puts point-min on end of + ;; prompt + "" + (concat "\\|" comint-prompt-regexp)) + "\\|^" + "\\)" + "[ \t]*\\(\\(" + (regexp-opt (sh-feature sh-leading-keywords) t) + "[ \t]+\\)?" + (regexp-opt (append (sh-feature sh-leading-keywords) + (sh-feature sh-other-keywords)) + t) + "[ \t]+\\)?\\_<\\(\\(?:\\s_\\|\\sw\\|/\\)+\\)\\_>")) + (setup + (lambda () + (setq shell-highlight-undef-regexp regexp) + (font-lock-add-keywords nil shell-highlight-undef-keywords t)))) + (cond (comint-fl-mode + (setq shell--highlight-undef-indirect setup) + (if-let ((buf (comint-indirect-buffer t))) + (with-current-buffer buf + (funcall setup)) + (add-hook 'comint-indirect-setup-hook setup nil t))) + (t (funcall setup)))) + + (add-hook 'comint-fl-mode-hook + #'shell-highlight-undef-reset-mode nil t)) + + (font-lock-flush)) + +(defun shell-highlight-undef-reset-mode () + "If `shell-highlight-undef-mode' is on, turn it off and on." + (when shell-highlight-undef-mode + (shell-highlight-undef-mode 1))) + (provide 'shell) ;;; shell.el ends here commit e9ecde5b1dd93c356ba513d320124869078cb03a Author: Miha Rihtaršič Date: Fri Sep 9 20:11:33 2022 +0200 Input fontification for M-x ielm * lisp/ielm.el (ielm-comint-fl-enable): New user option to control input fontification. (ielm-indirect-setup-hook): New hook. (inferior-emacs-lisp-mode): Set up and enable input fontification. diff --git a/lisp/ielm.el b/lisp/ielm.el index 47c1792118..211804210c 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -472,6 +472,27 @@ nonempty, then flushes the buffer." ;; Set the process mark in the current buffer to POS. (set-marker (process-mark (get-buffer-process (current-buffer))) pos)) +;;; Input fontification + +(defcustom ielm-comint-fl-enable t + "Enable highlighting of input in ielm buffers. +This variable only has effect when creating an ielm buffer. Use +the command `comint-fl-mode' to toggle highlighting of input in +an already existing ielm buffer." + :type 'boolean + :safe 'booleanp + :version "29.1") + +(defcustom ielm-indirect-setup-hook nil + "Hook run after setting up an indirect ielm fontification buffer." + :type 'boolean + :safe 'booleanp + :version "29.1") + +(defun ielm-indirect-setup-hook () + "Run `ielm-indirect-setup-hook'." + (run-hooks 'ielm-indirect-setup-hook)) + ;;; Major mode (define-derived-mode inferior-emacs-lisp-mode comint-mode "IELM" @@ -526,6 +547,10 @@ The behavior of IELM may be customized with the following variables: Customized bindings may be defined in `ielm-map', which currently contains: \\{ielm-map}" :syntax-table emacs-lisp-mode-syntax-table + :after-hook + (and (null comint-use-prompt-regexp) + ielm-comint-fl-enable + (comint-fl-mode)) (setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt))) (setq-local paragraph-separate "\\'") @@ -564,6 +589,10 @@ Customized bindings may be defined in `ielm-map', which currently contains: (setq-local font-lock-defaults '(ielm-font-lock-keywords nil nil ((?: . "w") (?- . "w") (?* . "w")))) + (add-hook 'comint-indirect-setup-hook + #'ielm-indirect-setup-hook 'append t) + (setq comint-indirect-setup-function #'emacs-lisp-mode) + ;; A dummy process to keep comint happy. It will never get any input (unless (comint-check-proc (current-buffer)) ;; Was cat, but on non-Unix platforms that might not exist, so commit 5a8a5e3d5782e9e138a826e1ce9c06fe501c5343 Author: Miha Rihtaršič Date: Fri Sep 9 20:10:01 2022 +0200 Input fontification for M-x shell * lisp/comint.el (comint-indent-input-line): (comint-indent-input-line-default): (comint-indent-input-region): (comint-indent-input-region-default): New functions that implement a general mechanism for input indentation through an indirect buffer in comint derived major modes. * lisp/shell.el (shell-mode): Set up input indentation according to sh-mode (bug#51940). * lisp/comint.el (comint-indent-input-line): (comint-indent-input-line-default): (comint-indent-input-region): (comint-indent-input-region-default): New functions that implement a general mechanism for input indentation through an indirect buffer in comint derived major modes. * lisp/shell.el (shell-mode): Set up input indentation according to sh-mode (bug#51940). diff --git a/lisp/shell.el b/lisp/shell.el index 85225b128a..4b11b0ac59 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -99,6 +99,7 @@ (require 'pcomplete) (eval-when-compile (require 'files-x)) ;with-connection-local-variables (require 'subr-x) +(eval-when-compile (require 'cl-lib)) ;;; Customization and Buffer Variables @@ -307,6 +308,22 @@ for Shell mode only." (const :tag "on" t)) :group 'shell) +(defcustom shell-comint-fl-enable t + "Enable highlighting of input in shell buffers. +This variable only has effect when the shell is started. Use the +command `comint-fl-mode' to toggle highlighting of input." + :type 'boolean + :group 'shell + :safe 'booleanp + :version "29.1") + +(defcustom shell-indirect-setup-hook nil + "Hook run after setting up an indirect shell fontification buffer." + :type 'boolean + :group 'shell + :safe 'booleanp + :version "29.1") + (defvar shell-dirstack nil "List of directories saved by pushd in this buffer's shell. Thus, this does not include the shell's current directory.") @@ -522,6 +539,8 @@ Shell buffers. It implements `shell-completion-execonly' for (put 'shell-mode 'mode-class 'special) +(defvar sh-shell-file) + (define-derived-mode shell-mode comint-mode "Shell" "Major mode for interacting with an inferior shell. \\ @@ -585,6 +604,11 @@ from `shell-mode-hook', Emacs will call the `ding' function whenever it receives the bell character in output from a command." :interactive nil + :after-hook + (and (null comint-use-prompt-regexp) + shell-comint-fl-enable + (comint-fl-mode)) + (setq comint-prompt-regexp shell-prompt-pattern) (shell-completion-vars) (setq-local paragraph-separate "\\'") @@ -604,6 +628,19 @@ command." (setq-local ansi-color-apply-face-function #'shell-apply-ansi-color) (shell-reapply-ansi-color) + (add-hook 'comint-indirect-setup-hook + #'shell-indirect-setup-hook 'append t) + (setq comint-indirect-setup-function + (let ((shell shell--start-prog)) + (lambda () + (require 'sh-script) + (cl-letf + (((default-value 'sh-shell-file) + (or shell sh-shell-file)) + (inhibit-message t) + (message-log-max nil)) + (sh-mode))))) + ;; This is not really correct, since the shell buffer does not really ;; edit this directory. But it is useful in the buffer list and menus. (setq list-buffers-directory (expand-file-name default-directory)) @@ -658,6 +695,10 @@ command." ": [[:digit:]]+:[[:digit:]]+;"))) (comint-read-input-ring t))) +(defun shell-indirect-setup-hook () + "Run `shell-indirect-setup-hook'." + (run-hooks 'shell-indirect-setup-hook)) + (defun shell-apply-ansi-color (beg end face) "Apply FACE as the ansi-color face for the text between BEG and END." (when face commit d278b976d480f672ba38764171891e74155ecb54 Author: Miha Rihtaršič Date: Fri Sep 9 20:08:19 2022 +0200 Implement a general input fontification mechanism for comint modes * lisp/comint.el (comint-indent-input-line): (comint-indent-input-line-default): (comint-indent-input-region): (comint-indent-input-region-default): New functions that implement a general mechanism for input indentation through an indirect buffer in comint derived major modes. * lisp/shell.el (shell-mode): Set up input indentation according to sh-mode (bug#51940). diff --git a/lisp/comint.el b/lisp/comint.el index 8786c6db4b..4fcfb500e1 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1944,6 +1944,7 @@ Similarly for Soar, Scheme, etc." (when comint-highlight-input (add-text-properties beg end '( font-lock-face comint-highlight-input + comint--fl-inhibit-fontification t front-sticky t ))) (unless comint-use-prompt-regexp ;; Give old user input a field property of `input', to @@ -4011,6 +4012,234 @@ This function is intended to be included as an entry of (cons (point-marker) (match-string-no-properties 1 text))))) +;;; Input fontification through an indirect buffer +;;============================================================================ +;; +;; Modes derived from `comint-mode' can set up fontification input +;; text with the help of an indirect buffer whose major mode and +;; font-lock settings are set accordingly. + +(defvar-local comint-indirect-setup-function nil + "Function to set up an indirect comint fontification buffer. +This function is called by `comint-indirect-buffer' with zero +arguments after making an indirect buffer. It is usually set to +a major-mode command whose font-locking is desired for input +text. In order to prevent possible mode hooks from running, the +variable `delay-mode-hooks' is set to t prior to calling this +function and `change-major-mode-hook' along with +`after-change-major-mode-hook' are bound to nil.") + +(defcustom comint-indirect-setup-hook nil + "Hook run after setting up an indirect comint fontification buffer. +It is run after the indirect buffer is set up for fontification +of input regions." + :group 'comint + :type 'hook + :version "29.1") + +(defvar-local comint--indirect-buffer nil + "Indirect buffer used for input fontification.") + +(defvar-local comint--fl-saved-jit-lock-contextually nil) + +(define-minor-mode comint-fl-mode + "Enable input fontification in the current comint buffer. +This minor mode is useful if the current major mode derives from +`comint-mode' and if `comint-indirect-setup-function' is set. +Comint modes that support input fontification usually set this +variable buffer-locally to a major-mode command whose +font-locking is desired for input text. + +Input text is fontified through an indirect buffer created with +`comint-indirect-buffer', which see. + +This function signals an error if `comint-use-prompt-regexp' is +non-nil. Input fontification isn't compatible with this +setting." + :lighter nil + (if comint-fl-mode + (let ((success nil)) + (unwind-protect + (progn + (comint--fl-on) + (setq success t)) + (unless success + (setq comint-fl-mode nil) + (comint--fl-off)))) + (comint--fl-off))) + +(defun comint--fl-on () + "Enable input fontification in the current comint buffer." + (comint--fl-off) + + (when comint-use-prompt-regexp + (error + "Input fontification is incompatible with `comint-use-prompt-regexp'")) + + (add-function :around (local 'font-lock-fontify-region-function) + #'comint--fl-fontify-region) + ;; `before-change-functions' are only run in the current buffer and + ;; not in its indirect buffers, which means that we must manually + ;; flush ppss cache + (add-hook 'before-change-functions + #'comint--fl-ppss-flush-indirect 99 t) + + ;; Set up contextual fontification + (unless (booleanp jit-lock-contextually) + (setq comint--fl-saved-jit-lock-contextually + jit-lock-contextually) + (setq-local jit-lock-contextually t) + (when jit-lock-mode + (jit-lock-mode t)))) + +(defun comint--fl-off () + "Disable input fontification in the current comint buffer." + (remove-function (local 'font-lock-fontify-region-function) + #'comint--fl-fontify-region) + (remove-hook 'before-change-functions + #'comint--fl-ppss-flush-indirect t) + + ;; Reset contextual fontification + (when comint--fl-saved-jit-lock-contextually + (setq-local jit-lock-contextually + comint--fl-saved-jit-lock-contextually) + (setq comint--fl-saved-jit-lock-contextually nil) + (when jit-lock-mode + (jit-lock-mode t))) + + (font-lock-flush)) + +(defun comint--fl-ppss-flush-indirect (beg &rest rest) + (when-let ((buf (comint-indirect-buffer t))) + (with-current-buffer buf + (when (memq #'syntax-ppss-flush-cache before-change-functions) + (apply #'syntax-ppss-flush-cache beg rest))))) + +(defun comint--fl-fontify-region (fun beg end verbose) + "Fontify process output and user input in the current comint buffer. +First, highlight the region between BEG and END using FUN. Then +highlight only the input text in the region with the help of an +indirect buffer. VERBOSE is passed to the fontify-region +functions. Skip fontification of input regions with non-nil +`comint--fl-inhibit-fontification' text property." + (pcase (funcall fun beg end verbose) + (`(jit-lock-bounds ,beg1 . ,end1) + (setq beg beg1 end end1))) + (pcase + (let ((min (point-min)) + (max (point-max))) + (with-current-buffer (comint-indirect-buffer) + (narrow-to-region min max) + (comint--intersect-regions + nil (lambda (beg end) + (unless (get-text-property + beg 'comint--fl-inhibit-fontification) + (font-lock-fontify-region beg end verbose))) + beg end))) + (`((jit-lock-bounds ,beg1 . ,_) . (jit-lock-bounds ,_ . ,end1)) + (setq beg (min beg beg1)) + (setq end (max end end1)))) + + `(jit-lock-bounds ,beg . ,end)) + +(defun comint--intersect-regions (fun-output fun-input beg end) + "Iterate over comint output and input regions between BEG and END. +Divide the region specified by BEG and END into smaller regions +that cover either process output (its `field' property is `output') +or input (all remaining text). Interchangeably call FUN-OUTPUT +on each output region, and FUN-INPUT on each input region. + +FUN-OUTPUT and FUN-INPUT are passed two arguments, the beginning +and end of the smaller region. Before calling each function, +narrow the buffer to the surrounding process output or input. You +can also pass nil as either function to skip its corresponding +regions. + +Return a cons cell of return values of the first and last +function called, or nil, if no function was called (if BEG = END)." + (let ((beg1 beg) + (end1 (copy-marker nil t)) + (return-beg nil) (return-end nil) + (is-output (eq (get-text-property beg 'field) 'output))) + (setq end (copy-marker end t)) + + (while (< beg1 end) + (set-marker + end1 (or (if is-output + (text-property-not-all beg1 end 'field 'output) + (text-property-any beg1 end 'field 'output)) + end)) + (when-let ((fun (if is-output fun-output fun-input))) + (save-restriction + (let ((beg2 beg1) + (end2 end1)) + (when (= beg2 beg) + (setq beg2 (field-beginning beg2))) + (when (= end2 end) + (setq end2 (field-end end2))) + ;; Narrow to the whole field surrounding the region + (narrow-to-region beg2 end2)) + (setq return-end (list (funcall fun beg1 + (marker-position end1))))) + (unless return-beg + (setq return-beg return-end))) + (setq beg1 (marker-position end1)) + (setq is-output (not is-output))) + + (set-marker end nil) + (set-marker end1 nil) + (when return-beg + (cons (car return-beg) (car return-end))))) + +(defun comint-indirect-buffer (&optional no-create) + "Return an indirect comint fontification buffer. +If an indirect buffer for the current buffer already exists, +return it, otherwise create it first and set it up by calling +`comint-indirect-setup-function' with zero arguments, turning on +font-lock, and running `comint-indirect-setup-hook'. This setup +happens with `delay-mode-hooks' set to t in order to prevent +possible SETUP-FUN's mode hooks from running. + +If an indirect buffer doesn't exist and NO-CREATE is non-nil, +return nil." + (or + comint--indirect-buffer + (unless no-create + (let ((setup-hook + (if (local-variable-p 'comint-indirect-setup-hook) + (list comint-indirect-setup-hook))) + (setup-fun comint-indirect-setup-function)) + + (add-hook 'change-major-mode-hook #'comint--indirect-cleanup + nil t) + + (with-current-buffer + (setq comint--indirect-buffer + (make-indirect-buffer + (current-buffer) + (generate-new-buffer-name + (concat " " (buffer-name) "-comint-indirect")))) + (setq-local delay-mode-hooks t) + (when setup-fun + (let ((change-major-mode-hook nil) + (after-change-major-mode-hook nil)) + (funcall setup-fun))) + (setq-local font-lock-dont-widen t) + (setq-local font-lock-support-mode nil) + (font-lock-mode) + (when setup-hook + (setq-local comint-indirect-setup-hook + (car setup-hook))) + (run-hooks 'comint-indirect-setup-hook)) + comint--indirect-buffer)))) + +(defun comint--indirect-cleanup () + (when comint--indirect-buffer + (kill-buffer comint--indirect-buffer) + (setq comint--indirect-buffer nil))) + + + ;;; Converting process modes to use comint mode ;;============================================================================ ;; The code in the Emacs 19 distribution has all been modified to use comint commit 06e4d9cb96fefae28c72919b72b87a0747c72a42 Author: Lars Ingebrigtsen Date: Fri Sep 9 19:43:28 2022 +0200 Fix "warn-lambda-malformed-interactive-spec.el" even more * test/lisp/emacs-lisp/bytecomp-tests.el ("warn-lambda-malformed-interactive-spec.el"): Adjust test further. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 11fa3b3d44..bc9f8d802a 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -912,7 +912,7 @@ byte-compiled. Run with dynamic binding." "next-line.*interactive use only.*forward-line") (bytecomp--define-warning-file-test "warn-lambda-malformed-interactive-spec.el" - "malformed `interactive' specification") + "malformed .interactive. specification") (bytecomp--define-warning-file-test "warn-obsolete-defun.el" "foo-obsolete. is an obsolete function (as of 99.99)") commit 04a6fd378f0996c14c3cf9e4905f56df231aa500 Author: Lars Ingebrigtsen Date: Fri Sep 9 19:29:21 2022 +0200 Don't bind `s' in the normal backtrace map * lisp/emacs-lisp/backtrace.el (backtrace-mode-map): Don't bind the "s" command, because it's meaningless outside modes that have set the backtrace-goto-source-functions variable (and only edebug does that) (bug#57674). * lisp/emacs-lisp/edebug.el (edebug-pop-to-backtrace): Use it. (edebug-backtrace-mode-map, edebug-backtrace-mode): New mode. diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 70473770d1..4ffe6f573c 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -209,7 +209,6 @@ frames where the source code location is known.") "v" #'backtrace-toggle-locals "#" #'backtrace-toggle-print-circle ":" #'backtrace-toggle-print-gensym - "s" #'backtrace-goto-source "RET" #'backtrace-help-follow-symbol "+" #'backtrace-multi-line "-" #'backtrace-single-line diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 763848c0c9..c916ec431e 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4179,6 +4179,7 @@ from Edebug instrumentation found in the backtrace." (backtrace-mode) (add-hook 'backtrace-goto-source-functions #'edebug--backtrace-goto-source nil t)) + (edebug-backtrace-mode) (setq edebug-instrumented-backtrace-frames (backtrace-get-frames 'edebug-debugger :constructor #'edebug--make-frame) @@ -4255,6 +4256,14 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME." (setf (edebug--frame-before-index frame) before-index) (setf (edebug--frame-after-index frame) after-index)) +(defvar-keymap edebug-backtrace-mode-map + "s" #'backtrace-goto-source) + +(define-minor-mode edebug-backtrace-mode + "Minor mode for showing backtraces from edebug." + :lighter nil + :interactive nil) + (defun edebug--backtrace-goto-source () (let* ((index (backtrace-get-index)) (frame (nth index backtrace-frames))) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 008e1e467b..dea6e9ed61 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -428,7 +428,8 @@ test and possibly others should be updated." (verify-keybinding "-" 'negative-argument) (verify-keybinding "=" 'edebug-temp-display-freq-count) (should (eq (lookup-key backtrace-mode-map "n") 'backtrace-forward-frame)) - (should (eq (lookup-key backtrace-mode-map "s") 'backtrace-goto-source)))) + (should (eq (lookup-key edebug-backtrace-mode-map "s") + 'backtrace-goto-source)))) (ert-deftest edebug-tests-stop-point-at-start-of-first-instrumented-function () "Edebug stops at the beginning of an instrumented function." commit 4cc78bcfd1f82829b92dff53abf4adf45641b4b2 Author: Lars Ingebrigtsen Date: Fri Sep 9 19:18:02 2022 +0200 Update a bytecomp test * test/lisp/emacs-lisp/bytecomp-tests.el ("warn-lambda-malformed-interactive-spec.el"): Update test to code change. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index a246c25e24..11fa3b3d44 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -912,7 +912,7 @@ byte-compiled. Run with dynamic binding." "next-line.*interactive use only.*forward-line") (bytecomp--define-warning-file-test "warn-lambda-malformed-interactive-spec.el" - "malformed interactive spec") + "malformed `interactive' specification") (bytecomp--define-warning-file-test "warn-obsolete-defun.el" "foo-obsolete. is an obsolete function (as of 99.99)") commit 79ae7b3c874ae9ca77213bfdea13d186ba902961 Author: Lars Ingebrigtsen Date: Fri Sep 9 19:16:01 2022 +0200 Fix typo in byte-compile-lambda warning * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): Fix typo in message (bug#57690). diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index a16486dc31..48929e62bd 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3104,8 +3104,8 @@ lambda-expression." ;; Check that the bit after the `interactive' spec is ;; just a list of symbols (i.e., modes). (unless (seq-every-p #'symbolp (cdr (cdr int))) - (byte-compile-warn-x int "malformed interactive specc: %s" - int)) + (byte-compile-warn-x + int "malformed `interactive' specification: %s" int)) (setq command-modes (cdr (cdr int))) ;; If the interactive spec is a call to `list', don't ;; compile it, because `call-interactively' looks at the commit fc5a4218929d7e3b65a33b81782fdaca75c5faae Author: Lars Ingebrigtsen Date: Fri Sep 9 18:09:36 2022 +0200 Fix --without-x compilation warnings * lisp/image/image-dired.el (clear-image-cache): * lisp/image/image-dired-external.el (clear-image-cache): Fix compilation warning (bug#57695). diff --git a/lisp/image/image-dired-external.el b/lisp/image/image-dired-external.el index c26cedc9f2..223d881bcf 100644 --- a/lisp/image/image-dired-external.el +++ b/lisp/image/image-dired-external.el @@ -30,6 +30,7 @@ (require 'image-dired-util) (declare-function image-dired-display-image "image-dired") +(declare-function clear-image-cache "image.c" (&optional filter)) (defvar image-dired-dir) (defvar image-dired-main-image-directory) diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index e799f2e748..a22edee2ec 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -1448,6 +1448,8 @@ of the thumbnail file." :type '(repeat (string :tag "Argument"))) (make-obsolete-variable 'image-dired-cmd-rotate-thumbnail-options nil "29.1") +(declare-function clear-image-cache "image.c" (&optional filter)) + (defun image-dired-rotate-thumbnail (degrees) "Rotate thumbnail DEGREES degrees." (declare (obsolete image-dired-refresh-thumb "29.1")) commit effb5d75a80b16db636788fb53e4273a1d16d85d Author: Lars Ingebrigtsen Date: Fri Sep 9 17:57:32 2022 +0200 Revert "Fix tramp-loaddefs compilation" This reverts commit 43e9c8e9d28dcb659a43e58778e2745d1279051f. The cookie seemed to go to lisp/loaddefs.el for a reason, but a bootstrap is needed. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index d6a4bde167..d33469f8db 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -220,7 +220,7 @@ CONDITION can also be a list of error conditions." (tramp-compat-rx--transform items))) ;; This is needed for compilation in the Emacs source tree. -;;;###tramp-autoload (defalias 'tramp-compat-rx #'rx) +;;;###autoload (defalias 'tramp-compat-rx #'rx) ;; `file-modes', `set-file-modes' and `set-file-times' got argument ;; FLAG in Emacs 28.1. commit 43e9c8e9d28dcb659a43e58778e2745d1279051f Author: Lars Ingebrigtsen Date: Fri Sep 9 17:54:40 2022 +0200 Fix tramp-loaddefs compilation * lisp/net/tramp-compat.el: Fix build by putting tramp-compat-rx in the right loaddefs file. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index d33469f8db..d6a4bde167 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -220,7 +220,7 @@ CONDITION can also be a list of error conditions." (tramp-compat-rx--transform items))) ;; This is needed for compilation in the Emacs source tree. -;;;###autoload (defalias 'tramp-compat-rx #'rx) +;;;###tramp-autoload (defalias 'tramp-compat-rx #'rx) ;; `file-modes', `set-file-modes' and `set-file-times' got argument ;; FLAG in Emacs 28.1. commit 08cc6c4d9e42079f88c6c30d9a2324dd6f0cec2b Author: Michael Albinus Date: Fri Sep 9 17:10:28 2022 +0200 Make use of rx in Tramp backward compatoble * lisp/net/tramp-compat.el (tramp-compat-rx--runtime-params): New defvar. (tramp-compat-rx--transform-items) (tramp-compat-rx--transform-item, tramp-compat-rx--transform): New defuns. Suggested by Mattias Engdegård . (tramp-compat-rx): New defalias or defmacro. (tramp-compat-string-replace, tramp-compat-string-search): Use regexp-quote. * lisp/net/tramp.el: * lisp/net/tramp-adb.el: * lisp/net/tramp-archive.el: * lisp/net/tramp-cmds.el: * lisp/net/tramp-crypt.el: * lisp/net/tramp-fuse.el: * lisp/net/tramp-gvfs.el: * lisp/net/tramp-sh.el: * lisp/net/tramp-smb.el: * lisp/net/tramp-sudoedit.el: Use `tramp-compat-rx' where indicated. * test/lisp/net/tramp-archive-tests.el: * test/lisp/net/tramp-tests.el: Use `tramp-compat-rx' where indicated. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index dfb026f834..9084e9d27a 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -71,20 +71,22 @@ It is used for TCP/IP devices." "Regexp for date time format in ls output.")) (defconst tramp-adb-ls-date-regexp - (rx blank (regexp tramp-adb-ls-date-year-regexp) - blank (regexp tramp-adb-ls-date-time-regexp) - blank) + (tramp-compat-rx + blank (regexp tramp-adb-ls-date-year-regexp) + blank (regexp tramp-adb-ls-date-time-regexp) + blank) "Regexp for date format in ls output.") (defconst tramp-adb-ls-toolbox-regexp - (rx bol (* blank) (group (+ (any ".-" alpha))) ; \1 permissions - (? (+ blank) (+ digit)) ; links (Android 7/toybox) - (* blank) (group (+ (not blank))) ; \2 username - (+ blank) (group (+ (not blank))) ; \3 group - (+ blank) (group (+ digit)) ; \4 size - (+ blank) (group (regexp tramp-adb-ls-date-year-regexp) - blank (regexp tramp-adb-ls-date-time-regexp)) ; \5 date - blank (group (* nonl)) eol) ; \6 filename + (tramp-compat-rx + bol (* blank) (group (+ (any ".-" alpha))) ; \1 permissions + (? (+ blank) (+ digit)) ; links (Android 7/toybox) + (* blank) (group (+ (not blank))) ; \2 username + (+ blank) (group (+ (not blank))) ; \3 group + (+ blank) (group (+ digit)) ; \4 size + (+ blank) (group (regexp tramp-adb-ls-date-year-regexp) + blank (regexp tramp-adb-ls-date-time-regexp)) ; \5 date + blank (group (* nonl)) eol) ; \6 filename "Regexp for ls output.") ;;;###tramp-autoload @@ -324,8 +326,8 @@ arguments to pass to the OPERATION." (tramp-shell-quote-argument (tramp-compat-file-name-concat localname "..")))) (tramp-compat-replace-regexp-in-region - (rx (literal (tramp-compat-file-name-unquote - (file-name-as-directory localname)))) + (tramp-compat-rx (literal (tramp-compat-file-name-unquote + (file-name-as-directory localname)))) "" (point-min)) (widen))) (tramp-adb-sh-fix-ls-output) @@ -363,12 +365,14 @@ Emacs dired can't find files." (goto-char (point-min)) (while (search-forward-regexp - (rx blank (group blank (regexp tramp-adb-ls-date-year-regexp) blank)) + (tramp-compat-rx + blank (group blank (regexp tramp-adb-ls-date-year-regexp) blank)) nil t) (replace-match "0\\1" "\\1" nil) ;; Insert missing "/". (when (looking-at-p - (rx (regexp tramp-adb-ls-date-time-regexp) (+ blank) eol)) + (tramp-compat-rx + (regexp tramp-adb-ls-date-time-regexp) (+ blank) eol)) (end-of-line) (insert "/"))) ;; Sort entries. @@ -944,7 +948,7 @@ implementation will be used." (i 0) p) - (when (string-match-p (rx multibyte) command) + (when (string-match-p (tramp-compat-rx multibyte) command) (tramp-error v 'file-error "Cannot apply multi-byte command `%s'" command)) @@ -1136,7 +1140,7 @@ error and non-nil on success." (defun tramp-adb-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC." - (if (string-match-p (rx multibyte) command) + (if (string-match-p (tramp-compat-rx multibyte) command) ;; Multibyte codepoints with four bytes are not supported at ;; least by toybox. @@ -1160,7 +1164,7 @@ error and non-nil on success." ;; We can't use stty to disable echo of command. stty is said ;; to be added to toybox 0.7.6. busybox shall have it, but this ;; isn't used any longer for Android. - (delete-matching-lines (rx bol (literal command) eol)) + (delete-matching-lines (tramp-compat-rx bol (literal command) eol)) ;; When the local machine is W32, there are still trailing ^M. ;; There must be a better solution by setting the correct coding ;; system, but this requires changes in core Tramp. @@ -1283,7 +1287,7 @@ connection if a previous connection has died for some reason." ;; Change prompt. (tramp-set-connection-property - p "prompt" (rx "///" (literal prompt) "#$")) + p "prompt" (tramp-compat-rx "///" (literal prompt) "#$")) (tramp-adb-send-command vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt)) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 21a1e94e41..9ff5d6ac75 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -184,17 +184,18 @@ It must be supported by libarchive(3).") ;;;###autoload (progn (defmacro tramp-archive-autoload-file-name-regexp () "Regular expression matching archive file names." - '(rx bos - ;; This group is used in `tramp-archive-file-name-archive'. - (group - (+ nonl) - ;; Default suffixes ... - "." (regexp (regexp-opt tramp-archive-suffixes)) - ;; ... with compression. - (? "." (regexp (regexp-opt tramp-archive-compression-suffixes)))) - ;; This group is used in `tramp-archive-file-name-localname'. - (group "/" (* nonl)) - eos))) + `(rx + bos + ;; This group is used in `tramp-archive-file-name-archive'. + (group + (+ nonl) + ;; Default suffixes ... + "." ,(cons '| tramp-archive-suffixes) + ;; ... with compression. + (? "." ,(cons '| tramp-archive-compression-suffixes))) + ;; This group is used in `tramp-archive-file-name-localname'. + (group "/" (* nonl)) + eos))) (put #'tramp-archive-autoload-file-name-regexp 'tramp-autoload t) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index ad531b427a..d36514bab2 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -355,7 +355,7 @@ The remote connection identified by SOURCE is flushed by (dir (tramp-rename-read-file-name-dir default)) (init (tramp-rename-read-file-name-init default)) (tramp-ignored-file-name-regexp - (rx (literal (file-remote-p source))))) + (tramp-compat-rx (literal (file-remote-p source))))) (read-file-name-default "Enter new Tramp connection: " dir default 'confirm init #'file-directory-p))))) @@ -466,7 +466,7 @@ For details, see `tramp-rename-files'." (dir (tramp-rename-read-file-name-dir default)) (init (tramp-rename-read-file-name-init default)) (tramp-ignored-file-name-regexp - (rx (literal (file-remote-p source))))) + (tramp-compat-rx (literal (file-remote-p source))))) (read-file-name-default (format "Change Tramp connection `%s': " source) dir default 'confirm init #'file-directory-p))))) @@ -621,10 +621,11 @@ buffer in your bug report. (unless (hash-table-p val) ;; Remove string quotation. (when (looking-at - (rx bol (group (* anychar)) "\"" ;; \1 " - (group "(base64-decode-string ") "\\" ;; \2 \ - (group "\"" (* anychar)) "\\" ;; \3 \ - (group "\")") "\"" eol)) ;; \4 " + (tramp-compat-rx + bol (group (* anychar)) "\"" ;; \1 " + (group "(base64-decode-string ") "\\" ;; \2 \ + (group "\"" (* anychar)) "\\" ;; \3 \ + (group "\")") "\"" eol)) ;; \4 " (replace-match "\\1\\2\\3\\4") (beginning-of-line) (insert " ;; Variable encoded due to non-printable characters.\n"))) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index b7c0a3113e..d33469f8db 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -180,6 +180,48 @@ CONDITION can also be a list of error conditions." (declare (debug t) (indent 1)) `(condition-case nil (progn ,@body) (,condition nil))) +;; `rx' in Emacs 26 doesn't know the `literal', `anychar' and +;; `multibyte' constructs. The `not' construct requires an `any' +;; construct as argument. The `regexp' construct requires a literal +;; string. +(defvar tramp-compat-rx--runtime-params) + +(defun tramp-compat-rx--transform-items (items) + (mapcar #'tramp-compat-rx--transform-item items)) + +;; There is an error in Emacs 26. `(rx "a" (? ""))' => "a?". +;; We must protect the string in regexp and literal, therefore. +(defun tramp-compat-rx--transform-item (item) + (pcase item + ('anychar 'anything) + ('multibyte 'nonascii) + (`(not ,expr) + (if (consp expr) item (list 'not (list 'any expr)))) + (`(regexp ,expr) + (setq tramp-compat-rx--runtime-params t) + `(regexp ,(list '\, `(concat "\\(?:" ,expr "\\)")))) + (`(literal ,expr) + (setq tramp-compat-rx--runtime-params t) + `(regexp ,(list '\, `(concat "\\(?:" (regexp-quote ,expr) "\\)")))) + (`(eval . ,_) item) + (`(,head . ,rest) (cons head (tramp-compat-rx--transform-items rest))) + (_ item))) + +(defun tramp-compat-rx--transform (items) + (let* ((tramp-compat-rx--runtime-params nil) + (new-rx (cons ': (tramp-compat-rx--transform-items items)))) + (if tramp-compat-rx--runtime-params + `(rx-to-string ,(list '\` new-rx) t) + (rx-to-string new-rx t)))) + +(if (ignore-errors (rx-to-string '(literal "a"))) ;; Emacs 27+. + (defalias 'tramp-compat-rx #'rx) + (defmacro tramp-compat-rx (&rest items) + (tramp-compat-rx--transform items))) + +;; This is needed for compilation in the Emacs source tree. +;;;###autoload (defalias 'tramp-compat-rx #'rx) + ;; `file-modes', `set-file-modes' and `set-file-times' got argument ;; FLAG in Emacs 28.1. (defalias 'tramp-compat-file-modes @@ -237,7 +279,7 @@ CONDITION can also be a list of error conditions." (lambda (from-string to-string in-string) (let (case-fold-search) (replace-regexp-in-string - (rx (literal from-string)) to-string in-string t t))))) + (regexp-quote from-string) to-string in-string t t))))) ;; Function `string-search' is new in Emacs 28.1. (defalias 'tramp-compat-string-search @@ -245,7 +287,7 @@ CONDITION can also be a list of error conditions." #'string-search (lambda (needle haystack &optional start-pos) (let (case-fold-search) - (string-match-p (rx (literal needle)) haystack start-pos))))) + (string-match-p (regexp-quote needle) haystack start-pos))))) ;; Function `make-lock-file-name' is new in Emacs 28.1. (defalias 'tramp-compat-make-lock-file-name diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 3f5275624f..86055ea78f 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -555,7 +555,7 @@ localname." (defun tramp-crypt-handle-access-file (filename string) "Like `access-file' for Tramp files." (let* ((encrypt-filename (tramp-crypt-encrypt-file-name filename)) - (encrypt-regexp (rx (literal encrypt-filename) eos)) + (encrypt-regexp (tramp-compat-rx (literal encrypt-filename) eos)) tramp-crypt-enabled) (condition-case err (access-file encrypt-filename string) @@ -707,7 +707,7 @@ absolute file names." (mapcar (lambda (x) (replace-regexp-in-string - (rx bos (literal directory)) "" + (tramp-compat-rx bos (literal directory)) "" (tramp-crypt-decrypt-file-name x))) (directory-files (tramp-crypt-encrypt-file-name directory) 'full))))) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index 8761dd1c07..ea6b5a0622 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -69,10 +69,11 @@ (tramp-fuse-local-file-name directory)))))))) (if full ;; Massage the result. - (let ((local (rx bol - (literal - (tramp-fuse-mount-point - (tramp-dissect-file-name directory))))) + (let ((local (tramp-compat-rx + bol + (literal + (tramp-fuse-mount-point + (tramp-dissect-file-name directory))))) (remote (directory-file-name (funcall (if (tramp-compat-file-name-quoted-p directory) @@ -179,7 +180,8 @@ It has the same meaning as `remote-file-name-inhibit-cache'.") (tramp-set-file-property vec "/" "mounted" (when (string-match - (rx bol (group (literal (tramp-fuse-mount-spec vec))) blank) + (tramp-compat-rx + bol (group (literal (tramp-fuse-mount-spec vec))) blank) mount) (match-string 1 mount))))))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 817246fcec..24a7cb2e36 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -414,9 +414,10 @@ It has been changed in GVFS 1.14.") ;; (defconst tramp-goa-identity-regexp - (rx bol (? (group (regexp tramp-user-regexp))) - "@" (? (group (regexp tramp-host-regexp))) - (? ":" (group (regexp tramp-port-regexp)))) + (tramp-compat-rx + bol (? (group (regexp tramp-user-regexp))) + "@" (? (group (regexp tramp-host-regexp))) + (? ":" (group (regexp tramp-port-regexp)))) "Regexp matching GNOME Online Accounts \"PresentationIdentity\" property.") (defconst tramp-goa-interface-mail "org.gnome.OnlineAccounts.Mail" @@ -715,13 +716,15 @@ It has been changed in GVFS 1.14.") "GVFS file attributes.")) (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp - (rx blank (group (regexp (regexp-opt tramp-gvfs-file-attributes))) - "=" (group (+? nonl))) + (tramp-compat-rx + blank (group (regexp (regexp-opt tramp-gvfs-file-attributes))) + "=" (group (+? nonl))) "Regexp to parse GVFS file attributes with `gvfs-ls'.") (defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp - (rx bol (* blank) (group (regexp (regexp-opt tramp-gvfs-file-attributes))) - ":" (+ blank) (group (* nonl)) eol) + (tramp-compat-rx + bol (* blank) (group (regexp (regexp-opt tramp-gvfs-file-attributes))) + ":" (+ blank) (group (* nonl)) eol) "Regexp to parse GVFS file attributes with `gvfs-info'.") (defconst tramp-gvfs-file-system-attributes @@ -731,16 +734,17 @@ It has been changed in GVFS 1.14.") "GVFS file system attributes.") (defconst tramp-gvfs-file-system-attributes-regexp - (rx bol (* blank) - (group (regexp (regexp-opt tramp-gvfs-file-system-attributes))) - ":" (+ blank) (group (* nonl)) eol) + (tramp-compat-rx + bol (* blank) + (group (regexp (regexp-opt tramp-gvfs-file-system-attributes))) + ":" (+ blank) (group (* nonl)) eol) "Regexp to parse GVFS file system attributes with `gvfs-info'.") (defconst tramp-gvfs-nextcloud-default-prefix "/remote.php/webdav" "Default prefix for owncloud / nextcloud methods.") (defconst tramp-gvfs-nextcloud-default-prefix-regexp - (rx (literal tramp-gvfs-nextcloud-default-prefix) eol) + (tramp-compat-rx (literal tramp-gvfs-nextcloud-default-prefix) eol) "Regexp of default prefix for owncloud / nextcloud methods.") @@ -1162,7 +1166,7 @@ file names." (with-parsed-tramp-file-name name nil ;; If there is a default location, expand tilde. (when (string-match - (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) @@ -1180,7 +1184,7 @@ file names." ;; We do not pass "/..". (if (string-match-p (rx bos (| "afp" (: "dav" (? "s")) "smb") eos) method) (when (string-match - (rx bos "/" (+ (not (any "/"))) (group "/.." (? "/"))) + (tramp-compat-rx bos "/" (+ (not "/")) (group "/.." (? "/"))) localname) (setq localname (replace-match "/" t t localname 1))) (when (string-match (rx bol "/.." (? "/")) localname) @@ -1216,20 +1220,22 @@ file names." (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (while (looking-at - (rx bol (group (+ nonl)) blank - (group (+ digit)) blank - "(" (group (+? nonl)) ")" - (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp))) + (tramp-compat-rx + bol (group (+ nonl)) blank + (group (+ digit)) blank + "(" (group (+? nonl)) ")" + (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp))) (let ((item (list (cons "type" (match-string 3)) (cons "standard::size" (match-string 2)) (cons "name" (match-string 1))))) (goto-char (1+ (match-end 3))) (while (looking-at - (rx (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp) - (group - (| (regexp - tramp-gvfs-file-attributes-with-gvfs-ls-regexp) - eol)))) + (tramp-compat-rx + (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp) + (group + (| (regexp + tramp-gvfs-file-attributes-with-gvfs-ls-regexp) + eol)))) (push (cons (match-string 1) (match-string 2)) item) (goto-char (match-end 2))) ;; Add display name as head. @@ -1277,7 +1283,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (if (or (and (string-match-p (rx bol (| "afp" (: "dav" (? "s")) "smb") eol) method) (string-match-p - (rx bol (? "/") (+ (not (any "/"))) eol) localname)) + (tramp-compat-rx bol (? "/") (+ (not "/")) eol) localname)) (string-equal localname "/")) (tramp-gvfs-get-root-attributes filename) (assoc @@ -1477,7 +1483,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (let* ((events (process-get proc 'events)) (rest-string (process-get proc 'rest-string)) (dd (tramp-get-default-directory (process-buffer proc))) - (ddu (rx (literal (tramp-gvfs-url-file-name dd))))) + (ddu (tramp-compat-rx (literal (tramp-gvfs-url-file-name dd))))) (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) @@ -1496,10 +1502,11 @@ If FILE-SYSTEM is non-nil, return file system attributes." (delete-process proc)) (while (string-match - (rx bol (+ nonl) ":" - blank (group (+ nonl)) ":" - blank (group (regexp (regexp-opt tramp-gio-events))) - (? (group blank (group (+ nonl)))) eol) + (tramp-compat-rx + bol (+ nonl) ":" + blank (group (+ nonl)) ":" + blank (group (regexp (regexp-opt tramp-gio-events))) + (? (group blank (group (+ nonl)))) eol) string) (let ((file (match-string 1 string)) @@ -1730,7 +1737,8 @@ ID-FORMAT valid values are `string' and `integer'." "Retrieve file name from D-Bus OBJECT-PATH." (dbus-unescape-from-identifier (replace-regexp-in-string - (rx bol (* nonl) "/" (group (+ (not (any "/")))) eol) "\\1" object-path))) + (tramp-compat-rx bol (* nonl) "/" (group (+ (not "/"))) eol) "\\1" + object-path))) (defun tramp-gvfs-url-host (url) "Return the host name part of URL, a string. @@ -2005,8 +2013,9 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (string-equal domain (tramp-file-name-domain vec)) (string-equal host (tramp-file-name-host vec)) (string-equal port (tramp-file-name-port vec)) - (string-match-p (rx bol "/" (literal (or share ""))) - (tramp-file-name-unquote-localname vec))) + (string-match-p + (tramp-compat-rx bol "/" (literal (or share ""))) + (tramp-file-name-unquote-localname vec))) ;; Set mountpoint and location. (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint) (tramp-set-connection-property @@ -2050,7 +2059,8 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (tramp-media-device-port media) (tramp-file-name-port vec))) (localname (tramp-file-name-unquote-localname vec)) (share (when (string-match - (rx bol (? "/") (group (+ (not (any "/"))))) localname) + (tramp-compat-rx bol (? "/") (group (+ (not "/")))) + localname) (match-string 1 localname))) (ssl (if (string-match-p (rx bol (| "davs" "nextcloud")) method) "true" "false")) @@ -2093,7 +2103,8 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "port" port))))) (mount-pref (if (and (string-match-p (rx bol "dav") method) - (string-match (rx bol (? "/") (+ (not (any "/")))) localname)) + (string-match + (tramp-compat-rx bol (? "/") (+ (not "/"))) localname)) (match-string 0 localname) (tramp-gvfs-get-remote-prefix vec)))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index a783f8c16c..f8d6c0e363 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -411,7 +411,7 @@ The string is used in `tramp-methods'.") (add-to-list 'tramp-default-method-alist `(,tramp-local-host-regexp - ,(rx bos (literal tramp-root-id-string) eos) "su")) + ,(tramp-compat-rx bos (literal tramp-root-id-string) eos) "su")) (add-to-list 'tramp-default-user-alist `(,(rx bos (| "su" "sudo" "doas" "ksu") eos) @@ -1635,10 +1635,11 @@ ID-FORMAT valid values are `string' and `integer'." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) - (regexp (rx (group (+ (any "_" alnum))) ":" - (group (+ (any "_" alnum))) ":" - (group (+ (any "_" alnum))) ":" - (group (+ (any "_" alnum)))))) + (regexp (tramp-compat-rx + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum)))))) (when (and (tramp-remote-selinux-p v) (tramp-send-command-and-check v (format @@ -2828,7 +2829,8 @@ the result will be a local, non-Tramp, file name." ;; by `file-name-absolute-p'. (if (and (eq system-type 'windows-nt) (string-match-p - (rx bol (| (: alpha ":") (: (literal null-device) eol))) name)) + (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device) eol))) + name)) (tramp-run-real-handler #'expand-file-name (list name dir)) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) @@ -2845,7 +2847,8 @@ the result will be a local, non-Tramp, file name." ;; supposed to find such a shell on the remote host. Please ;; tell me about it when this doesn't work on your system. (when (string-match - (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + (tramp-compat-rx + bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) @@ -3917,10 +3920,11 @@ Fall back to normal file name handler if no Tramp handler exists." (setq string (tramp-compat-string-replace "\n\n" "\n" string)) (while (string-match - (rx bol (+ (not (any ":"))) ":" blank - (group (+ (not (any ":")))) ":" blank - (group (regexp (regexp-opt tramp-gio-events))) - (? blank (group (+ (not (any ":"))))) eol) + (tramp-compat-rx + bol (+ (not ":")) ":" blank + (group (+ (not ":"))) ":" blank + (group (regexp (regexp-opt tramp-gio-events))) + (? blank (group (+ (not ":")))) eol) string) (let* ((file (match-string 1 string)) @@ -4020,55 +4024,65 @@ replaced by a temporary file name. If VEC is nil, the respective local commands are used. If there is a format specifier which cannot be expanded, this function returns nil." (if (not (string-match-p - (rx (| bol (not (any "%"))) "%" (any "ahlnoprsty")) script)) + (tramp-compat-rx (| bol (not "%")) "%" (any "ahlnoprsty")) script)) script (catch 'wont-work - (let ((awk (when (string-match-p (rx (| bol (not (any "%"))) "%a") script) + (let ((awk (when (string-match-p + (tramp-compat-rx (| bol (not "%")) "%a") script) (or (if vec (tramp-get-remote-awk vec) (executable-find "awk")) (throw 'wont-work nil)))) - (hdmp (when (string-match-p (rx (| bol (not (any "%"))) "%h") script) + (hdmp (when (string-match-p + (tramp-compat-rx (| bol (not "%")) "%h") script) (or (if vec (tramp-get-remote-hexdump vec) (executable-find "hexdump")) (throw 'wont-work nil)))) - (dev (when (string-match-p (rx (| bol (not (any "%"))) "%n") script) + (dev (when (string-match-p + (tramp-compat-rx (| bol (not "%")) "%n") script) (or (if vec (concat "2>" (tramp-get-remote-null-device vec)) (if (eq system-type 'windows-nt) "" (concat "2>" null-device))) (throw 'wont-work nil)))) - (ls (when (string-match-p (rx (| bol (not (any "%"))) "%l") script) + (ls (when (string-match-p + (tramp-compat-rx (| bol (not "%")) "%l") script) (format "%s %s" (or (tramp-get-ls-command vec) (throw 'wont-work nil)) (tramp-sh--quoting-style-options vec)))) - (od (when (string-match-p (rx (| bol (not (any "%"))) "%o") script) + (od (when (string-match-p + (tramp-compat-rx (| bol (not "%")) "%o") script) (or (if vec (tramp-get-remote-od vec) (executable-find "od")) (throw 'wont-work nil)))) - (perl (when (string-match-p (rx (| bol (not (any "%"))) "%p") script) + (perl (when (string-match-p + (tramp-compat-rx (| bol (not "%")) "%p") script) (or (if vec (tramp-get-remote-perl vec) (executable-find "perl")) (throw 'wont-work nil)))) - (python (when (string-match-p (rx (| bol (not (any "%"))) "%y") script) + (python (when (string-match-p + (tramp-compat-rx (| bol (not "%")) "%y") script) (or (if vec - (tramp-get-remote-python vec) (executable-find "python")) + (tramp-get-remote-python vec) + (executable-find "python")) (throw 'wont-work nil)))) (readlink (when (string-match-p - (rx (| bol (not (any "%"))) "%r") script) + (tramp-compat-rx (| bol (not "%")) "%r") script) (or (if vec (tramp-get-remote-readlink vec) (executable-find "readlink")) (throw 'wont-work nil)))) - (stat (when (string-match-p (rx (| bol (not (any "%"))) "%s") script) + (stat (when (string-match-p + (tramp-compat-rx (| bol (not "%")) "%s") script) (or (if vec (tramp-get-remote-stat vec) (executable-find "stat")) (throw 'wont-work nil)))) - (tmp (when (string-match-p (rx (| bol (not (any "%"))) "%t") script) + (tmp (when (string-match-p + (tramp-compat-rx (| bol (not "%")) "%t") script) (or (if vec (tramp-file-local-name (tramp-make-tramp-temp-name vec)) @@ -4329,7 +4343,8 @@ file exists and nonzero exit status otherwise." "Couldn't find remote shell prompt for %s" shell) (unless (tramp-check-for-regexp - (tramp-get-connection-process vec) (rx (literal tramp-end-of-output))) + (tramp-get-connection-process vec) + (tramp-compat-rx (literal tramp-end-of-output))) (tramp-wait-for-output (tramp-get-connection-process vec)) (tramp-message vec 5 "Setting shell prompt") (tramp-send-command @@ -4370,7 +4385,8 @@ file exists and nonzero exit status otherwise." (tramp-send-command vec (format "echo ~%s" tramp-root-id-string) t) (if (or (string-match-p - (rx bol "~" (literal tramp-root-id-string) eol) + (tramp-compat-rx + bol "~" (literal tramp-root-id-string) eol) (buffer-string)) ;; The default shell (ksh93) of OpenSolaris ;; and Solaris is buggy. We've got reports @@ -4409,9 +4425,9 @@ seconds. If not, it produces an error message with the given ERROR-ARGS." (condition-case nil (tramp-wait-for-regexp proc timeout - (rx (| (regexp shell-prompt-pattern) - (regexp tramp-shell-prompt-pattern)) - eos)) + (tramp-compat-rx + (| (regexp shell-prompt-pattern) (regexp tramp-shell-prompt-pattern)) + eos)) (error (delete-process proc) (apply #'tramp-error-with-buffer @@ -4771,7 +4787,7 @@ Goes through the list `tramp-local-coding-commands' and (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) - (unless (looking-at-p (rx (literal magic))) + (unless (looking-at-p (tramp-compat-rx (literal magic))) (throw 'wont-work-remote nil))) ;; `rem-enc' and `rem-dec' could be a string meanwhile. @@ -4857,7 +4873,7 @@ Goes through the list `tramp-inline-compress-commands'." nil t)) (throw 'next nil)) (goto-char (point-min)) - (unless (looking-at-p (rx (literal magic))) + (unless (looking-at-p (tramp-compat-rx (literal magic))) (throw 'next nil))) (tramp-message vec 5 @@ -4868,7 +4884,7 @@ Goes through the list `tramp-inline-compress-commands'." (throw 'next nil)) (with-current-buffer (tramp-get-buffer vec) (goto-char (point-min)) - (unless (looking-at-p (rx (literal magic))) + (unless (looking-at-p (tramp-compat-rx (literal magic))) (throw 'next nil))) (setq found t))) @@ -5357,14 +5373,15 @@ function waits for output unless NOOUTPUT is set." ;; Busyboxes built with the EDITING_ASK_TERMINAL config ;; option send also escape sequences, which must be ;; ignored. - (regexp (rx (* (not (any "#$\n"))) - (literal tramp-end-of-output) - (? (regexp tramp-device-escape-sequence-regexp)) - (? "\r") eol)) + (regexp (tramp-compat-rx + (* (not (any "#$\n"))) + (literal tramp-end-of-output) + (? (regexp tramp-device-escape-sequence-regexp)) + (? "\r") eol)) ;; Sometimes, the commands do not return a newline but a ;; null byte before the shell prompt, for example "git ;; ls-files -c -z ...". - (regexp1 (rx (| bol "\000") (regexp regexp))) + (regexp1 (tramp-compat-rx (| bol "\000") (regexp regexp))) (found (tramp-wait-for-regexp proc timeout regexp1))) (if found (let ((inhibit-read-only t)) @@ -5404,7 +5421,8 @@ the exit status." (let (cmd data) (if (and (stringp command) (string-match - (rx (* nonl) "<<'" (literal tramp-end-of-heredoc) "'" (* nonl)) + (tramp-compat-rx + (* nonl) "<<'" (literal tramp-end-of-heredoc) "'" (* nonl)) command)) (setq cmd (match-string 0 command) data (substring command (match-end 0))) @@ -5574,7 +5592,7 @@ Nonexistent directories are removed from spec." (tramp-get-method-parameter vec 'tramp-remote-shell-args) " ") (tramp-shell-quote-argument tramp-end-of-heredoc)) - 'noerror (rx (literal tramp-end-of-heredoc))) + 'noerror (tramp-compat-rx (literal tramp-end-of-heredoc))) (progn (tramp-message vec 2 "Could not retrieve `tramp-own-remote-path'") @@ -5624,7 +5642,7 @@ Nonexistent directories are removed from spec." (while candidates (goto-char (point-min)) (if (string-match-p - (rx bol (literal (car candidates)) (? "\r") eol) + (tramp-compat-rx bol (literal (car candidates)) (? "\r") eol) (buffer-string)) (setq locale (car candidates) candidates nil) @@ -5703,7 +5721,7 @@ Nonexistent directories are removed from spec." vec (format "( %s / -nt / )" (tramp-get-test-command vec))) (with-current-buffer (tramp-get-buffer vec) (goto-char (point-min)) - (when (looking-at-p (rx (literal tramp-end-of-output))) + (when (looking-at-p (tramp-compat-rx (literal tramp-end-of-output))) (format "%s %%s -nt %%s" (tramp-get-test-command vec))))) (progn (tramp-send-command diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 930f4f707b..5cdb8a9473 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -53,7 +53,7 @@ ;;;###tramp-autoload (tramp--with-startup (add-to-list 'tramp-default-user-alist - `(,(rx bos (literal tramp-smb-method) eos) nil nil)) + `(,(tramp-compat-rx bos (literal tramp-smb-method) eos) nil nil)) ;; Add completion function for SMB method. (tramp-set-completion-function @@ -92,9 +92,9 @@ this variable \"client min protocol=NT1\"." "Version string of the SMB client.") (defconst tramp-smb-server-version - (rx "Domain=[" (* (not (any "]"))) "] " - "OS=[" (* (not (any "]"))) "] " - "Server=[" (* (not (any "]"))) "]") + (tramp-compat-rx "Domain=[" (* (not "]")) "] " + "OS=[" (* (not "]")) "] " + "Server=[" (* (not "]")) "]") "Regexp of SMB server identification.") (defconst tramp-smb-prompt @@ -729,7 +729,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (with-parsed-tramp-file-name name nil ;; Tilde expansion if necessary. (when (string-match - (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) @@ -1082,7 +1082,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Check for matching entries. (mapcar (lambda (x) - (when (string-match-p (rx bol (literal base)) (nth 0 x)) + (when (string-match-p + (tramp-compat-rx bol (literal base)) (nth 0 x)) x)) entries) ;; We just need the only and only entry FILENAME. @@ -1632,7 +1633,7 @@ VEC or USER, or if there is no home directory, return nil." (save-match-data (let ((localname (tramp-file-name-unquote-localname vec))) (when (string-match - (rx bol (? "/") (group (+ (not (any "/")))) "/") localname) + (tramp-compat-rx bol (? "/") (group (+ (not "/"))) "/") localname) (match-string 1 localname))))) (defun tramp-smb-get-localname (vec) @@ -1643,7 +1644,8 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (setq localname (if (string-match - (rx bol (? "/") (+ (not (any "/"))) (group "/" (* nonl))) localname) + (tramp-compat-rx bol (? "/") (+ (not "/")) (group "/" (* nonl))) + localname) ;; There is a share, separated by "/". (if (not (tramp-smb-get-cifs-capabilities vec)) (mapconcat @@ -1652,7 +1654,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (match-string 1 localname)) ;; There is just a share. (if (string-match - (rx bol (? "/") (group (+ (not (any "/")))) eol) localname) + (tramp-compat-rx bol (? "/") (group (+ (not "/"))) eol) localname) (match-string 1 localname) ""))) @@ -1781,7 +1783,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." ;; Read share entries. (when (string-match - (rx bol "Disk|" (group (+ (not (any "|")))) "|") line) + (tramp-compat-rx bol "Disk|" (group (+ (not "|"))) "|") line) (setq localname (match-string 1 line) mode "dr-xr-xr-x" size 0)) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index e0b577fff8..cece7a664d 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -49,7 +49,7 @@ (tramp-password-previous-hop t))) (add-to-list 'tramp-default-user-alist - `(,(rx bos (literal tramp-sudoedit-method) eos) + `(,(tramp-compat-rx bos (literal tramp-sudoedit-method) eos) nil ,tramp-root-id-string)) (tramp-set-completion-function @@ -377,7 +377,7 @@ the result will be a local, non-Tramp, file name." (unless (file-name-absolute-p localname) (setq localname (format "~%s/%s" user localname))) (when (string-match - (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) @@ -518,10 +518,11 @@ the result will be a local, non-Tramp, file name." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) - (regexp (rx (group (+ (any "_" alnum))) ":" - (group (+ (any "_" alnum))) ":" - (group (+ (any "_" alnum))) ":" - (group (+ (any "_" alnum)))))) + (regexp (tramp-compat-rx + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum)))))) (when (and (tramp-sudoedit-remote-selinux-p v) (tramp-sudoedit-send-command v "ls" "-d" "-Z" diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index cd68801c21..652fafb67e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -516,9 +516,10 @@ interpreted as a regular expression which always matches." (defcustom tramp-restricted-shell-hosts-alist (when (and (eq system-type 'windows-nt) (not (string-match-p (rx "sh" eol) tramp-encoding-shell))) - (list (rx bos (| (literal (downcase tramp-system-name)) - (literal (upcase tramp-system-name))) - eos))) + (list (tramp-compat-rx + bos (| (literal (downcase tramp-system-name)) + (literal (upcase tramp-system-name))) + eos))) "List of hosts, which run a restricted shell. This is a list of regular expressions, which denote hosts running a restricted shell like \"rbash\". Those hosts can be used as @@ -529,10 +530,11 @@ host runs a restricted shell, it shall be added to this list, too." ;;;###tramp-autoload (defcustom tramp-local-host-regexp - (rx bos - (| (literal tramp-system-name) - (| "localhost" "localhost4" "localhost6" "127.0.0.1" "::1")) - eos) + (tramp-compat-rx + bos + (| (literal tramp-system-name) + (| "localhost" "localhost4" "localhost6" "127.0.0.1" "::1")) + eos) "Host names which are regarded as local host. If the local host runs a chrooted environment, set this to nil." :version "29.1" @@ -629,9 +631,10 @@ This regexp must match both `tramp-initial-end-of-output' and :type 'regexp) (defcustom tramp-password-prompt-regexp - (rx bol (* nonl) - (group (regexp (regexp-opt password-word-equivalents))) - (* nonl) ":" (? "\^@") (* blank)) + (tramp-compat-rx + bol (* nonl) + (group (regexp (regexp-opt password-word-equivalents))) + (* nonl) ":" (? "\^@") (* blank)) "Regexp matching password-like prompts. The regexp should match at end of buffer. @@ -887,17 +890,18 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-prefix-regexp () "Return `tramp-prefix-regexp'." - (rx bol (literal (tramp-build-prefix-format)))) + (tramp-compat-rx bol (literal (tramp-build-prefix-format)))) (defvar tramp-prefix-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching the very beginning of Tramp file names. Should always start with \"^\". Derived from `tramp-prefix-format'.") (defconst tramp-method-regexp-alist - `((default . ,(rx (| (literal tramp-default-method-marker) (>= 2 alnum)))) + `((default . ,(tramp-compat-rx + (| (literal tramp-default-method-marker) (>= 2 alnum)))) (simplified . "") - (separate - . ,(rx (? (| (literal tramp-default-method-marker) (>= 2 alnum)))))) + (separate . ,(tramp-compat-rx + (? (| (literal tramp-default-method-marker) (>= 2 alnum)))))) "Alist mapping Tramp syntax to regexps matching methods identifiers.") (defun tramp-build-method-regexp () @@ -925,7 +929,7 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-method-regexp () "Return `tramp-postfix-method-regexp'." - (rx (literal (tramp-build-postfix-method-format)))) + (tramp-compat-rx (literal (tramp-build-postfix-method-format)))) (defvar tramp-postfix-method-regexp nil ; Init'd when defining `tramp-syntax'! "Regexp matching delimiter between method and user or host names. @@ -937,7 +941,8 @@ Derived from `tramp-postfix-method-format'.") (defconst tramp-prefix-domain-format "%" "String matching delimiter between user and domain names.") -(defconst tramp-prefix-domain-regexp (rx (literal tramp-prefix-domain-format)) +(defconst tramp-prefix-domain-regexp + (tramp-compat-rx (literal tramp-prefix-domain-format)) "Regexp matching delimiter between user and domain names. Derived from `tramp-prefix-domain-format'.") @@ -945,16 +950,18 @@ Derived from `tramp-prefix-domain-format'.") "Regexp matching domain names.") (defconst tramp-user-with-domain-regexp - (rx (group (regexp tramp-user-regexp)) - (regexp tramp-prefix-domain-regexp) - (group (regexp tramp-domain-regexp))) + (tramp-compat-rx + (group (regexp tramp-user-regexp)) + (regexp tramp-prefix-domain-regexp) + (group (regexp tramp-domain-regexp))) "Regexp matching user names with domain names.") (defconst tramp-postfix-user-format "@" "String matching delimiter between user and host names. Used in `tramp-make-tramp-file-name'.") -(defconst tramp-postfix-user-regexp (rx (literal tramp-postfix-user-format)) +(defconst tramp-postfix-user-regexp + (tramp-compat-rx (literal tramp-postfix-user-format)) "Regexp matching delimiter between user and host names. Derived from `tramp-postfix-user-format'.") @@ -977,7 +984,7 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-prefix-ipv6-regexp () "Return `tramp-prefix-ipv6-regexp'." - (rx (literal tramp-prefix-ipv6-format))) + (tramp-compat-rx (literal tramp-prefix-ipv6-format))) (defvar tramp-prefix-ipv6-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching left hand side of IPv6 addresses. @@ -1005,7 +1012,7 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-ipv6-regexp () "Return `tramp-postfix-ipv6-regexp'." - (rx (literal tramp-postfix-ipv6-format))) + (tramp-compat-rx (literal tramp-postfix-ipv6-format))) (defvar tramp-postfix-ipv6-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching right hand side of IPv6 addresses. @@ -1014,7 +1021,8 @@ Derived from `tramp-postfix-ipv6-format'.") (defconst tramp-prefix-port-format "#" "String matching delimiter between host names and port numbers.") -(defconst tramp-prefix-port-regexp (rx (literal tramp-prefix-port-format)) +(defconst tramp-prefix-port-regexp + (tramp-compat-rx (literal tramp-prefix-port-format)) "Regexp matching delimiter between host names and port numbers. Derived from `tramp-prefix-port-format'.") @@ -1022,15 +1030,17 @@ Derived from `tramp-prefix-port-format'.") "Regexp matching port numbers.") (defconst tramp-host-with-port-regexp - (rx (group (regexp tramp-host-regexp)) - (regexp tramp-prefix-port-regexp) - (group (regexp tramp-port-regexp))) + (tramp-compat-rx + (group (regexp tramp-host-regexp)) + (regexp tramp-prefix-port-regexp) + (group (regexp tramp-port-regexp))) "Regexp matching host names with port numbers.") (defconst tramp-postfix-hop-format "|" "String matching delimiter after ad-hoc hop definitions.") -(defconst tramp-postfix-hop-regexp (rx (literal tramp-postfix-hop-format)) +(defconst tramp-postfix-hop-regexp + (tramp-compat-rx (literal tramp-postfix-hop-format)) "Regexp matching delimiter after ad-hoc hop definitions. Derived from `tramp-postfix-hop-format'.") @@ -1050,7 +1060,7 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-host-regexp () "Return `tramp-postfix-host-regexp'." - (rx (literal tramp-postfix-host-format))) + (tramp-compat-rx (literal tramp-postfix-host-format))) (defvar tramp-postfix-host-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching delimiter between host names and localnames. @@ -1077,17 +1087,18 @@ Derived from `tramp-postfix-host-format'.") (defun tramp-build-remote-file-name-spec-regexp () "Construct a regexp matching a Tramp file name for a Tramp syntax. It is expected, that `tramp-syntax' has the proper value." - (rx ;; Method. - (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) - ;; Optional user. - (? (group (regexp tramp-user-regexp)) (regexp tramp-postfix-user-regexp)) - ;; Optional host. - (? (group (| (regexp tramp-host-regexp) - (: (regexp tramp-prefix-ipv6-regexp) - (? (regexp tramp-ipv6-regexp)) - (regexp tramp-postfix-ipv6-regexp))) - ;; Optional port. - (? (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp)))))) + (tramp-compat-rx + ;; Method. + (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) + ;; Optional user. This includes domain. + (? (group (regexp tramp-user-regexp)) (regexp tramp-postfix-user-regexp)) + ;; Optional host. + (? (group (| (regexp tramp-host-regexp) + (: (regexp tramp-prefix-ipv6-regexp) + (? (regexp tramp-ipv6-regexp)) + (regexp tramp-postfix-ipv6-regexp))) + ;; Optional port. + (? (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp)))))) (defvar tramp-remote-file-name-spec-regexp nil ; Initialized when defining `tramp-syntax'! @@ -1098,12 +1109,13 @@ It is expected, that `tramp-syntax' has the proper value." It is expected, that `tramp-syntax' has the proper value. See `tramp-file-name-structure'." (list - (rx (regexp tramp-prefix-regexp) - (? (group (+ (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)))) - (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-host-regexp) - (group (regexp tramp-localname-regexp))) + (tramp-compat-rx + (regexp tramp-prefix-regexp) + (? (group (+ (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)))) + (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-host-regexp) + (group (regexp tramp-localname-regexp))) 5 6 7 8 1)) (defvar tramp-file-name-structure nil ; Initialized when defining `tramp-syntax'! @@ -1157,9 +1169,11 @@ initial value is overwritten by the car of `tramp-file-name-structure'.") ;; `tramp-method-regexp' needs at least two characters, in order to ;; distinguish from volume letter. This is in the way when completing. (defconst tramp-completion-method-regexp-alist - `((default . ,(rx (| (literal tramp-default-method-marker) (+ alnum)))) + `((default . ,(tramp-compat-rx + (| (literal tramp-default-method-marker) (+ alnum)))) (simplified . "") - (separate . ,(rx (| (literal tramp-default-method-marker) (* alnum))))) + (separate . ,(tramp-compat-rx + (| (literal tramp-default-method-marker) (* alnum))))) "Alist mapping Tramp syntax to regexps matching completion methods.") (defun tramp-build-completion-method-regexp () @@ -1175,27 +1189,28 @@ The `ftp' syntax does not support methods.") "Return `tramp-completion-file-name-regexp' according to `tramp-syntax'." (if (eq tramp-syntax 'separate) ;; FIXME: This shouldn't be necessary. - (rx bos "/" (? "[" (* (not (any "]")))) eos) - (rx bos - ;; `file-name-completion' uses absolute paths for matching. - ;; This means that on W32 systems, something like - ;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also - ;; `tramp-drop-volume-letter'. - (? (regexp tramp-volume-letter-regexp)) - (regexp tramp-prefix-regexp) - - ;; Optional multi hops. - (* (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)) - - ;; Last hop. - (? (regexp tramp-completion-method-regexp) - ;; Method separator, user name and host name. - (? (regexp tramp-postfix-method-regexp) - ;; This is a little bit lax, but it serves. - (? (regexp tramp-host-regexp)))) - - eos))) + (tramp-compat-rx bos "/" (? "[" (* (not "]"))) eos) + (tramp-compat-rx + bos + ;; `file-name-completion' uses absolute paths for matching. + ;; This means that on W32 systems, something like + ;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also + ;; `tramp-drop-volume-letter'. + (? (regexp tramp-volume-letter-regexp)) + (regexp tramp-prefix-regexp) + + ;; Optional multi hops. + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + + ;; Last hop. + (? (regexp tramp-completion-method-regexp) + ;; Method separator, user name and host name. + (? (regexp tramp-postfix-method-regexp) + ;; This is a little bit lax, but it serves. + (? (regexp tramp-host-regexp)))) + + eos))) (defvar tramp-completion-file-name-regexp nil ; Initialized when defining `tramp-syntax'! @@ -1733,7 +1748,7 @@ See `tramp-dissect-file-name' for details." (let ((v (tramp-dissect-file-name (concat tramp-prefix-format (replace-regexp-in-string - (rx (regexp tramp-postfix-hop-regexp) eos) + (tramp-compat-rx (regexp tramp-postfix-hop-regexp) eos) tramp-postfix-host-format name)) nodefault))) ;; Only some methods from tramp-sh.el do support multi-hops. @@ -1829,7 +1844,8 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." (replace-regexp-in-string tramp-prefix-regexp "" (replace-regexp-in-string - (rx (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format + (tramp-compat-rx + (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format (tramp-make-tramp-file-name vec 'noloc))))) (defun tramp-completion-make-tramp-file-name (method user host localname) @@ -1958,7 +1974,7 @@ of `current-buffer'." ;; Also, in `font-lock-defaults' you can specify a function name for ;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords! '(list - (rx bol (regexp tramp-debug-outline-regexp) (+ nonl)) + (tramp-compat-rx bol (regexp tramp-debug-outline-regexp) (+ nonl)) '(1 font-lock-warning-face t t) '(0 (outline-font-lock-face) keep t)) "Used for highlighting Tramp debug buffers in `outline-mode'.") @@ -2413,9 +2429,9 @@ letter into the file name. This function removes it." (let ((quoted (tramp-compat-file-name-quoted-p name 'top)) (result (tramp-compat-file-name-unquote name 'top))) (setq result - (if (string-match - (rx (regexp tramp-volume-letter-regexp) "/") result) - (replace-match "/" nil t result) result)) + (replace-regexp-in-string + (tramp-compat-rx (regexp tramp-volume-letter-regexp) "/") + "/" result)) (if quoted (tramp-compat-file-name-quote result 'top) result)))) ;;; Config Manipulation Functions: @@ -2524,7 +2540,7 @@ coding system might not be determined. This function repairs it." ;; We found a matching entry in `file-coding-system-alist'. ;; So we add a similar entry, but with the temporary file name ;; as regexp. - (push (cons (rx (literal tmpname)) (cdr elt)) result))))) + (push (cons (tramp-compat-rx (literal tmpname)) (cdr elt)) result))))) (defun tramp-run-real-handler (operation args) "Invoke normal file name handler for OPERATION. @@ -2807,7 +2823,7 @@ remote file names." #'file-name-sans-extension (directory-files dir nil (rx bos "tramp" (+ nonl) ".el" (? "c") eos))))) - (files-regexp (rx bol (regexp (regexp-opt files)) eol))) + (files-regexp (tramp-compat-rx bol (regexp (regexp-opt files)) eol))) (mapatoms (lambda (atom) (when (and (functionp atom) @@ -2952,9 +2968,10 @@ not in completion mode." ;; Suppress hop from completion. (when (string-match - (rx (regexp tramp-prefix-regexp) - (group (+ (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)))) + (tramp-compat-rx + (regexp tramp-prefix-regexp) + (group (+ (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)))) fullname) (setq hop (match-string 1 fullname) fullname (replace-match "" nil nil fullname 1))) @@ -3044,54 +3061,60 @@ They are collected by `tramp-completion-dissect-file-name1'." (let (;; "/method" "/[method" (tramp-completion-file-name-structure1 (list - (rx (regexp tramp-prefix-regexp) - (group (? (regexp tramp-completion-method-regexp))) eol) + (tramp-compat-rx + (regexp tramp-prefix-regexp) + (group (? (regexp tramp-completion-method-regexp))) eol) 1 nil nil nil)) ;; "/method:user" "/[method/user" (tramp-completion-file-name-structure2 (list - (rx (regexp tramp-prefix-regexp) - (group (regexp tramp-method-regexp)) - (regexp tramp-postfix-method-regexp) - (group (? (regexp tramp-user-regexp))) eol) + (tramp-compat-rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (? (regexp tramp-user-regexp))) eol) 1 2 nil nil)) ;; "/method:host" "/[method/host" (tramp-completion-file-name-structure3 (list - (rx (regexp tramp-prefix-regexp) - (group (regexp tramp-method-regexp)) - (regexp tramp-postfix-method-regexp) - (group (? (regexp tramp-host-regexp))) eol) + (tramp-compat-rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (? (regexp tramp-host-regexp))) eol) 1 nil 2 nil)) ;; "/method:[ipv6" "/[method/ipv6" (tramp-completion-file-name-structure4 (list - (rx (regexp tramp-prefix-regexp) - (group (regexp tramp-method-regexp)) - (regexp tramp-postfix-method-regexp) - (regexp tramp-prefix-ipv6-regexp) - (group (? (regexp tramp-ipv6-regexp))) eol) + (tramp-compat-rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (regexp tramp-prefix-ipv6-regexp) + (group (? (regexp tramp-ipv6-regexp))) eol) 1 nil 2 nil)) ;; "/method:user@host" "/[method/user@host" (tramp-completion-file-name-structure5 (list - (rx (regexp tramp-prefix-regexp) - (group (regexp tramp-method-regexp)) - (regexp tramp-postfix-method-regexp) - (group (regexp tramp-user-regexp)) - (regexp tramp-postfix-user-regexp) - (group (? (regexp tramp-host-regexp))) eol) + (tramp-compat-rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-user-regexp)) + (regexp tramp-postfix-user-regexp) + (group (? (regexp tramp-host-regexp))) eol) 1 2 3 nil)) ;; "/method:user@[ipv6" "/[method/user@ipv6" (tramp-completion-file-name-structure6 (list - (rx (regexp tramp-prefix-regexp) - (group (regexp tramp-method-regexp)) - (regexp tramp-postfix-method-regexp) - (group (regexp tramp-user-regexp)) - (regexp tramp-postfix-user-regexp) - (regexp tramp-prefix-ipv6-regexp) - (group (? (regexp tramp-ipv6-regexp))) eol) + (tramp-compat-rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-user-regexp)) + (regexp tramp-postfix-user-regexp) + (regexp tramp-prefix-ipv6-regexp) + (group (? (regexp tramp-ipv6-regexp))) eol) 1 2 3 nil))) (delq nil @@ -3217,8 +3240,9 @@ Either user or host may be nil." Either user or host may be nil." (let (result (regexp - (rx bol (group (regexp tramp-host-regexp)) - (? (+ blank) (group (regexp tramp-user-regexp)))))) + (tramp-compat-rx + bol (group (regexp tramp-host-regexp)) + (? (+ blank) (group (regexp tramp-user-regexp)))))) (when (re-search-forward regexp (line-end-position) t) (setq result (append (list (match-string 2) (match-string 1))))) (forward-line 1) @@ -3232,7 +3256,8 @@ User is always nil." (defun tramp-parse-shosts-group () "Return a (user host) tuple allowed to access. User is always nil." - (tramp-parse-group (rx bol (group (regexp tramp-host-regexp))) 1 ",")) + (tramp-parse-group + (tramp-compat-rx bol (group (regexp tramp-host-regexp))) 1 ",")) (defun tramp-parse-sconfig (filename) "Return a list of (user host) tuples allowed to access. @@ -3243,9 +3268,10 @@ User is always nil." "Return a (user host) tuple allowed to access. User is always nil." (tramp-parse-group - (rx (| (: bol (* blank) "Host") - (: bol (+ nonl)) ;; ??? - (group (regexp tramp-host-regexp)))) + (tramp-compat-rx + (| (: bol (* blank) "Host") + (: bol (+ nonl)) ;; ??? + (group (regexp tramp-host-regexp)))) 1 (rx blank))) ;; Generic function. @@ -3267,15 +3293,16 @@ User is always nil." User is always nil." (tramp-parse-shostkeys-sknownhosts dirname - (rx bol "key_" (+ digit) "_" (group (regexp tramp-host-regexp)) ".pub" eol))) + (tramp-compat-rx + bol "key_" (+ digit) "_" (group (regexp tramp-host-regexp)) ".pub" eol))) (defun tramp-parse-sknownhosts (dirname) "Return a list of (user host) tuples allowed to access. User is always nil." (tramp-parse-shostkeys-sknownhosts dirname - (rx bol (group (regexp tramp-host-regexp)) - ".ssh-" (| "dss" "rsa") ".pub" eol))) + (tramp-compat-rx + bol (group (regexp tramp-host-regexp)) ".ssh-" (| "dss" "rsa") ".pub" eol))) (defun tramp-parse-hosts (filename) "Return a list of (user host) tuples allowed to access. @@ -3286,7 +3313,8 @@ User is always nil." "Return a (user host) tuple allowed to access. User is always nil." (tramp-parse-group - (rx bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp)))) + (tramp-compat-rx + bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp)))) 1 (rx blank))) (defun tramp-parse-passwd (filename) @@ -3305,7 +3333,7 @@ Host is always \"localhost\"." "Return a (user host) tuple allowed to access. Host is always \"localhost\"." (let (result - (regexp (rx bol (group (regexp tramp-user-regexp)) ":"))) + (regexp (tramp-compat-rx bol (group (regexp tramp-user-regexp)) ":"))) (when (re-search-forward regexp (line-end-position) t) (setq result (list (match-string 1) "localhost"))) (forward-line 1) @@ -3356,13 +3384,14 @@ User is always nil." (tramp-parse-putty-group registry-or-dirname))))) ;; UNIX case. (tramp-parse-shostkeys-sknownhosts - registry-or-dirname (rx bol (group (regexp tramp-host-regexp)) eol)))) + registry-or-dirname + (tramp-compat-rx bol (group (regexp tramp-host-regexp)) eol)))) (defun tramp-parse-putty-group (registry) "Return a (user host) tuple allowed to access. User is always nil." (let (result - (regexp (rx (literal registry) "\\" (group (+ nonl))))) + (regexp (tramp-compat-rx (literal registry) "\\" (group (+ nonl))))) (when (re-search-forward regexp (line-end-position) t) (setq result (list nil (match-string 1)))) (forward-line 1) @@ -3763,7 +3792,7 @@ Let-bind it when necessary.") ;; not support tilde expansion. But users could declare a ;; respective connection property. (Bug#53847) (when (string-match - (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) @@ -3927,7 +3956,8 @@ Let-bind it when necessary.") (and completion-ignored-extensions (string-match-p - (rx (regexp (regexp-opt completion-ignored-extensions)) eos) + (tramp-compat-rx + (regexp (regexp-opt completion-ignored-extensions)) eos) x) ;; We remember the hit. (push x hits-ignored-extensions)))))) @@ -4570,9 +4600,9 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") tramp-prefix-format proxy tramp-postfix-host-format)) (entry (list (and (stringp host-port) - (rx bol (literal host-port) eol)) + (tramp-compat-rx bol (literal host-port) eol)) (and (stringp user-domain) - (rx bol (literal user-domain) eol)) + (tramp-compat-rx bol (literal user-domain) eol)) (propertize proxy 'tramp-ad-hoc t)))) (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry) ;; Add the hop. @@ -4651,7 +4681,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (setq tramp-default-proxies-alist saved-tdpa) (tramp-user-error vec "Host name `%s' does not match `%s'" host previous-host)) - (setq previous-host (rx bol (literal host) eol))))) + (setq previous-host (tramp-compat-rx bol (literal host) eol))))) ;; Result. target-alist)) @@ -5614,7 +5644,8 @@ the remote host use line-endings as defined in the variable (tramp-flush-directory-properties vec "/")) (when (buffer-live-p buf) (with-current-buffer buf - (when (and prompt (tramp-search-regexp (rx (literal prompt)))) + (when (and prompt + (tramp-search-regexp (tramp-compat-rx (literal prompt)))) (delete-region (point) (point-max)))))))) (defun tramp-get-inode (vec) @@ -5818,7 +5849,7 @@ VEC is used for tracing." (while candidates (goto-char (point-min)) (if (string-match-p - (rx bol (literal (car candidates)) (? "\r") eol) + (tramp-compat-rx bol (literal (car candidates)) (? "\r") eol) (buffer-string)) (setq locale (car candidates) candidates nil) @@ -6178,7 +6209,7 @@ ALIST is of the form ((FROM . TO) ...)." (let* ((pr (car alist)) (from (car pr)) (to (cdr pr))) - (while (string-match (rx (literal from)) string) + (while (string-match (tramp-compat-rx (literal from)) string) (setq string (replace-match to t t string))) (setq alist (cdr alist)))) string)) @@ -6446,7 +6477,7 @@ Only works for Bourne-like shells." (string= (substring result 0 2) "\\~")) (setq result (substring result 1))) (replace-regexp-in-string - (rx "\\" (literal tramp-rsh-end-of-line)) + (tramp-compat-rx "\\" (literal tramp-rsh-end-of-line)) (format "'%s'" tramp-rsh-end-of-line) result))))) ;;; Signal handling. This works for remote processes, which have set diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index d0892bf708..f8a0aa03e3 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -616,13 +616,15 @@ This checks also `file-name-as-directory', `file-name-directory', (insert-directory tramp-archive-test-archive nil) (goto-char (point-min)) (should - (looking-at-p (rx (literal tramp-archive-test-archive))))) + (looking-at-p + (tramp-compat-rx (literal tramp-archive-test-archive))))) (with-temp-buffer (insert-directory tramp-archive-test-archive "-al") (goto-char (point-min)) (should (looking-at-p - (rx bol (+ nonl) blank (literal tramp-archive-test-archive) eol)))) + (tramp-compat-rx + bol (+ nonl) blank (literal tramp-archive-test-archive) eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tramp-archive-test-archive) @@ -917,14 +919,15 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo"))) (should (string-match - (rx "tramp-archive loaded: " - (literal (symbol-name - (tramp-archive-file-name-p default-directory))) - (+ ascii) - "tramp-archive loaded: " - (literal (symbol-name - (or (tramp-archive-file-name-p default-directory) - (and enabled (tramp-archive-file-name-p file)))))) + (tramp-compat-rx + "tramp-archive loaded: " + (literal (symbol-name + (tramp-archive-file-name-p default-directory))) + (+ ascii) + "tramp-archive loaded: " + (literal (symbol-name + (or (tramp-archive-file-name-p default-directory) + (and enabled (tramp-archive-file-name-p file)))))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s --eval %s" @@ -961,9 +964,10 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (dolist (tae '(t nil)) (should (string-match - (rx "tramp-archive loaded: nil" (+ ascii) - "tramp-archive loaded: nil" (+ ascii) - "tramp-archive loaded: " (literal (symbol-name tae))) + (tramp-compat-rx + "tramp-archive loaded: nil" (+ ascii) + "tramp-archive loaded: nil" (+ ascii) + "tramp-archive loaded: " (literal (symbol-name tae))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 6f7c6702e7..2db4449438 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2295,9 +2295,9 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Check `directory-abbrev-alist' abbreviation. (let ((directory-abbrev-alist - `((,(rx bos (literal home-dir) "/foo") + `((,(tramp-compat-rx bos (literal home-dir) "/foo") . ,(concat home-dir "/f")) - (,(rx bos (literal remote-host) "/nowhere") + (,(tramp-compat-rx bos (literal remote-host) "/nowhere") . ,(concat remote-host "/nw"))))) (should (equal (abbreviate-file-name (concat home-dir "/foo/bar")) (concat remote-host-nohop "~/f/bar"))) @@ -2510,7 +2510,8 @@ This checks also `file-name-as-directory', `file-name-directory', (string-match-p (if (and (null noninteractive) (or (eq visit t) (null visit) (stringp visit))) - (rx bol "Wrote " (literal tmp-name) "\n" eos) + (tramp-compat-rx + bol "Wrote " (literal tmp-name) "\n" eos) (rx bos)) tramp--test-messages)))))) @@ -3211,24 +3212,26 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (with-temp-buffer (insert-directory tmp-name1 nil) (goto-char (point-min)) - (should (looking-at-p (rx (literal tmp-name1))))) + (should (looking-at-p (tramp-compat-rx (literal tmp-name1))))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) nil) (goto-char (point-min)) (should (looking-at-p - (rx (literal (file-name-as-directory tmp-name1)))))) + (tramp-compat-rx (literal (file-name-as-directory tmp-name1)))))) (with-temp-buffer (insert-directory tmp-name1 "-al") (goto-char (point-min)) (should - (looking-at-p (rx bol (+ nonl) blank (literal tmp-name1) eol)))) + (looking-at-p + (tramp-compat-rx bol (+ nonl) blank (literal tmp-name1) eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) "-al") (goto-char (point-min)) (should (looking-at-p - (rx bol (+ nonl) blank (literal tmp-name1) "/" eol)))) + (tramp-compat-rx + bol (+ nonl) blank (literal tmp-name1) "/" eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) @@ -3312,15 +3315,17 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (should (re-search-forward - (rx (literal - (file-relative-name - tmp-name1 ert-remote-temporary-file-directory))))) + (tramp-compat-rx + (literal + (file-relative-name + tmp-name1 ert-remote-temporary-file-directory))))) (goto-char (point-min)) (should (re-search-forward - (rx (literal - (file-relative-name - tmp-name2 ert-remote-temporary-file-directory)))))) + (tramp-compat-rx + (literal + (file-relative-name + tmp-name2 ert-remote-temporary-file-directory)))))) (kill-buffer buffer) ;; Check for expanded directory and file names. @@ -3332,16 +3337,18 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (should (re-search-forward - (rx (literal - (file-relative-name - tmp-name3 ert-remote-temporary-file-directory))))) + (tramp-compat-rx + (literal + (file-relative-name + tmp-name3 ert-remote-temporary-file-directory))))) (goto-char (point-min)) (should (re-search-forward - (rx (literal - (file-relative-name - tmp-name4 - ert-remote-temporary-file-directory)))))) + (tramp-compat-rx + (literal + (file-relative-name + tmp-name4 + ert-remote-temporary-file-directory)))))) (kill-buffer buffer) ;; Check for special characters. @@ -3360,16 +3367,18 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (should (re-search-forward - (rx (literal - (file-relative-name - tmp-name3 ert-remote-temporary-file-directory))))) + (tramp-compat-rx + (literal + (file-relative-name + tmp-name3 ert-remote-temporary-file-directory))))) (goto-char (point-min)) (should (re-search-forward - (rx (literal - (file-relative-name - tmp-name4 - ert-remote-temporary-file-directory)))))) + (tramp-compat-rx + (literal + (file-relative-name + tmp-name4 + ert-remote-temporary-file-directory)))))) (kill-buffer buffer)) ;; Cleanup. @@ -3599,6 +3608,9 @@ This tests also `access-file', `file-readable-p', (cons '(nil "perl" nil) tramp-connection-properties))) (progn + ;; `ert-test-result-duration' exists since Emacs 27. It + ;; doesn't hurt to call it unconditionally, because + ;; `skip-unless' hides the error. (skip-unless (< (ert-test-result-duration result) 300)) (funcall (ert-test-body ert-test))) (ert-skip (format "Test `%s' must run before" ',test))))) @@ -3627,6 +3639,9 @@ This tests also `access-file', `file-readable-p', (nil "id" nil)) tramp-connection-properties))) (progn + ;; `ert-test-result-duration' exists since Emacs 27. It + ;; doesn't hurt to call it unconditionally, because + ;; `skip-unless' hides the error. (skip-unless (< (ert-test-result-duration result) 300)) (funcall (ert-test-body ert-test))) (ert-skip (format "Test `%s' must run before" ',test))))) @@ -3653,6 +3668,9 @@ This tests also `access-file', `file-readable-p', (nil "readlink" nil)) tramp-connection-properties))) (progn + ;; `ert-test-result-duration' exists since Emacs 27. It + ;; doesn't hurt to call it unconditionally, because + ;; `skip-unless' hides the error. (skip-unless (< (ert-test-result-duration result) 300)) (funcall (ert-test-body ert-test))) (ert-skip (format "Test `%s' must run before" ',test))))) @@ -5679,7 +5697,7 @@ INPUT, if non-nil, is a string sent to the process." ;; Variable is set. (should (string-match-p - (rx (literal envvar)) + (tramp-compat-rx (literal envvar)) (funcall this-shell-command-to-string "set")))) (unless (tramp-direct-async-process-p) @@ -5706,7 +5724,7 @@ INPUT, if non-nil, is a string sent to the process." ;; Variable is unset. (should-not (string-match-p - (rx (literal envvar)) + (tramp-compat-rx (literal envvar)) ;; We must remove PS1, the output is truncated otherwise. ;; We must suppress "_=VAR...". (funcall @@ -6598,7 +6616,7 @@ This is used in tests which we don't want to tag :body nil :tags '(:tramp-asynchronous-processes)))) ;; tramp-adb.el cannot apply multi-byte commands. (not (and (tramp--test-adb-p) - (string-match-p (rx multibyte) default-directory))))) + (string-match-p (tramp-compat-rx multibyte) default-directory))))) (defun tramp--test-crypt-p () "Check, whether the remote directory is encrypted." @@ -6906,14 +6924,14 @@ This requires restrictions of file name syntax." (should (string-equal (caar (directory-files-and-attributes - file1 nil (rx (literal elt1)))) + file1 nil (tramp-compat-rx (literal elt1)))) elt1)) (should (string-equal (funcall (if quoted #'tramp-compat-file-name-quote #'identity) (cadr (car (directory-files-and-attributes - file1 nil (rx (literal elt1)))))) + file1 nil (tramp-compat-rx (literal elt1)))))) (file-remote-p (file-truename file2) 'localname))) (delete-file file3) (should-not (file-exists-p file3)))) @@ -6968,8 +6986,9 @@ This requires restrictions of file name syntax." (goto-char (point-min)) (should (re-search-forward - (rx bol (literal envvar) - "=" (literal (getenv envvar)) eol)))))))) + (tramp-compat-rx + bol (literal envvar) + "=" (literal (getenv envvar)) eol)))))))) ;; Cleanup. (ignore-errors (kill-buffer buffer)) @@ -7511,9 +7530,10 @@ process sentinels. They shall not disturb each other." (dolist (tm '(t nil)) (should (string-match-p - (rx "Tramp loaded: nil" (+ (any "\n\r")) - "Tramp loaded: nil" (+ (any "\n\r")) - "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r"))) + (tramp-compat-rx + "Tramp loaded: nil" (+ (any "\n\r")) + "Tramp loaded: nil" (+ (any "\n\r")) + "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7558,10 +7578,11 @@ process sentinels. They shall not disturb each other." (tramp-cleanup-all-connections))")) (should (string-match-p - (rx "Loading " - (literal - (expand-file-name - "tramp-cmds" (file-name-directory (locate-library "tramp"))))) + (tramp-compat-rx + "Loading " + (literal + (expand-file-name + "tramp-cmds" (file-name-directory (locate-library "tramp"))))) (shell-command-to-string (format "%s -batch -Q -L %s -l tramp-sh --eval %s" @@ -7665,6 +7686,7 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * file-in-directory-p ;; * file-name-case-insensitive-p ;; * tramp-get-remote-gid +;; * tramp-get-remote-groups ;; * tramp-get-remote-uid ;; * tramp-set-file-uid-gid commit 72c64dd73c93a92f91431435a0295d748588a4ed Author: Stefan Kangas Date: Fri Sep 9 14:19:32 2022 +0200 Fix SVG loading test for old librsvg 2.40.1 * test/manual/image-tests.el (image-tests-load-image/svg-invalid): Fix test for old librsvg 2.40.1. (Bug#57691) diff --git a/test/manual/image-tests.el b/test/manual/image-tests.el index 9cb98252f6..c66080cf02 100644 --- a/test/manual/image-tests.el +++ b/test/manual/image-tests.el @@ -88,7 +88,8 @@ "invalid foo bar" :type svg))) (redisplay)) - (should (string-search "XML parse error" (buffer-string)))))) + ;; librsvg error: "... Start tag expected, '<' not found [3 times]" + (should (string-match "[Ee]rror.+Start tag expected" (buffer-string)))))) ;;;; image-test-size commit 0ad028c91febd0d1a6c8c47babf3dddbe06b68b4 Author: Stefan Kangas Date: Fri Sep 9 10:31:25 2022 +0200 ; Clean up recently added SVG test * test/manual/image-tests.el (image-tests-load-image/svg-invalid): Clean up. diff --git a/test/manual/image-tests.el b/test/manual/image-tests.el index c726845bd3..9cb98252f6 100644 --- a/test/manual/image-tests.el +++ b/test/manual/image-tests.el @@ -80,14 +80,15 @@ (ert-deftest image-tests-load-image/svg-invalid () (with-temp-buffer - (pop-to-buffer (current-buffer)) - (insert (propertize " " - 'display '(image :data - "invalid foo bar" - :type svg))) - (redisplay)) - (with-current-buffer "*Messages*" - (should (string-search "XML parse error" (buffer-string))))) + (let ((messages-buffer-name (buffer-name (current-buffer)))) + (with-temp-buffer + (pop-to-buffer (current-buffer)) + (insert (propertize " " + 'display '(image :data + "invalid foo bar" + :type svg))) + (redisplay)) + (should (string-search "XML parse error" (buffer-string)))))) ;;;; image-test-size commit 2d9674e865028357da69d92f18f18f0a3a8d65a0 Author: Stefan Kangas Date: Tue Aug 16 16:04:03 2022 +0200 Don't warn about some deleted variables in rst.el * lisp/textmodes/rst.el (rst-level-face-max) (rst-level-face-base-color, rst-level-face-base-light) (rst-level-face-format-light, rst-level-face-step-light) (rst-level-1-face, rst-level-2-face, rst-level-3-face) (rst-level-4-face, rst-level-5-face, rst-level-6-face): Don't issue obsoletion warnings for variables deleted in 24.3. diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index c0d4dc68af..7fe46b9628 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -3634,19 +3634,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(dolist (var '(rst-level-face-max rst-level-face-base-color - rst-level-face-base-light - rst-level-face-format-light - rst-level-face-step-light - rst-level-1-face - rst-level-2-face - rst-level-3-face - rst-level-4-face - rst-level-5-face - rst-level-6-face)) - (make-obsolete-variable var "customize the faces `rst-level-*' instead." - "24.3")) - ;; Define faces for the first 6 levels. More levels are possible, however. (defface rst-level-1 '((((background light)) (:background "grey85")) (((background dark)) (:background "grey15"))) commit ea0b913ab64c872b169a4b9dfd3e4699cb1fd637 Author: Stefan Kangas Date: Sat Jul 9 13:05:49 2022 +0200 Delete variable window-system-version obsolete since 24.3 * lisp/frame.el (window-system-version): Delete variable. * src/dispnew.c (syms_of_display) : Delete DEFVAR, obsolete since 24.3. (init_display_interactive, syms_of_display_for_pdumper): * src/msdos.c (internal_terminal_init): * src/nsterm.m (ns_term_init): * src/pgtkfns.c (pgtk_display_info_for_name): * src/w32fns.c (w32_display_info_for_name, Fx_open_connection): * src/xfns.c (x_display_info_for_name, Fx_open_connection): Don't set above deleted variable. * admin/admin.el (set-version): Don't update above deleted variable in msdos.c. * lisp/textmodes/artist.el (artist-submit-bug-report): Don't use above deleted variable. diff --git a/admin/admin.el b/admin/admin.el index c84287a702..fececc86a4 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -124,9 +124,6 @@ Root must be the root of an Emacs source tree." ;; Major version only. (when (string-match "\\([0-9]\\{2,\\}\\)" version) (let ((newmajor (match-string 1 version))) - (set-version-in-file root "src/msdos.c" newmajor - (rx (and "Vwindow_system_version" (1+ not-newline) - ?\( (submatch (1+ (in "0-9"))) ?\)))) (set-version-in-file root "etc/refcards/ru-refcard.tex" newmajor "\\\\newcommand{\\\\versionemacs}\\[0\\]\ {\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs"))) diff --git a/etc/NEWS b/etc/NEWS index 7005e290b3..97a476ae08 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2715,8 +2715,8 @@ but switching to `ash` is generally much preferable. 'url-recreate-url-attributes', 'user-variable-p', 'vc-string-prefix-p', 'vc-toggle-read-only', 'view-return-to-alist', 'view-return-to-alist-update', 'w32-default-color-map' (function), -'which-func-mode' (function), 'winner-mode-leave-hook', -'x-cut-buffer-or-selection-value'. +'which-func-mode' (function), 'window-system-version', +'winner-mode-leave-hook', 'x-cut-buffer-or-selection-value'. --- ** Some functions and variables obsolete since Emacs 23 have been removed: diff --git a/lisp/frame.el b/lisp/frame.el index 9361683c28..ae8449d0ea 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -3050,10 +3050,6 @@ See also `toggle-frame-maximized'." (make-variable-buffer-local 'show-trailing-whitespace) -;; Defined in dispnew.c. -(make-obsolete-variable - 'window-system-version "it does not give useful information." "24.3") - (defun set-frame-property--interactive (prompt number) "Get a value for `set-frame-width' or `set-frame-height', prompting with PROMPT. Offer NUMBER as default value, if it is a natural number." diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 2cf9ded04b..76675328da 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -5341,8 +5341,6 @@ The event, EV, is the mouse event." (require 'reporter) (if (y-or-n-p "Do you want to submit a bug report on Artist? ") (let ((vars '(window-system - window-system-version - ;; artist-rubber-banding artist-interface-with-rect artist-aspect-ratio diff --git a/src/dispnew.c b/src/dispnew.c index 53a47c4b2f..8932f103f1 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6504,9 +6504,6 @@ init_display_interactive (void) if (!inhibit_window_system && display_arg) { Vinitial_window_system = Qx; -#ifdef HAVE_X11 - Vwindow_system_version = make_fixnum (11); -#endif #ifdef USE_NCURSES /* In some versions of ncurses, tputs crashes if we have not called tgetent. @@ -6521,7 +6518,6 @@ init_display_interactive (void) if (!inhibit_window_system) { Vinitial_window_system = Qw32; - Vwindow_system_version = make_fixnum (1); return; } #endif /* HAVE_NTGUI */ @@ -6530,7 +6526,6 @@ init_display_interactive (void) if (!inhibit_window_system && !will_dump_p ()) { Vinitial_window_system = Qns; - Vwindow_system_version = make_fixnum (10); return; } #endif @@ -6539,7 +6534,6 @@ init_display_interactive (void) if (!inhibit_window_system && !will_dump_p ()) { Vinitial_window_system = Qpgtk; - Vwindow_system_version = make_fixnum (3); return; } #endif @@ -6548,7 +6542,6 @@ init_display_interactive (void) if (!inhibit_window_system && !will_dump_p ()) { Vinitial_window_system = Qhaiku; - Vwindow_system_version = make_fixnum (1); return; } #endif @@ -6766,10 +6759,6 @@ Use of this variable as a boolean is deprecated. Instead, use `display-graphic-p' or any of the other `display-*-p' predicates which report frame's specific UI-related capabilities. */); - DEFVAR_LISP ("window-system-version", Vwindow_system_version, - doc: /* The version number of the window system in use. -For X windows, this is 11. */); - DEFVAR_BOOL ("cursor-in-echo-area", cursor_in_echo_area, doc: /* Non-nil means put cursor in minibuffer, at end of any message there. */); @@ -6817,5 +6806,4 @@ static void syms_of_display_for_pdumper (void) { Vinitial_window_system = Qnil; - Vwindow_system_version = Qnil; } diff --git a/src/msdos.c b/src/msdos.c index 1608245904..1d3fdd528d 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1794,7 +1794,6 @@ internal_terminal_init (void) } Vinitial_window_system = Qpc; - Vwindow_system_version = make_fixnum (29); /* RE Emacs version */ tty->terminal->type = output_msdos_raw; /* If Emacs was dumped on DOS/V machine, forget the stale VRAM diff --git a/src/nsterm.m b/src/nsterm.m index d6290449b4..b8b4e66cd1 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5607,17 +5607,6 @@ Needs to be here because ns_initialize_display_info () uses AppKit classes. NSTRACE_MSG ("Versions"); - { -#ifdef NS_IMPL_GNUSTEP - Vwindow_system_version = build_string (gnustep_base_version); -#else - /* PSnextrelease (128, c); */ - char c[DBL_BUFSIZE_BOUND]; - int len = dtoastr (c, sizeof c, 0, 0, NSAppKitVersionNumber); - Vwindow_system_version = make_unibyte_string (c, len); -#endif - } - delete_keyboard_wait_descriptor (0); ns_app_name = [[NSProcessInfo processInfo] processName]; diff --git a/src/pgtkfns.c b/src/pgtkfns.c index beaf28f69d..9473e14f5c 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -164,8 +164,6 @@ pgtk_display_info_for_name (Lisp_Object name) if (dpyinfo == 0) error ("Cannot connect to display server %s", SDATA (name)); - XSETFASTINT (Vwindow_system_version, 11); - return dpyinfo; } diff --git a/src/w32fns.c b/src/w32fns.c index 28d13a68d4..745458d0a0 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -6699,8 +6699,6 @@ w32_display_info_for_name (Lisp_Object name) if (dpyinfo == 0) error ("Cannot connect to server %s", SDATA (name)); - XSETFASTINT (Vwindow_system_version, w32_major_version); - return dpyinfo; } @@ -6781,7 +6779,6 @@ DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, error ("Cannot connect to server %s", SDATA (display)); } - XSETFASTINT (Vwindow_system_version, w32_major_version); return Qnil; } diff --git a/src/xfns.c b/src/xfns.c index fc8b30a9d6..ecb869bf36 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -7250,8 +7250,6 @@ x_display_info_for_name (Lisp_Object name) if (dpyinfo == 0) error ("Cannot connect to X server %s", SDATA (name)); - XSETFASTINT (Vwindow_system_version, 11); - return dpyinfo; } @@ -7295,7 +7293,6 @@ An insecure way to solve the problem may be to use `xhost'.\n", error ("Cannot connect to X server %s", SDATA (display)); } - XSETFASTINT (Vwindow_system_version, 11); return Qnil; } commit 1f29ee2d21b57e81a28550a1b31bc8a39406d17b Author: Stefan Kangas Date: Sun Jul 10 13:27:36 2022 +0200 Delete many items obsolete since 24.3 * lisp/allout.el (allout-exposure-change-hook) (allout-structure-added-hook, allout-structure-deleted-hook) (allout-structure-shifted-hook): * lisp/arc-mode.el (archive-extract-hooks): * lisp/buff-menu.el (Buffer-menu-buffer+size-width): * lisp/calendar/timeclock.el (timeclock-modeline-display) (timeclock-modeline-display, timeclock-update-modeline): * lisp/cedet/semantic/db-el.el (semanticdb-elisp-sym-function-arglist): * lisp/cedet/semantic/db-file.el (semanticdb-save-database-hooks): * lisp/cedet/semantic/edit.el (semantic-change-hooks) (semantic-edits-new-change-hooks) (semantic-edits-delete-change-hooks) (semantic-edits-reparse-change-hooks): * lisp/cedet/semantic/lex.el (semantic-lex-reset-hooks): * lisp/comint.el (comint--unquote&expand-filename) (comint-unquote-filename): * lisp/custom.el (user-variable-p): * lisp/dired.el (dired-shrink-to-fit, dired-pop-to-buffer) (dired-sort-set-modeline): * lisp/ebuff-menu.el (Electric-buffer-menu-mode): * lisp/emacs-lisp/byte-run.el (macro-declaration-function): * lisp/emacs-lisp/checkdoc.el (custom-print-functions) (checkdoc-comment-style-hooks): * lisp/emacs-lisp/cl-lib.el (custom-print-functions): * lisp/emacs-lisp/edebug.el (gud-inhibit-global-bindings): * lisp/erc/erc-dcc.el (erc-dcc-chat-filter-hook): * lisp/eshell/esh-mode.el (eshell-status-in-modeline): * lisp/eshell/eshell.el (eshell-add-to-window-buffer-names) (eshell-remove-from-window-buffer-names): * lisp/faces.el (set-face-underline-p, font-list-limit): * lisp/files.el (automount-dir-prefix, toggle-read-only): * lisp/filesets.el (filesets-cache-fill-content-hooks): * lisp/frame.el (automatic-hscrolling): * lisp/generic-x.el (javascript-generic-mode) (javascript-generic-mode-hook): * lisp/gnus/gnus-start.el (gnus-subscribe-newsgroup-hooks): * lisp/gnus/nndiary.el (nndiary-request-create-group-hooks) (nndiary-request-update-info-hooks) (nndiary-request-accept-article-hooks): * lisp/htmlfontify.el (hfy-post-html-hooks): * lisp/international/mule-cmds.el (inactivate-current-input-method-function) (inactivate-input-method, input-method-inactivate-hook) (ucs-insert): * lisp/international/quail.el (quail-inactivate) (quail-inactivate-hook): * lisp/international/robin.el (robin-inactivate) (robin-inactivate-hook): * lisp/leim/quail/hangul.el (hangul-input-method-inactivate): * lisp/leim/quail/uni-input.el (ucs-input-inactivate): * lisp/mail/emacsbug.el (report-emacs-bug-info): * lisp/mh-e/mh-e.el (mh-kill-folder-suppress-prompt-hooks): * lisp/mpc.el (mpc-string-prefix-p): * lisp/net/rcirc.el (rcirc-print-hooks, rcirc-sentinel-hooks) (rcirc-receive-message-hooks, rcirc-activity-hooks): * lisp/obsolete/crisp.el (crisp-mode-modeline-string): * lisp/pcomplete.el (pcomplete-arg-quote-list) (pcomplete-quote-argument): * lisp/progmodes/cc-mode.el (c-prepare-bug-report-hooks): * lisp/progmodes/python.el (python-info-ppss-context) (python-info-ppss-context-type) (python-info-ppss-comment-or-string-p, python-indent) (python-guess-indent, python-buffer, python-preoutput-result) (python-proc, python-send-receive, python-send-string) (python-use-skeletons): * lisp/progmodes/sh-script.el (sh-maybe-here-document): * lisp/replace.el (query-replace-interactive): * lisp/strokes.el (strokes-modeline-string): * lisp/subr.el (redraw-modeline): * lisp/term.el (term-default-fg-color, term-default-bg-color): * lisp/textmodes/tex-mode.el (latex-string-prefix-p) (tex-string-prefix-p): * lisp/url/url-parse.el (url-recreate-url-attributes): * lisp/vc/add-log.el (change-log-acknowledgement): * lisp/vc/ediff-wind.el (ediff-choose-window-setup-function-automatically): * lisp/vc/pcvs-util.el (cvs-string-prefix-p): * lisp/vc/vc.el (vc-string-prefix-p): * lisp/window.el (display-buffer-function): * lisp/winner.el (winner-mode-leave-hook): Remove many functions and variables obsolete since 24.3. * lisp/buff-menu.el (list-buffers--refresh): * lisp/dired.el (dired-mode-map): * lisp/files.el (abbreviate-file-name): * lisp/generic-x.el (generic-default-modes): * lisp/mh-e/mh-funcs.el (mh-kill-folder): * lisp/progmodes/hideif.el (hide-ifdef-mode-submap): * lisp/replace.el (query-replace-read-from): * lisp/term.el (term): * lisp/window.el (display-buffer): Don't use above deleted functions and variables. * src/marker.c (Fbuffer_has_markers_at): Delete DEFUN obsolete since 24.3. (syms_of_marker) : Delete defsubr. * lisp/subr.el (buffer-has-markers-at): Remove obsoletion of above deleted DEFUN. * etc/TODO: Doc fix; don't mention above deleted function. * admin/cus-test.el (cus-test-get-options): * lisp/pcomplete.el: Doc fixes; don't mention removed items. ; * etc/NEWS: List removed items. diff --git a/admin/cus-test.el b/admin/cus-test.el index 5894abed3d..22d5a3a151 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -272,7 +272,7 @@ currently defined groups." (if group (memq symbol groups) (or - ;; (user-variable-p symbol) + ;; (custom-variable-p symbol) (get symbol 'standard-value) ;; (get symbol 'saved-value) (get symbol 'custom-type))) diff --git a/etc/NEWS b/etc/NEWS index bf24665ee4..7005e290b3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2621,55 +2621,102 @@ but switching to `ash` is generally much preferable. --- ** Some functions and variables obsolete since Emacs 24 have been removed: +'Buffer-menu-buffer+size-width', 'Electric-buffer-menu-mode', 'Info-edit-map', 'allout-abbreviate-flattened-numbering', -'allout-mode-deactivate-hook', 'ansi-color-unfontify-region', -'auth-source-forget-user-or-password', 'auth-source-hide-passwords', -'auth-source-user-or-password', 'bibtex-complete', -'bibtex-entry-field-alist', 'buffer-substring-filters', -'byte-compile-disable-print-circle', 'cfengine-mode-abbrevs', -'chart-map', 'comint-dynamic-complete', -'comint-dynamic-complete-as-filename', -'comint-dynamic-simple-complete', 'command-history-map', -'compilation-parse-errors-function', 'completion-annotate-function', -'condition-case-no-debug', 'count-lines-region', 'data-debug-map', -'deferred-action-list', 'deferred-action-function', -'dired-x-submit-report', 'eieio-defgeneric', 'eieio-defmethod', -'emacs-lock-from-exiting', 'erc-complete-word', -'eshell-cmpl-suffix-list', 'eshell-for', 'font-lock-maximum-size', +'allout-exposure-change-hook', 'allout-mode-deactivate-hook', +'allout-structure-added-hook', 'allout-structure-deleted-hook', +'allout-structure-shifted-hook', 'ansi-color-unfontify-region', +'archive-extract-hooks', 'auth-source-forget-user-or-password', +'auth-source-hide-passwords', 'auth-source-user-or-password', +'automatic-hscrolling', 'automount-dir-prefix', 'bibtex-complete', +'bibtex-entry-field-alist', 'buffer-has-markers-at', +'buffer-substring-filters', 'byte-compile-disable-print-circle', +'c-prepare-bug-report-hooks', 'cfengine-mode-abbrevs', +'change-log-acknowledgement', 'chart-map', +'checkdoc-comment-style-hooks', 'comint--unquote&expand-filename', +'comint-dynamic-complete', 'comint-dynamic-complete-as-filename', +'comint-dynamic-simple-complete', 'comint-unquote-filename', +'command-history-map', 'compilation-parse-errors-function', +'completion-annotate-function', 'condition-case-no-debug', +'count-lines-region', 'crisp-mode-modeline-string', +'custom-print-functions', 'custom-print-functions', +'cvs-string-prefix-p', 'data-debug-map', 'deferred-action-function', +'deferred-action-list', 'dired-pop-to-buffer', 'dired-shrink-to-fit', +'dired-sort-set-modeline', 'dired-x-submit-report', +'display-buffer-function', +'ediff-choose-window-setup-function-automatically', +'eieio-defgeneric', 'eieio-defmethod', 'emacs-lock-from-exiting', +'erc-complete-word', 'erc-dcc-chat-filter-hook', +'eshell-add-to-window-buffer-names', 'eshell-cmpl-suffix-list', +'eshell-for', 'eshell-remove-from-window-buffer-names', +'eshell-status-in-modeline', 'filesets-cache-fill-content-hooks', +'font-list-limit', 'font-lock-maximum-size', 'font-lock-reference-face', 'gnus-carpal', 'gnus-debug-exclude-variables', 'gnus-debug-files', 'gnus-local-domain', 'gnus-outgoing-message-group', -'gnus-secondary-servers', 'gnus-registry-user-format-function-M', +'gnus-registry-user-format-function-M', 'gnus-secondary-servers', +'gnus-subscribe-newsgroup-hooks', 'gud-inhibit-global-bindings', +'hangul-input-method-inactivate', 'hfy-post-html-hooks', 'image-extension-data', 'image-library-alist', +'inactivate-current-input-method-function', 'inactivate-input-method', 'inhibit-first-line-modes-regexps', -'inhibit-first-line-modes-suffixes', 'intdos', -'mail-complete-function', 'mail-completion-at-point-function', +'inhibit-first-line-modes-suffixes', 'input-method-inactivate-hook', +'intdos', 'javascript-generic-mode', 'javascript-generic-mode-hook', +'latex-string-prefix-p', 'macro-declaration-function' (function), +'macro-declaration-function' (variable), 'mail-complete-function', +'mail-completion-at-point-function', 'mail-mailer-swallows-blank-line', 'mail-sent-via', 'make-register', 'makefile-complete', 'menu-bar-kill-ring-save', 'meta-complete-symbol', 'meta-mode-map', +'mh-kill-folder-suppress-prompt-hooks', 'minibuffer-completing-symbol', 'minibuffer-local-filename-must-match-map', 'mode25', 'mode4350', -'msb-after-load-hooks', 'nnimap-split-rule', 'nntp-authinfo-file', -'ns-alternatives-map', 'ns-store-cut-buffer-internal', -'package-menu-view-commentary', 'pascal-last-completions', -'pascal-show-completions', 'pascal-toggle-completions', -'prolog-char-quote-workaround', 'read-filename-at-point', +'mpc-string-prefix-p', 'msb-after-load-hooks', +'nndiary-request-accept-article-hooks', +'nndiary-request-create-group-hooks', +'nndiary-request-update-info-hooks', 'nnimap-split-rule', +'nntp-authinfo-file', 'ns-alternatives-map', +'ns-store-cut-buffer-internal', 'package-menu-view-commentary', +'pascal-last-completions', 'pascal-show-completions', +'pascal-toggle-completions', 'pcomplete-arg-quote-list', +'pcomplete-quote-argument', 'prolog-char-quote-workaround', +'python-buffer, 'python-guess-indent', 'python-indent', +'python-info-ppss-comment-or-string-p', 'python-info-ppss-context', +'python-info-ppss-context-type', 'python-preoutput-result', +'python-proc', 'python-send-receive', 'python-send-string', +'python-use-skeletons', 'quail-inactivate', 'quail-inactivate-hook', +'query-replace-interactive', 'rcirc-activity-hooks', +'rcirc-print-hooks', 'rcirc-receive-message-hooks', +'rcirc-sentinel-hooks', 'read-filename-at-point', 'redraw-modeline', 'reftex-index-map', 'reftex-index-phrases-map', 'reftex-select-bib-map', 'reftex-select-label-map', 'reftex-toc-map', -'register-name-alist', 'register-value', +'register-name-alist', 'register-value', 'report-emacs-bug-info', 'report-emacs-bug-pretest-address', 'rmail-default-dont-reply-to-names', 'rmail-dont-reply-to', -'rmail-dont-reply-to-names', 'rst-block-face', 'rst-comment-face', +'rmail-dont-reply-to-names', 'robin-inactivate', +'robin-inactivate-hook', 'rst-block-face', 'rst-comment-face', 'rst-definition-face', 'rst-directive-face', 'rst-emphasis1-face', 'rst-emphasis2-face', 'rst-external-face', 'rst-literal-face', -'rst-reference-face', 'semantic-grammar-map', -'semantic-grammar-syntax-table', 'set-register-value', -'speedbar-key-map', 'speedbar-syntax-table', -'starttls-any-program-available', 'strokes-report-bug', +'rst-reference-face', 'semantic-change-hooks', +'semantic-edits-delete-change-hooks', +'semantic-edits-new-change-hooks', +'semantic-edits-reparse-change-hooks', 'semantic-grammar-map', +'semantic-grammar-syntax-table', 'semantic-lex-reset-hooks', +'semanticdb-elisp-sym-function-arglist', +'semanticdb-save-database-hooks', 'set-face-underline-p', +'set-register-value', 'sh-maybe-here-document', 'speedbar-key-map', +'speedbar-syntax-table', 'starttls-any-program-available', +'strokes-modeline-string', 'strokes-report-bug', +'term-default-bg-color', 'term-default-fg-color', +'tex-string-prefix-p', 'timeclock-modeline-display', +'timeclock-modeline-display', 'timeclock-update-modeline', 'toggle-emacs-lock', 'tooltip-use-echo-area', 'turn-on-cwarn-mode', -'turn-on-iimage-mode', 'vc-toggle-read-only', 'view-return-to-alist', +'turn-on-iimage-mode', 'ucs-input-inactivate', 'ucs-insert', +'url-recreate-url-attributes', 'user-variable-p', +'vc-string-prefix-p', 'vc-toggle-read-only', 'view-return-to-alist', 'view-return-to-alist-update', 'w32-default-color-map' (function), -'which-func-mode' (function), 'x-cut-buffer-or-selection-value'. +'which-func-mode' (function), 'winner-mode-leave-hook', +'x-cut-buffer-or-selection-value'. --- ** Some functions and variables obsolete since Emacs 23 have been removed: diff --git a/etc/TODO b/etc/TODO index a086470ef5..5a89c47a9c 100644 --- a/etc/TODO +++ b/etc/TODO @@ -1481,8 +1481,8 @@ Markers are implemented as a non-sorted singly linked list of markers. This makes them scale badly when thousands of markers are created in a buffer for some purpose, because some low-level primitives in Emacs traverse the markers' list (e.g., when converting between character -and byte positions), and also because searching for a marker (e.g., -with 'buffer-has-markers-at') becomes very slow. +and byte positions), and also because searching for a marker becomes +very slow. **** Explore whether overlay-recenter can cure overlays performance problems diff --git a/lisp/allout.el b/lisp/allout.el index fb922608b0..5f7087829e 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1352,8 +1352,6 @@ their settings before `allout-mode' was started." "Symbol for use as allout invisible-text overlay category.") ;;;_ = allout-exposure-change-functions -(define-obsolete-variable-alias 'allout-exposure-change-hook - 'allout-exposure-change-functions "24.3") (defcustom allout-exposure-change-functions nil "Abnormal hook run after allout outline subtree exposure changes. It is run at the conclusion of `allout-flag-region'. @@ -1370,8 +1368,6 @@ This hook might be invoked multiple times by a single command." :version "24.3") ;;;_ = allout-structure-added-functions -(define-obsolete-variable-alias 'allout-structure-added-hook - 'allout-structure-added-functions "24.3") (defcustom allout-structure-added-functions nil "Abnormal hook run after adding items to an Allout outline. Functions on the hook should take two arguments: @@ -1385,8 +1381,6 @@ This hook might be invoked multiple times by a single command." :version "24.3") ;;;_ = allout-structure-deleted-functions -(define-obsolete-variable-alias 'allout-structure-deleted-hook - 'allout-structure-deleted-functions "24.3") (defcustom allout-structure-deleted-functions nil "Abnormal hook run after deleting subtrees from an Allout outline. Functions on the hook must take two arguments: @@ -1403,8 +1397,6 @@ This hook might be invoked multiple times by a single command." :version "24.3") ;;;_ = allout-structure-shifted-functions -(define-obsolete-variable-alias 'allout-structure-shifted-hook - 'allout-structure-shifted-functions "24.3") (defcustom allout-structure-shifted-functions nil "Abnormal hook run after shifting items in an Allout outline. Functions on the hook should take two arguments: diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 632ae57852..b6f7794e33 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -125,8 +125,6 @@ A non-local file is one whose file name is not proper outside Emacs. A local copy of the archive will be used when updating." :type 'regexp) -(define-obsolete-variable-alias 'archive-extract-hooks - 'archive-extract-hook "24.3") (defcustom archive-extract-hook nil "Hook run when an archive member has been extracted." :type 'hook) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 539ef673f0..abf152f058 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -54,21 +54,6 @@ :group 'Buffer-menu) (put 'Buffer-menu-buffer 'face-alias 'buffer-menu-buffer) -(defcustom Buffer-menu-buffer+size-width nil - "Combined width of buffer name and size columns in Buffer Menu. -If nil, use `Buffer-menu-name-width' and `Buffer-menu-size-width'. - -If non-nil, the value of `Buffer-menu-name-width' is overridden; -the name column is assigned width `Buffer-menu-buffer+size-width' -minus `Buffer-menu-size-width'. This use is deprecated." - :type '(choice (const nil) number) - :group 'Buffer-menu - :version "24.3") - -(make-obsolete-variable 'Buffer-menu-buffer+size-width - "use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead." - "24.3") - (defun Buffer-menu--dynamic-name-width (buffers) "Return a name column width based on the current window width. The width will never exceed the actual width of the buffer names, @@ -679,9 +664,6 @@ means list those buffers and no others." (setq name-width (if (functionp Buffer-menu-name-width) (funcall Buffer-menu-name-width (mapcar #'car entries)) Buffer-menu-name-width)) - ;; Handle obsolete variable: - (if Buffer-menu-buffer+size-width - (setq name-width (- Buffer-menu-buffer+size-width size-width))) (setq tabulated-list-format (vector '("C" 1 t :pad-right 0) '("R" 1 t :pad-right 0) diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 6b6cc517a2..e36119984b 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -137,9 +137,6 @@ This variable only has effect if set with \\[customize]." (defvar timeclock-update-timer nil "The timer used to update `timeclock-mode-string'.") -(define-obsolete-variable-alias 'timeclock-modeline-display - 'timeclock-mode-line-display "24.3") - ;; For byte-compiler. (defvar display-time-hook) (defvar timeclock-mode-line-display) @@ -259,9 +256,6 @@ The time is bracketed by <> if you are clocked in, otherwise by [].") ;;; User Functions: -(define-obsolete-function-alias 'timeclock-modeline-display - 'timeclock-mode-line-display "24.3") - ;;;###autoload (define-minor-mode timeclock-mode-line-display "Toggle display of the amount of time left today in the mode line. @@ -612,9 +606,6 @@ arguments of `completing-read'." "Ask the user for the reason they are clocking out." (completing-read "Reason for clocking out: " timeclock-reason-list)) -(define-obsolete-function-alias 'timeclock-update-modeline - 'timeclock-update-mode-line "24.3") - (defun timeclock-update-mode-line () "Update the `timeclock-mode-string' displayed in the mode line. The value of `timeclock-relative' affects the display as described in diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 02ebde4078..f72e206908 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el @@ -342,9 +342,6 @@ Return a list of tags." ) taglst)))) -(define-obsolete-function-alias 'semanticdb-elisp-sym-function-arglist - #'help-function-arglist "24.3") - (provide 'semantic/db-el) ;;; semantic/db-el.el ends here diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index e2c9d618ba..0fc6806e40 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -70,8 +70,6 @@ passes a list of predicates in `semanticdb-project-predicate-functions'." :type '(repeat (choice (string :tag "Directory") (const never) (const always) (const project)))) -(define-obsolete-variable-alias 'semanticdb-save-database-hooks - 'semanticdb-save-database-functions "24.3") (defcustom semanticdb-save-database-functions nil "Abnormal hook run after a database is saved. Each function is called with one argument, the object representing diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el index 4679500ed9..7cb6768f7e 100644 --- a/lisp/cedet/semantic/edit.el +++ b/lisp/cedet/semantic/edit.el @@ -72,8 +72,6 @@ updated in the current buffer. For language specific hooks, make sure you define this as a local hook.") -(define-obsolete-variable-alias 'semantic-change-hooks - 'semantic-change-functions "24.3") (defvar semantic-change-functions '(semantic-edits-change-function-handle-changes) "Abnormal hook run when semantic detects a change in a buffer. @@ -91,14 +89,10 @@ If the hook returns non-nil, then declare that a reparse is needed. For language specific hooks, make sure you define this as a local hook. Not used yet; part of the next generation reparse mechanism.") -(define-obsolete-variable-alias 'semantic-edits-new-change-hooks - 'semantic-edits-new-change-functions "24.3") (defvar semantic-edits-new-change-functions nil "Abnormal hook run when a new change is found. Functions must take one argument representing an overlay on that change.") -(define-obsolete-variable-alias 'semantic-edits-delete-change-hooks - 'semantic-edits-delete-change-functions "24.3") (defvar semantic-edits-delete-change-functions nil "Abnormal hook run before a change overlay is deleted. Deleted changes occur when multiple changes are merged. @@ -110,8 +104,6 @@ Changes move when a new change overlaps an old change. The old change will be moved. Functions must take one argument representing an overlay being moved.") -(define-obsolete-variable-alias 'semantic-edits-reparse-change-hooks - 'semantic-edits-reparse-change-functions "24.3") (defvar semantic-edits-reparse-change-functions nil "Abnormal hook run after a change results in a reparse. Functions are called before the overlay is deleted, and after the diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 75c4ee328d..b3c9e96538 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -718,8 +718,6 @@ This is an alist of (ANCHOR . STREAM) elements where ANCHOR is the start position of the block, and STREAM is the list of tokens in that block.") -(define-obsolete-variable-alias 'semantic-lex-reset-hooks - 'semantic-lex-reset-functions "24.3") (defvar semantic-lex-reset-functions nil "Abnormal hook used by major-modes to reset lexical analyzers. Hook functions are called with START and END values for the diff --git a/lisp/comint.el b/lisp/comint.el index 3ed04f098c..8786c6db4b 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3268,8 +3268,6 @@ See `comint-word'." (defun comint--unquote-argument (str) (car (comint--unquote&requote-argument str))) -(define-obsolete-function-alias 'comint--unquote&expand-filename - #'comint--unquote-argument "24.3") (defun comint-match-partial-filename () "Return the unquoted&expanded filename at point, or nil if none is found. @@ -3290,14 +3288,6 @@ Magic characters are those in `comint-file-name-quote-list'." (setq i (1+ (match-end 0))))) filename)))) -(defun comint-unquote-filename (filename) - "Return FILENAME with quoted characters unquoted." - (declare (obsolete nil "24.3")) - (if (null comint-file-name-quote-list) - filename - (save-match-data - (replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t)))) - (defun comint--requote-argument (upos qstr) ;; See `completion-table-with-quoting'. (let ((res (comint--unquote&requote-argument qstr upos))) diff --git a/lisp/custom.el b/lisp/custom.el index 96dfb37d86..352b5b0e16 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -674,8 +674,6 @@ property, or (ii) an alias for another customizable variable." "Return the standard value of VARIABLE." (eval (car (get variable 'standard-value)) t)) -(define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.3") - (defun custom-note-var-changed (variable) "Inform Custom that VARIABLE has been set (changed). VARIABLE is a symbol that names a user option. diff --git a/lisp/dired.el b/lisp/dired.el index facfb35ab4..b9e89292e2 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -508,15 +508,6 @@ This is what the do-commands look for, and what the mark-commands store.") (defvar dired-del-marker ?D "Character used to flag files for deletion.") -(defvar dired-shrink-to-fit t - ;; I see no reason ever to make this nil -- rms. - ;; (> baud-rate search-slow-speed) - "Non-nil means Dired shrinks the display buffer to fit the marked files.") -(make-obsolete-variable 'dired-shrink-to-fit - "use the Customization interface to add a new rule -to `display-buffer-alist' where condition regexp is \"^ \\*Marked Files\\*$\", -action argument symbol is `window-height' and its value is nil." "24.3") - (defvar dired-file-version-alist) ;;;###autoload @@ -2259,8 +2250,6 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." "M-s f C-M-s" #'dired-isearch-filenames-regexp ;; misc " " #'dired-toggle-read-only - ;; `toggle-read-only' is an obsolete alias for `read-only-mode' - " " #'dired-toggle-read-only "?" #'dired-summary "DEL" #'dired-unmark-backward " " #'dired-undo @@ -3879,28 +3868,6 @@ or \"* [3 files]\"." (format "[next %d files]" arg) (format "%c [%d files]" dired-marker-char count))))) -(defun dired-pop-to-buffer (buf) - "Pop up buffer BUF in a way suitable for Dired." - (declare (obsolete pop-to-buffer "24.3")) - (let ((split-window-preferred-function - (lambda (window) - (or (and (let ((split-height-threshold 0)) - (window-splittable-p (selected-window))) - ;; Try to split the selected window vertically if - ;; that's possible. (Bug#1806) - (split-window-below)) - ;; Otherwise, try to split WINDOW sensibly. - (split-window-sensibly window)))) - pop-up-frames) - (pop-to-buffer (get-buffer-create buf))) - ;; See Bug#12281. - (set-window-start nil (point-min)) - ;; If dired-shrink-to-fit is t, make its window fit its contents. - (when dired-shrink-to-fit - ;; Try to not delete window when we want to display less than - ;; `window-min-height' lines. - (fit-window-to-buffer (get-buffer-window buf) nil 1 nil nil t))) - (defcustom dired-no-confirm nil "A list of symbols for commands Dired should not confirm, or t. Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress', @@ -4590,9 +4557,6 @@ Possible values: (t (concat "Dired " dired-actual-switches)))))) (force-mode-line-update))) -(define-obsolete-function-alias 'dired-sort-set-modeline - #'dired-sort-set-mode-line "24.3") - (defun dired-sort-toggle-or-edit (&optional arg) "Toggle sorting by date, and refresh the Dired buffer. With a prefix argument, edit the current listing switches instead." diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index 2b1fc916d9..809a31d457 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el @@ -203,9 +203,6 @@ See the documentation of `electric-buffer-list' for details." (setq mode-line-buffer-identification "Electric Buffer List") (setq-local Helper-return-blurb "return to buffer editing")) -(define-obsolete-function-alias 'Electric-buffer-menu-mode - #'electric-buffer-menu-mode "24.3") - ;; generally the same as Buffer-menu-mode-map ;; (except we don't indirect to global-map) (put 'Electric-buffer-menu-undefined 'suppress-keymap t) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 9a56ba0f7a..9db84c31b8 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -112,44 +112,6 @@ So far, FUNCTION can only be a symbol, not a lambda expression." (function-put 'defmacro 'doc-string-elt 3) (function-put 'defmacro 'lisp-indent-function 2) -;; `macro-declaration-function' are both obsolete (as marked at the end of this -;; file) but used in many .elc files. - -;; We don't use #' here, because it's an obsolete function, and we -;; can't use `with-suppressed-warnings' here due to how this file is -;; used in the bootstrapping process. -(defvar macro-declaration-function 'macro-declaration-function - "Function to process declarations in a macro definition. -The function will be called with two args MACRO and DECL. -MACRO is the name of the macro being defined. -DECL is a list `(declare ...)' containing the declarations. -The value the function returns is not used.") - -(defalias 'macro-declaration-function - #'(lambda (macro decl) - "Process a declaration found in a macro definition. -This is set as the value of the variable `macro-declaration-function'. -MACRO is the name of the macro being defined. -DECL is a list `(declare ...)' containing the declarations. -The return value of this function is not used." - ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons. - (let (d) - ;; Ignore the first element of `decl' (it's always `declare'). - (while (setq decl (cdr decl)) - (setq d (car decl)) - (if (and (consp d) - (listp (cdr d)) - (null (cdr (cdr d)))) - (cond ((eq (car d) 'indent) - (put macro 'lisp-indent-function (car (cdr d)))) - ((eq (car d) 'debug) - (put macro 'edebug-form-spec (car (cdr d)))) - ((eq (car d) 'doc-string) - (put macro 'doc-string-elt (car (cdr d)))) - (t - (message "Unknown declaration %s" d))) - (message "Invalid declaration %s" d)))))) - ;; We define macro-declaration-alist here because it is needed to ;; handle declarations in macro definitions and this is the first file ;; loaded by loadup.el that uses declarations in macros. We specify @@ -771,9 +733,4 @@ type is. This defaults to \"INFO\"." ;; (file-format emacs19))" ;; nil) -(make-obsolete-variable 'macro-declaration-function - 'macro-declarations-alist "24.3") -(make-obsolete 'macro-declaration-function - 'macro-declarations-alist "24.3") - ;;; byte-run.el ends here diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index a5ab3a50ff..20d64b5915 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -281,8 +281,6 @@ Currently, all recognized keywords must be on `finder-known-keywords'." :version "25.1" :type 'boolean) -(define-obsolete-variable-alias 'checkdoc-style-hooks - 'checkdoc-style-functions "24.3") (defvar checkdoc-style-functions nil "Hook run after the standard style check is completed. All functions must return nil or a string representing the error found. @@ -292,8 +290,6 @@ Each hook is called with two parameters, (DEFUNINFO ENDPOINT). DEFUNINFO is the return value of `checkdoc-defun-info'. ENDPOINT is the location of end of the documentation string.") -(define-obsolete-variable-alias 'checkdoc-comment-style-hooks - 'checkdoc-comment-style-functions "24.3") (defvar checkdoc-comment-style-functions nil "Hook run after the standard comment style check is completed. Must return nil if no errors are found, or a string describing the diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index a54fa21fa9..b83b44974d 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -89,12 +89,6 @@ (defvar cl--optimize-speed 1) (defvar cl--optimize-safety 1) -;;;###autoload -(define-obsolete-variable-alias - ;; This alias is needed for compatibility with .elc files that use defstruct - ;; and were compiled with Emacs<24.3. - 'custom-print-functions 'cl-custom-print-functions "24.3") - ;;;###autoload (defvar cl-custom-print-functions nil "This is a list of functions that format user objects for printing. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 9de8999fdf..763848c0c9 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3791,9 +3791,6 @@ limited by `edebug-print-length' or `edebug-print-level'." ;;; Edebug Minor Mode -(define-obsolete-variable-alias 'gud-inhibit-global-bindings - 'edebug-inhibit-emacs-lisp-mode-bindings "24.3") - (defvar edebug-inhibit-emacs-lisp-mode-bindings nil "If non-nil, inhibit Edebug bindings on the C-x C-a key. By default, loading the `edebug' library causes these bindings to diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index dd70bfb7b7..90a10766c4 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -1108,9 +1108,6 @@ Possible values are: ask, auto, ignore." (pcomplete-here '("auto" "ask" "ignore"))) (defalias 'pcomplete/erc-mode/SREQ #'pcomplete/erc-mode/CREQ) -(define-obsolete-variable-alias 'erc-dcc-chat-filter-hook - 'erc-dcc-chat-filter-functions "24.3") - (defvar erc-dcc-chat-filter-functions '(erc-dcc-chat-parse-output) "Abnormal hook run after parsing (and maybe inserting) a DCC message. Each function is called with two arguments: the ERC process and diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index ecbcf88b97..69069183a3 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -175,9 +175,6 @@ This is used by `eshell-watch-for-password-prompt'." "A function called from beginning of line to skip the prompt." :type '(choice (const nil) function)) -(define-obsolete-variable-alias 'eshell-status-in-modeline - 'eshell-status-in-mode-line "24.3") - (defcustom eshell-status-in-mode-line t "If non-nil, let the user know a command is running in the mode line." :type 'boolean) diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index 2c472a2afa..e0c927cad4 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -194,17 +194,6 @@ shells such as bash, zsh, rc, 4dos." ;; The following user options modify the behavior of Eshell overall. (defvar eshell-buffer-name) -(defun eshell-add-to-window-buffer-names () - "Add `eshell-buffer-name' to `same-window-buffer-names'." - (declare (obsolete nil "24.3")) - (add-to-list 'same-window-buffer-names eshell-buffer-name)) - -(defun eshell-remove-from-window-buffer-names () - "Remove `eshell-buffer-name' from `same-window-buffer-names'." - (declare (obsolete nil "24.3")) - (setq same-window-buffer-names - (delete eshell-buffer-name same-window-buffer-names))) - (defcustom eshell-load-hook nil "A hook run once Eshell has been loaded." :type 'hook diff --git a/lisp/faces.el b/lisp/faces.el index f1d8f82fec..e171b32e31 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1001,9 +1001,6 @@ Use `set-face-attribute' to \"unspecify\" underlining." (interactive (read-face-and-attribute :underline)) (set-face-attribute face frame :underline underline)) -(define-obsolete-function-alias 'set-face-underline-p - 'set-face-underline "24.3") - (defun set-face-inverse-video (face inverse-video-p &optional frame) "Specify whether face FACE is in inverse video. @@ -3174,12 +3171,6 @@ also the same size as FACE on FRAME, or fail." (car fonts)) (frame-parameter nil 'font))) -(defcustom font-list-limit 100 - "This variable is obsolete and has no effect." - :type 'integer - :group 'display) -(make-obsolete-variable 'font-list-limit nil "24.3") - (define-obsolete-function-alias 'face-background-pixmap #'face-stipple "29.1") (define-obsolete-function-alias 'set-face-background-pixmap #'set-face-stipple "29.1") diff --git a/lisp/files.el b/lisp/files.el index b084dca8b7..540bc2a6a8 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2079,12 +2079,6 @@ this function prepends a \"|\" to the final result if necessary." (uniquify--create-file-buffer-advice buf filename) buf)) -(defcustom automount-dir-prefix (purecopy "^/tmp_mnt/") - "Regexp to match the automounter prefix in a directory name." - :group 'files - :type 'regexp) -(make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.3") - (defvar abbreviated-home-dir nil "Regexp matching the user's homedir at the beginning of file name. The value includes abbreviation according to `directory-abbrev-alist'.") @@ -2092,8 +2086,7 @@ The value includes abbreviation according to `directory-abbrev-alist'.") (defun abbreviate-file-name (filename) "Return a version of FILENAME shortened using `directory-abbrev-alist'. This also substitutes \"~\" for the user's home directory (unless the -home directory is a root directory) and removes automounter prefixes -\(see the variable `automount-dir-prefix'). +home directory is a root directory). When this function is first called, it caches the user's home directory as a regexp in `abbreviated-home-dir', and reuses it @@ -2104,11 +2097,6 @@ started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)." (save-match-data ;FIXME: Why? (if-let ((handler (find-file-name-handler filename 'abbreviate-file-name))) (funcall handler 'abbreviate-file-name filename) - (if (and automount-dir-prefix - (string-match automount-dir-prefix filename) - (file-exists-p (file-name-directory - (substring filename (1- (match-end 0)))))) - (setq filename (substring filename (1- (match-end 0))))) ;; Avoid treating /home/foo as /home/Foo during `~' substitution. (let ((case-fold-search (file-name-case-insensitive-p filename))) ;; If any elt of directory-abbrev-alist matches this name, @@ -6100,14 +6088,6 @@ prints a message in the minibuffer. Instead, use `set-buffer-modified-p'." "Modification-flag cleared")) (set-buffer-modified-p arg)) -(defun toggle-read-only (&optional arg interactive) - "Change whether this buffer is read-only." - (declare (obsolete read-only-mode "24.3")) - (interactive (list current-prefix-arg t)) - (if interactive - (call-interactively 'read-only-mode) - (read-only-mode (or arg 'toggle)))) - (defun insert-file (filename) "Insert contents of file FILENAME into buffer after point. Set mark after the inserted text. diff --git a/lisp/filesets.el b/lisp/filesets.el index 4831bf167d..aeebd907c3 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -358,8 +358,6 @@ Don't forget to check out `filesets-menu-ensure-use-cached'." :value filesets-be-docile-flag) (sexp :tag "Other" :value nil)))) -(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks - 'filesets-cache-fill-content-hook "24.3") (defcustom filesets-cache-fill-content-hook nil "Hook run when writing the contents of filesets' cache file. diff --git a/lisp/frame.el b/lisp/frame.el index 9476cb0ec4..9361683c28 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -3048,10 +3048,6 @@ See also `toggle-frame-maximized'." ;; Misc. -;; Only marked as obsolete in 24.3. -(define-obsolete-variable-alias 'automatic-hscrolling - 'auto-hscroll-mode "22.1") - (make-variable-buffer-local 'show-trailing-whitespace) ;; Defined in dispnew.c. diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 2c9d1b316e..bbc90493af 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -193,7 +193,6 @@ This hook will be installed if the variable hosts-generic-mode java-manifest-generic-mode java-properties-generic-mode - javascript-generic-mode show-tabs-generic-mode vrml-generic-mode) "List of generic modes that are defined by default.") @@ -489,12 +488,6 @@ like an INI file. You can add this hook to `find-file-hook'." nil "Generic mode for Sys V pkginfo files.")) -;; Javascript mode -;; Obsolete; defer to js-mode from js.el. -(when (memq 'javascript-generic-mode generic-extras-enable-list) - (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3") - (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3")) - ;; VRML files (when (memq 'vrml-generic-mode generic-extras-enable-list) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 7700e6bd43..8d9e50059f 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -294,8 +294,6 @@ claim them." function (repeat function))) -(define-obsolete-variable-alias 'gnus-subscribe-newsgroup-hooks - 'gnus-subscribe-newsgroup-functions "24.3") (defcustom gnus-subscribe-newsgroup-functions nil "Hooks run after you subscribe to a new group. The hooks will be called with new group's name as argument." diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 27204b3618..ab9c6dd74f 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -165,22 +165,16 @@ In order to make this clear, here are some examples: :type 'boolean) -(define-obsolete-variable-alias 'nndiary-request-create-group-hooks - 'nndiary-request-create-group-functions "24.3") (defcustom nndiary-request-create-group-functions nil "Hook run after `nndiary-request-create-group' is executed. The hook functions will be called with the full group name as argument." :type 'hook) -(define-obsolete-variable-alias 'nndiary-request-update-info-hooks - 'nndiary-request-update-info-functions "24.3") (defcustom nndiary-request-update-info-functions nil "Hook run after `nndiary-request-update-info' is executed. The hook functions will be called with the full group name as argument." :type 'hook) -(define-obsolete-variable-alias 'nndiary-request-accept-article-hooks - 'nndiary-request-accept-article-functions "24.3") (defcustom nndiary-request-accept-article-functions nil "Hook run before accepting an article. Executed near the beginning of `nndiary-request-accept-article'. diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index bf7446f151..b1fdbd2c4a 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -226,7 +226,6 @@ to make them safe." :tag "html-quote-regex" :type '(regexp)) -(define-obsolete-variable-alias 'hfy-post-html-hooks 'hfy-post-html-hook "24.3") (defcustom hfy-post-html-hook nil "List of functions to call after creating and filling the HTML buffer. These functions will be called with the HTML buffer as the current buffer." diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 4137642528..e1d0df6e3e 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1389,9 +1389,6 @@ Maximum length of the history list is determined by the value of `history-length', which see.") (put 'input-method-history 'permanent-local t) -(define-obsolete-variable-alias - 'inactivate-current-input-method-function - 'deactivate-current-input-method-function "24.3") (defvar-local deactivate-current-input-method-function nil "Function to call for deactivating the current input method. Every input method should set this to an appropriate value when activated. @@ -1524,10 +1521,6 @@ If INPUT-METHOD is nil, deactivate any current input method." (setq current-input-method nil) (force-mode-line-update))))) -(define-obsolete-function-alias - 'inactivate-input-method - 'deactivate-input-method "24.3") - (defun set-input-method (input-method &optional interactive) "Select and activate input method INPUT-METHOD for the current buffer. This also sets the default input method to the one you specify. @@ -1741,10 +1734,6 @@ just activated." :type 'hook :group 'mule) -(define-obsolete-variable-alias - 'input-method-inactivate-hook - 'input-method-deactivate-hook "24.3") - (defcustom input-method-deactivate-hook nil "Normal hook run just after an input method is deactivated. @@ -3254,7 +3243,6 @@ single characters to be treated as standing for themselves." (error "Invalid character")) char)) -(define-obsolete-function-alias 'ucs-insert 'insert-char "24.3") (define-key ctl-x-map "8\r" 'insert-char) (define-key ctl-x-map "8e" (define-keymap diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 4bb6dbcc8e..e2ba485bbe 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -540,8 +540,6 @@ This function runs the normal hook `quail-deactivate-hook'." (interactive) (quail-activate -1)) -(define-obsolete-function-alias 'quail-inactivate 'quail-deactivate "24.3") - (defun quail-activate (&optional arg) "Activate Quail input method. With ARG, activate Quail input method if and only if arg is positive. @@ -583,10 +581,6 @@ While this input method is active, the variable (run-hooks 'quail-activate-hook) (setq-local input-method-function #'quail-input-method))) -(define-obsolete-variable-alias - 'quail-inactivate-hook - 'quail-deactivate-hook "24.3") - (defun quail-exit-from-minibuffer () (deactivate-input-method) (if (<= (minibuffer-depth) 1) diff --git a/lisp/international/robin.el b/lisp/international/robin.el index 4c498d7f92..9f0ff80e62 100644 --- a/lisp/international/robin.el +++ b/lisp/international/robin.el @@ -393,8 +393,6 @@ A nil value means no package is selected.") (interactive) (robin-activate -1)) -(define-obsolete-function-alias 'robin-inactivate 'robin-deactivate "24.3") - (defun robin-activate (&optional arg) "Activate robin input method. @@ -423,10 +421,6 @@ While this input method is active, the variable 'robin-activate-hook) (setq-local input-method-function 'robin-input-method))) -(define-obsolete-variable-alias - 'robin-inactivate-hook - 'robin-deactivate-hook "24.3") - (defun robin-exit-from-minibuffer () (deactivate-input-method) (if (<= (minibuffer-depth) 1) diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el index 83fee1e04c..89b9abe137 100644 --- a/lisp/leim/quail/hangul.el +++ b/lisp/leim/quail/hangul.el @@ -537,10 +537,6 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'." (setq describe-current-input-method-function nil)) (kill-local-variable 'input-method-function))) -(define-obsolete-function-alias - 'hangul-input-method-inactivate - #'hangul-input-method-deactivate "24.3") - (defun hangul-input-method-help () "Describe the current Hangul input method." (interactive) diff --git a/lisp/leim/quail/uni-input.el b/lisp/leim/quail/uni-input.el index 36d8e6a840..3f10b873a3 100644 --- a/lisp/leim/quail/uni-input.el +++ b/lisp/leim/quail/uni-input.el @@ -113,10 +113,6 @@ While this input method is active, the variable (interactive) (ucs-input-activate -1)) -(define-obsolete-function-alias - 'ucs-input-inactivate - #'ucs-input-deactivate "24.3") - (defun ucs-input-help () (interactive) (with-output-to-temp-buffer "*Help*" diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index d72809b186..a85ceaf1a5 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -414,8 +414,6 @@ copy text to your preferred mail program.\n" system-configuration-options "'\n\n") (fill-region (line-beginning-position -1) (point)))) -(define-obsolete-function-alias 'report-emacs-bug-info #'info-emacs-bug "24.3") - (defun report-emacs-bug-hook () "Do some checking before sending a bug report." (goto-char (point-max)) diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index f6031df9c2..0ad934107d 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -3183,8 +3183,6 @@ function used to insert the signature with :group 'mh-letter :package-version '(MH-E . "8.0")) -(define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks - 'mh-kill-folder-suppress-prompt-functions "24.3") (defcustom mh-kill-folder-suppress-prompt-functions '(mh-search-p) "Abnormal hook run at the beginning of \\\\[mh-kill-folder]. diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index ab89ef2a3d..4956d9b59f 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -101,7 +101,7 @@ a non-nil value to suppress the normal prompt when you remove a folder. This is useful for folders that are easily regenerated." (interactive) (if (or (run-hook-with-args-until-success - 'mh-kill-folder-suppress-prompt-hooks) + 'mh-kill-folder-suppress-prompt-functions) (yes-or-no-p (format "Remove folder %s (and all included messages)? " mh-current-folder))) (let ((folder mh-current-folder) diff --git a/lisp/mpc.el b/lisp/mpc.el index ba95308bf6..1775e7d5e7 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -182,8 +182,6 @@ numerically rather than lexicographically." (abs res)) res)))))))) -(define-obsolete-function-alias 'mpc-string-prefix-p #'string-prefix-p "24.3") - ;; This can speed up mpc--song-search significantly. The table may grow ;; very large, tho. It's only bounded by the fact that it gets flushed ;; whenever the connection is established; which seems to work OK thanks diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index fcef3f1010..abb67da95f 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -350,8 +350,6 @@ See `rcirc-bright-nick' face." See `rcirc-dim-nick' face." :type '(repeat string)) -(define-obsolete-variable-alias 'rcirc-print-hooks - 'rcirc-print-functions "24.3") (defcustom rcirc-print-functions nil "Hook run after text is printed. Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT." @@ -832,8 +830,6 @@ is moved to after the text inserted. Otherwise the point is not moved." text)) (goto-char old))))) -(define-obsolete-variable-alias 'rcirc-sentinel-hooks - 'rcirc-sentinel-functions "24.3") (defvar rcirc-sentinel-functions nil "Hook functions called when the process sentinel is called. Functions are called with PROCESS and SENTINEL arguments.") @@ -974,8 +970,6 @@ If BUFFER is nil, default to the current buffer." (process-list)) ps)) -(define-obsolete-variable-alias 'rcirc-receive-message-hooks - 'rcirc-receive-message-functions "24.3") (defvar rcirc-receive-message-functions nil "Hook functions run when a message is received from server. Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") @@ -2375,8 +2369,6 @@ With prefix ARG, go to the next low priority buffer with activity." "")))) (rcirc-update-activity-string)) -(define-obsolete-variable-alias 'rcirc-activity-hooks - 'rcirc-activity-functions "24.3") (defvar rcirc-activity-functions nil "Hook to be run when there is channel activity. diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el index 8424c42b69..5e1a278a2c 100644 --- a/lisp/obsolete/crisp.el +++ b/lisp/obsolete/crisp.el @@ -174,9 +174,6 @@ All the bindings are done here instead of globally to try and be nice to the world.") -(define-obsolete-variable-alias 'crisp-mode-modeline-string - 'crisp-mode-mode-line-string "24.3") - (defcustom crisp-mode-mode-line-string " *CRiSP*" "String to display in the mode line when CRiSP emulation mode is enabled." :type 'string) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 15b9880df8..0e3d1df781 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -155,9 +155,6 @@ This mirrors the optional behavior of tcsh. A non-nil value is useful if `pcomplete-autolist' is non-nil too." :type 'boolean) -(define-obsolete-variable-alias - 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3") - (defcustom pcomplete-man-function #'man "A function to that will be called to display a manual page. It will be passed the name of the command to document." @@ -364,11 +361,10 @@ modified to be an empty string, or the desired separation string." ;;; Alternative front-end using the standard completion facilities. -;; The way pcomplete-parse-arguments, pcomplete-stub, and -;; pcomplete-quote-argument work only works because of some deep -;; hypothesis about the way the completion work. Basically, it makes -;; it pretty much impossible to have completion other than -;; prefix-completion. +;; The way pcomplete-parse-arguments and pcomplete-stub work only +;; works because of some deep hypothesis about the way the completion +;; work. Basically, it makes it pretty much impossible to have +;; completion other than prefix-completion. ;; ;; pcomplete--common-suffix and completion-table-subvert try to work around ;; this difficulty with heuristics, but it's really a hack. @@ -841,9 +837,6 @@ this is `comint-dynamic-complete-functions'." (throw 'pcompleted t) pcomplete-args)))))) -(define-obsolete-function-alias - 'pcomplete-quote-argument #'comint-quote-filename "24.3") - ;; file-system completion lists (defsubst pcomplete-dirs-or-entries (&optional regexp predicate) diff --git a/lisp/proced.el b/lisp/proced.el index 52389beff7..c278cce9dc 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -1766,6 +1766,9 @@ The value returned is the value of the last form in BODY." (save-window-excursion ;; Analogous to `dired-pop-to-buffer' ;; Don't split window horizontally. (Bug#1806) + ;; FIXME: `dired-pop-to-buffer' was removed and replaced with + ;; `dired-mark-pop-up'. Should we just use + ;; `pop-to-buffer' here also? (display-buffer (current-buffer) '(display-buffer-in-direction (direction . bottom) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 9327dbf775..9309a546db 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -3148,8 +3148,6 @@ Key bindings: (message "Using CC Mode version %s" c-version) (c-keep-region-active)) -(define-obsolete-variable-alias 'c-prepare-bug-report-hooks - 'c-prepare-bug-report-hook "24.3") (defvar c-prepare-bug-report-hook nil) ;; Dynamic variables used by reporter. diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index d09e1f4cdf..53788949ea 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -196,9 +196,7 @@ Effective only if `hide-ifdef-expand-reinclusion-guard' is t." "C" #'hif-clear-all-ifdef-defined "C-q" #'hide-ifdef-toggle-read-only "C-w" #'hide-ifdef-toggle-shadowing - " " #'hide-ifdef-toggle-outside-read-only - ;; `toggle-read-only' is obsoleted by `read-only-mode'. - " " #'hide-ifdef-toggle-outside-read-only) + " " #'hide-ifdef-toggle-outside-read-only) (defcustom hide-ifdef-mode-prefix-key "\C-c@" "Prefix key for all Hide-Ifdef mode commands." diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3247d7ad50..9f9439aac6 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -528,16 +528,6 @@ The type returned can be `comment', `string' or `paren'." (eql (syntax-class (syntax-after (point))) (syntax-class (string-to-syntax ")")))) -(define-obsolete-function-alias - 'python-info-ppss-context #'python-syntax-context "24.3") - -(define-obsolete-function-alias - 'python-info-ppss-context-type #'python-syntax-context-type "24.3") - -(define-obsolete-function-alias - 'python-info-ppss-comment-or-string-p - #'python-syntax-comment-or-string-p "24.3") - (defun python-font-lock-syntactic-face-function (state) "Return syntactic face given STATE." (if (nth 3 state) @@ -953,17 +943,11 @@ It makes underscores and dots word constituent chars.") ;;; Indentation -(define-obsolete-variable-alias - 'python-indent 'python-indent-offset "24.3") - (defcustom python-indent-offset 4 "Default indentation offset for Python." :type 'integer :safe 'integerp) -(define-obsolete-variable-alias - 'python-guess-indent 'python-indent-guess-indent-offset "24.3") - (defcustom python-indent-guess-indent-offset t "Non-nil tells Python mode to guess `python-indent-offset' value." :type 'boolean @@ -3307,17 +3291,11 @@ be asked for their values." "Instead call `python-shell-get-process' and create one if returns nil." "25.1") -(define-obsolete-variable-alias - 'python-buffer 'python-shell-internal-buffer "24.3") - (defvar python-shell-internal-buffer nil "Current internal shell buffer for the current buffer. This is really not necessary at all for the code to work but it's there for compatibility with CEDET.") -(define-obsolete-variable-alias - 'python-preoutput-result 'python-shell-internal-last-output "24.3") - (defvar python-shell-internal-last-output nil "Last output captured by the internal shell. This is really not necessary at all for the code to work but it's @@ -3330,9 +3308,6 @@ there for compatibility with CEDET.") (get-process proc-name) (run-python-internal)))) -(define-obsolete-function-alias - 'python-proc #'python-shell-internal-get-or-create-process "24.3") - (defun python-shell--save-temp-file (string) (let* ((temporary-file-directory (if (file-remote-p default-directory) @@ -3449,12 +3424,6 @@ Returns the output. See `python-shell-send-string-no-output'." (replace-regexp-in-string "_emacs_out +" "" string) (python-shell-internal-get-or-create-process)))) -(define-obsolete-function-alias - 'python-send-receive #'python-shell-internal-send-string "24.3") - -(define-obsolete-function-alias - 'python-send-string #'python-shell-internal-send-string "24.3") - (defun python-shell-buffer-substring (start end &optional nomain no-cookie) "Send buffer substring from START to END formatted for shell. This is a wrapper over `buffer-substring' that takes care of @@ -4620,9 +4589,6 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." ;;; Skeletons -(define-obsolete-variable-alias - 'python-use-skeletons 'python-skeleton-autoinsert "24.3") - (defcustom python-skeleton-autoinsert nil "Non-nil means template skeletons will be automagically inserted. This happens when pressing \"if\", for example, to prompt for diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index be9f325d93..517fbbd8e7 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2982,14 +2982,6 @@ option followed by a colon `:' if the option accepts an argument." (match-string 1)))))) -(defun sh-maybe-here-document (arg) - "Insert self. Without prefix, following unquoted `<' inserts here document. -The document is bounded by `sh-here-document-word'." - (declare (obsolete sh-electric-here-document-mode "24.3")) - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (or arg (sh--maybe-here-document))) - (defun sh--maybe-here-document () (when (and (looking-back "[^<]<<[ E-]" (line-beginning-position)) (save-excursion diff --git a/lisp/replace.el b/lisp/replace.el index 06cde771b9..6393c09288 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -73,14 +73,6 @@ See `query-replace-from-history-variable' and This is a list of cons cells (FROM-STRING . TO-STRING), or nil if there are no default values.") -(defvar query-replace-interactive nil - "Non-nil means `query-replace' uses the last search string. -That becomes the \"string to replace\".") -(make-obsolete-variable 'query-replace-interactive - "use `M-n' to pull the last incremental search string -to the minibuffer that reads the string to replace, or invoke replacements -from Isearch by using a key sequence like `C-s C-s M-%'." "24.3") - (defcustom query-replace-from-to-separator " → " "String that separates FROM and TO in the history of replacement pairs. When nil, the pair will not be added to the history (same behavior @@ -213,96 +205,94 @@ by this function to the end of values available via Prompt with PROMPT. REGEXP-FLAG non-nil means the response should be a regexp. The return value can also be a pair (FROM . TO) indicating that the user wants to replace FROM with TO." - (if query-replace-interactive - (car (if regexp-flag regexp-search-ring search-ring)) - (let* ((history-add-new-input nil) - (separator-string - (when query-replace-from-to-separator - ;; Check if the first non-whitespace char is displayable - (if (char-displayable-p - (string-to-char (string-replace - " " "" query-replace-from-to-separator))) - query-replace-from-to-separator - " -> "))) - (separator - (when separator-string - (propertize separator-string - 'display separator-string - 'face 'minibuffer-prompt - 'separator t))) - (minibuffer-history - (append - (when separator - (mapcar (lambda (from-to) - (concat (query-replace-descr (car from-to)) - separator - (query-replace-descr (cdr from-to)))) - query-replace-defaults)) - (symbol-value query-replace-from-history-variable))) - (minibuffer-allow-text-properties t) ; separator uses text-properties - (default (when (and query-replace-read-from-default (not regexp-flag)) - (funcall query-replace-read-from-default))) - (prompt - (cond ((and query-replace-read-from-regexp-default regexp-flag) prompt) - (default (format-prompt prompt default)) - ((and query-replace-defaults separator) - (format-prompt prompt (car minibuffer-history))) - (query-replace-defaults - (format-prompt - prompt (format "%s -> %s" - (query-replace-descr - (caar query-replace-defaults)) - (query-replace-descr - (cdar query-replace-defaults))))) - (t (format-prompt prompt nil)))) - (from - ;; The save-excursion here is in case the user marks and copies - ;; a region in order to specify the minibuffer input. - ;; That should not clobber the region for the query-replace itself. - (save-excursion - (minibuffer-with-setup-hook - (lambda () - (setq-local text-property-default-nonsticky - (append '((separator . t) (face . t)) - text-property-default-nonsticky))) - (if regexp-flag - (read-regexp - (if query-replace-read-from-regexp-default - (string-remove-suffix ": " prompt) - prompt) - query-replace-read-from-regexp-default - 'minibuffer-history) - (read-from-minibuffer - prompt nil nil nil nil - (if default - (delete-dups - (cons default (query-replace-read-from-suggestions))) - (query-replace-read-from-suggestions)) - t))))) - (to)) - (if (and (zerop (length from)) query-replace-defaults (not default)) - (cons (caar query-replace-defaults) - (query-replace-compile-replacement - (cdar query-replace-defaults) regexp-flag)) - (setq from (or (and (zerop (length from)) default) - (query-replace--split-string from))) - (when (consp from) (setq to (cdr from) from (car from))) - (add-to-history query-replace-from-history-variable from nil t) - ;; Warn if user types \n or \t, but don't reject the input. - (and regexp-flag - (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from) - (let ((match (match-string 3 from))) - (cond - ((string= match "\\n") - (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead")) - ((string= match "\\t") - (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB"))) - (sit-for 2))) - (if (not to) - from - (add-to-history query-replace-to-history-variable to nil t) - (add-to-history 'query-replace-defaults (cons from to) nil t) - (cons from (query-replace-compile-replacement to regexp-flag))))))) + (let* ((history-add-new-input nil) + (separator-string + (when query-replace-from-to-separator + ;; Check if the first non-whitespace char is displayable + (if (char-displayable-p + (string-to-char (string-replace + " " "" query-replace-from-to-separator))) + query-replace-from-to-separator + " -> "))) + (separator + (when separator-string + (propertize separator-string + 'display separator-string + 'face 'minibuffer-prompt + 'separator t))) + (minibuffer-history + (append + (when separator + (mapcar (lambda (from-to) + (concat (query-replace-descr (car from-to)) + separator + (query-replace-descr (cdr from-to)))) + query-replace-defaults)) + (symbol-value query-replace-from-history-variable))) + (minibuffer-allow-text-properties t) ; separator uses text-properties + (default (when (and query-replace-read-from-default (not regexp-flag)) + (funcall query-replace-read-from-default))) + (prompt + (cond ((and query-replace-read-from-regexp-default regexp-flag) prompt) + (default (format-prompt prompt default)) + ((and query-replace-defaults separator) + (format-prompt prompt (car minibuffer-history))) + (query-replace-defaults + (format-prompt + prompt (format "%s -> %s" + (query-replace-descr + (caar query-replace-defaults)) + (query-replace-descr + (cdar query-replace-defaults))))) + (t (format-prompt prompt nil)))) + (from + ;; The save-excursion here is in case the user marks and copies + ;; a region in order to specify the minibuffer input. + ;; That should not clobber the region for the query-replace itself. + (save-excursion + (minibuffer-with-setup-hook + (lambda () + (setq-local text-property-default-nonsticky + (append '((separator . t) (face . t)) + text-property-default-nonsticky))) + (if regexp-flag + (read-regexp + (if query-replace-read-from-regexp-default + (string-remove-suffix ": " prompt) + prompt) + query-replace-read-from-regexp-default + 'minibuffer-history) + (read-from-minibuffer + prompt nil nil nil nil + (if default + (delete-dups + (cons default (query-replace-read-from-suggestions))) + (query-replace-read-from-suggestions)) + t))))) + (to)) + (if (and (zerop (length from)) query-replace-defaults (not default)) + (cons (caar query-replace-defaults) + (query-replace-compile-replacement + (cdar query-replace-defaults) regexp-flag)) + (setq from (or (and (zerop (length from)) default) + (query-replace--split-string from))) + (when (consp from) (setq to (cdr from) from (car from))) + (add-to-history query-replace-from-history-variable from nil t) + ;; Warn if user types \n or \t, but don't reject the input. + (and regexp-flag + (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from) + (let ((match (match-string 3 from))) + (cond + ((string= match "\\n") + (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead")) + ((string= match "\\t") + (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB"))) + (sit-for 2))) + (if (not to) + from + (add-to-history query-replace-to-history-variable to nil t) + (add-to-history 'query-replace-defaults (cons from to) nil t) + (cons from (query-replace-compile-replacement to regexp-flag)))))) (defun query-replace-compile-replacement (to regexp-flag) "Maybe convert a regexp replacement TO to Lisp. diff --git a/lisp/strokes.el b/lisp/strokes.el index d7a9539316..0edb20c2eb 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -210,9 +210,6 @@ static char * stroke_xpm[] = { :link '(emacs-commentary-link "strokes") :group 'mouse) -(define-obsolete-variable-alias 'strokes-modeline-string 'strokes-lighter - "24.3") - (defcustom strokes-lighter " Strokes" "Mode line identifier for Strokes mode." :type 'string) diff --git a/lisp/subr.el b/lisp/subr.el index c7b86c83e8..f4b457556d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1794,8 +1794,6 @@ be a list of the form returned by `event-start' and `event-end'." ;;;; Obsolescent names for functions. -(make-obsolete 'buffer-has-markers-at nil "24.3") - (make-obsolete 'invocation-directory "use the variable of the same name." "27.1") (make-obsolete 'invocation-name "use the variable of the same name." "27.1") @@ -3758,10 +3756,6 @@ This finishes the change group by reverting all of its changes." ;;;; Display-related functions. -;; For compatibility. -(define-obsolete-function-alias 'redraw-modeline - #'force-mode-line-update "24.3") - (defun momentary-string-display (string pos &optional exit-char message) "Momentarily display STRING in the buffer at POS. Display remains until next event is input. diff --git a/lisp/term.el b/lisp/term.el index 797fb18074..755c220270 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -755,25 +755,8 @@ Buffer local variable.") term-color-bright-cyan term-color-bright-white]) -(defcustom term-default-fg-color nil - "If non-nil, default color for foreground in Term mode." - :group 'term - :type '(choice (const nil) (string :tag "color"))) -(make-obsolete-variable 'term-default-fg-color "use the face `term' instead." - "24.3") - -(defcustom term-default-bg-color nil - "If non-nil, default color for foreground in Term mode." - :group 'term - :type '(choice (const nil) (string :tag "color"))) -(make-obsolete-variable 'term-default-bg-color "use the face `term' instead." - "24.3") - (defface term - `((t - :foreground ,term-default-fg-color - :background ,term-default-bg-color - :inherit default)) + `((t :inherit default)) "Default face to use in Term mode." :group 'term) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index e6c0f8c28c..f624b604aa 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1596,10 +1596,6 @@ Puts point on a blank line between them." ;;;; LaTeX completion. (defvar latex-complete-bibtex-cache nil) - -(define-obsolete-function-alias 'latex-string-prefix-p - #'string-prefix-p "24.3") - (defvar bibtex-reference-key) (declare-function reftex-get-bibfile-list "reftex-cite.el" ()) @@ -2174,8 +2170,6 @@ IN can be either a string (with the same % escapes in it) indicating OUT describes the output file and is either a %-escaped string or nil to indicate that there is no output file.") -(define-obsolete-function-alias 'tex-string-prefix-p #'string-prefix-p "24.3") - (defun tex-guess-main-file (&optional all) "Find a likely `tex-main-file'. Looks for hints in other buffers in the same directory or in diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index 24b064773b..91f47d0325 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -96,17 +96,6 @@ If the specified port number is the default, return nil." (or file "/") (if frag (concat "#" frag))))) -(defun url-recreate-url-attributes (urlobj) - "Recreate the attributes of an URL string from the parsed URLOBJ." - (declare (obsolete nil "24.3")) - (when (url-attributes urlobj) - (concat ";" - (mapconcat (lambda (x) - (if (cdr x) - (concat (car x) "=" (cdr x)) - (car x))) - (url-attributes urlobj) ";")))) - ;;;###autoload (defun url-generic-parse-url (url) "Return an URL-struct of the parts of URL. diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index d710578fff..d617d5aebb 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -208,8 +208,6 @@ a case simply use the directory containing the changed file." '((t (:inherit font-lock-comment-face))) "Face for highlighting acknowledgments." :version "21.1") -(define-obsolete-face-alias 'change-log-acknowledgement - 'change-log-acknowledgment "24.3") (defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)") (defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*") diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index d45e13ea72..bd2e9f1977 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -36,14 +36,6 @@ :group 'ediff :group 'frames) - -;; Determine which window setup function to use based on current window system. -(defun ediff-choose-window-setup-function-automatically () - (declare (obsolete ediff-setup-windows-default "24.3")) - (if (display-graphic-p) - #'ediff-setup-windows-multiframe - #'ediff-setup-windows-plain)) - (defcustom ediff-window-setup-function #'ediff-setup-windows-default "Function called to set up windows. Ediff provides a choice of three functions: diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el index 89f8d26880..ddc3ea6e81 100644 --- a/lisp/vc/pcvs-util.el +++ b/lisp/vc/pcvs-util.el @@ -164,8 +164,6 @@ arguments. If ARGS is not a list, no argument will be passed." (if oneline (line-end-position) (point-max)))) (file-error nil))) -(define-obsolete-function-alias 'cvs-string-prefix-p #'string-prefix-p "24.3") - ;;;; ;;;; file names ;;;; diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index d93be951a3..6df5f3cf7d 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3273,8 +3273,6 @@ to provide the `find-revision' operation instead." ;; These things should probably be generally available -(define-obsolete-function-alias 'vc-string-prefix-p 'string-prefix-p "24.3") - (defun vc-file-tree-walk (dirname func &rest args) "Walk recursively through DIRNAME. Invoke FUNC f ARGS on each VC-managed file f underneath it." diff --git a/lisp/window.el b/lisp/window.el index 9ff55dc980..67a4a4bbf2 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6622,24 +6622,6 @@ fourth element is BUFFER." window 'quit-restore (list 'tab 'tab (selected-window) buffer))))) -(defcustom display-buffer-function nil - "If non-nil, function to call to handle `display-buffer'. -It will receive two args, the buffer and a flag which if non-nil -means that the currently selected window is not acceptable. It -should choose or create a window, display the specified buffer in -it, and return the window. - -The specified function should call `display-buffer-record-window' -with corresponding arguments to set up the quit-restore parameter -of the window used." - :type '(choice - (const nil) - (function :tag "function")) - :group 'windows) - -(make-obsolete-variable 'display-buffer-function - 'display-buffer-alist "24.3") - (defcustom pop-up-frame-alist nil "Alist of parameters for automatically generated new frames. If non-nil, the value you specify here is used by the default @@ -7745,38 +7727,34 @@ specified by the ACTION argument." ;; Handle the old form of the first argument. (inhibit-same-window (and action (not (listp action))))) (unless (listp action) (setq action nil)) - (if display-buffer-function - ;; If `display-buffer-function' is defined, let it do the job. - (funcall display-buffer-function buffer inhibit-same-window) - ;; Otherwise, use the defined actions. - (let* ((user-action - (display-buffer-assq-regexp - buffer display-buffer-alist action)) - (special-action (display-buffer--special-action buffer)) - ;; Extra actions from the arguments to this function: - (extra-action - (cons nil (append (if inhibit-same-window - '((inhibit-same-window . t))) - (if frame - `((reusable-frames . ,frame)))))) - ;; Construct action function list and action alist. - (actions (list display-buffer-overriding-action - user-action special-action action extra-action - display-buffer-base-action - display-buffer-fallback-action)) - (functions (apply 'append - (mapcar (lambda (x) - (setq x (car x)) - (if (functionp x) (list x) x)) - actions))) - (alist (apply 'append (mapcar 'cdr actions))) - window) - (unless (buffer-live-p buffer) - (error "Invalid buffer")) - (while (and functions (not window)) - (setq window (funcall (car functions) buffer alist) - functions (cdr functions))) - (and (windowp window) window))))) + (let* ((user-action + (display-buffer-assq-regexp + buffer display-buffer-alist action)) + (special-action (display-buffer--special-action buffer)) + ;; Extra actions from the arguments to this function: + (extra-action + (cons nil (append (if inhibit-same-window + '((inhibit-same-window . t))) + (if frame + `((reusable-frames . ,frame)))))) + ;; Construct action function list and action alist. + (actions (list display-buffer-overriding-action + user-action special-action action extra-action + display-buffer-base-action + display-buffer-fallback-action)) + (functions (apply 'append + (mapcar (lambda (x) + (setq x (car x)) + (if (functionp x) (list x) x)) + actions))) + (alist (apply 'append (mapcar 'cdr actions))) + window) + (unless (buffer-live-p buffer) + (error "Invalid buffer")) + (while (and functions (not window)) + (setq window (funcall (car functions) buffer alist) + functions (cdr functions))) + (and (windowp window) window)))) (defun display-buffer-other-frame (buffer) "Display buffer BUFFER preferably in another frame. diff --git a/lisp/winner.el b/lisp/winner.el index 89f337170c..4290f1fd23 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -318,9 +318,6 @@ You may want to include buffer names such as *Help*, *Apropos*, "Functions to run whenever Winner mode is turned on or off." :type 'hook) -(define-obsolete-variable-alias 'winner-mode-leave-hook - 'winner-mode-off-hook "24.3") - (defcustom winner-mode-off-hook nil "Functions to run whenever Winner mode is turned off." :type 'hook) diff --git a/src/marker.c b/src/marker.c index 9727586f42..0ed1e55ddc 100644 --- a/src/marker.c +++ b/src/marker.c @@ -759,23 +759,6 @@ If TYPE is nil, it means the marker stays behind when you insert text at it. */ return type; } -DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at, - 1, 1, 0, - doc: /* Return t if there are markers pointing at POSITION in the current buffer. */) - (Lisp_Object position) -{ - register struct Lisp_Marker *tail; - register ptrdiff_t charpos; - - charpos = clip_to_bounds (BEG, XFIXNUM (position), Z); - - for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next) - if (tail->charpos == charpos) - return Qt; - - return Qnil; -} - #ifdef MARKER_DEBUG /* For debugging -- count the markers in buffer BUF. */ @@ -821,5 +804,4 @@ syms_of_marker (void) defsubr (&Scopy_marker); defsubr (&Smarker_insertion_type); defsubr (&Sset_marker_insertion_type); - defsubr (&Sbuffer_has_markers_at); } commit c6d8db8d91649d4e30bb26c662ac867136005c0c Author: Stefan Kangas Date: Fri Sep 9 11:19:21 2022 +0200 Display error in emacsclient if setsockopt failed * lib-src/emacsclient.c (set_tcp_socket, set_socket_timeout): Display an error message if setsockopt failed. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 49d90a989f..88800b9b2e 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1078,7 +1078,9 @@ set_tcp_socket (const char *local_server_file) /* The cast to 'const char *' is to avoid a compiler warning when compiling for MS-Windows sockets. */ - setsockopt (s, SOL_SOCKET, SO_LINGER, (const char *) &l_arg, sizeof l_arg); + int ret = setsockopt (s, SOL_SOCKET, SO_LINGER, (const char *) &l_arg, sizeof l_arg); + if (ret < 0) + sock_err_message ("setsockopt"); /* Send the authentication. */ auth_string[AUTH_KEY_LENGTH] = '\0'; @@ -1892,11 +1894,13 @@ start_daemon_and_retry_set_socket (void) static void set_socket_timeout (HSOCKET socket, int seconds) { + int ret; + #ifndef WINDOWSNT struct timeval timeout; timeout.tv_sec = seconds; timeout.tv_usec = 0; - setsockopt (socket, SOL_SOCKET, SO_RCVTIMEO, &timeout, sizeof timeout); + ret = setsockopt (socket, SOL_SOCKET, SO_RCVTIMEO, &timeout, sizeof timeout); #else DWORD timeout; @@ -1904,8 +1908,11 @@ set_socket_timeout (HSOCKET socket, int seconds) timeout = INT_MAX; else timeout = seconds * 1000; - setsockopt (socket, SOL_SOCKET, SO_RCVTIMEO, (char *) &timeout, sizeof timeout); + ret = setsockopt (socket, SOL_SOCKET, SO_RCVTIMEO, (char *) &timeout, sizeof timeout); #endif + + if (ret < 0) + sock_err_message ("setsockopt"); } static bool commit a0886b321c4792ac52d69900a999840c7ee1d90a Author: Po Lu Date: Fri Sep 9 16:27:02 2022 +0800 Remove some redundant calls to x_ignore_errors_for_next_request * src/xterm.c (x_dnd_do_unsupported_drop, x_set_frame_alpha): Wrap some requests in x_ignore_errors_for_next_request instead of calling it each time. diff --git a/src/xterm.c b/src/xterm.c index aa3fb0fc12..6043e2ab09 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3978,12 +3978,10 @@ x_dnd_do_unsupported_drop (struct x_display_info *dpyinfo, x_ignore_errors_for_next_request (dpyinfo); XSendEvent (dpyinfo->display, child, True, ButtonPressMask, &event); - x_stop_ignoring_errors (dpyinfo); event.xbutton.type = ButtonRelease; event.xbutton.time = before + 2; - x_ignore_errors_for_next_request (dpyinfo); XSendEvent (dpyinfo->display, child, True, ButtonReleaseMask, &event); x_stop_ignoring_errors (dpyinfo); @@ -6630,22 +6628,21 @@ x_set_frame_alpha (struct frame *f) Do this unconditionally as this function is called on reparent when alpha has not changed on the frame. */ + x_ignore_errors_for_next_request (dpyinfo); + if (!FRAME_PARENT_FRAME (f)) { parent = x_find_topmost_parent (f); if (parent != None) { - x_ignore_errors_for_next_request (dpyinfo); XChangeProperty (dpy, parent, dpyinfo->Xatom_net_wm_window_opacity, XA_CARDINAL, 32, PropModeReplace, (unsigned char *) &opac, 1); - x_stop_ignoring_errors (dpyinfo); } } - x_ignore_errors_for_next_request (dpyinfo); XChangeProperty (dpy, win, dpyinfo->Xatom_net_wm_window_opacity, XA_CARDINAL, 32, PropModeReplace, (unsigned char *) &opac, 1);