commit 2a4f2ba91a1bbcda9c8b452e61f36758527f16ff (HEAD, refs/remotes/origin/master) Author: Michael Albinus Date: Mon Sep 12 08:52:08 2022 +0200 Fix Tramp test * lisp/net/tramp-compat.el (tramp-compat-rx): Add `tramp-autoload' function property. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index d33469f8db..aae15fafdf 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -222,6 +222,8 @@ CONDITION can also be a list of error conditions." ;; This is needed for compilation in the Emacs source tree. ;;;###autoload (defalias 'tramp-compat-rx #'rx) +(put #'tramp-compat-rx 'tramp-autoload t) + ;; `file-modes', `set-file-modes' and `set-file-times' got argument ;; FLAG in Emacs 28.1. (defalias 'tramp-compat-file-modes commit 239bad7921fc38891dc4ee09b57c96d32100f19f Author: Po Lu Date: Mon Sep 12 14:01:52 2022 +0800 Fix focus restoration upon x_mouse_leave again * src/xterm.c (x_mouse_leave): Call xi_handle_focus_change after changing the implicit focus. diff --git a/src/xterm.c b/src/xterm.c index 12234351a3..48502f12d8 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13213,8 +13213,13 @@ x_mouse_leave (struct x_display_info *dpyinfo) device = xi_device_from_id (dpyinfo, dpyinfo->client_pointer_device); - if (device) - device->focus_implicit_frame = NULL; + if (device && device->focus_implicit_frame) + { + device->focus_implicit_frame = NULL; + + /* The focus might have changed; compute the new focus. */ + xi_handle_focus_change (dpyinfo); + } } #endif } commit e0f137f079c346c5cb05f738ed96e9a09aaad4e6 Author: Dmitry Gutov Date: Mon Sep 12 00:45:12 2022 +0300 * lisp/progmodes/xref.el: Bump the version. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index a7e372c2ac..ac04b64ce5 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,7 +1,7 @@ ;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2022 Free Software Foundation, Inc. -;; Version: 1.5.0 +;; Version: 1.5.1 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not commit d8f392bccd46cdb238ec96964f220ffb9d81cc44 Author: Kévin Le Gouguec Date: Sun Sep 11 19:55:01 2022 +0200 Restrict replace-*-in-region to the bounds defined by caller * lisp/subr.el (replace-string-in-region, replace-regexp-in-region): Narrow to region before iterating over matches, instead of giving a bound to the search functions. * test/lisp/subr-tests.el (test-replace-string-in-region): Add regression tests (bug#57733). diff --git a/lisp/subr.el b/lisp/subr.el index 686189e69b..8769fec2b9 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4219,15 +4219,17 @@ Comparisons and replacements are done with fixed case." (error "End after end of buffer")) (setq end (point-max))) (save-excursion - (let ((matches 0) - (case-fold-search nil)) - (goto-char start) - (while (search-forward string end t) - (delete-region (match-beginning 0) (match-end 0)) - (insert replacement) - (setq matches (1+ matches))) - (and (not (zerop matches)) - matches)))) + (goto-char start) + (save-restriction + (narrow-to-region start end) + (let ((matches 0) + (case-fold-search nil)) + (while (search-forward string nil t) + (delete-region (match-beginning 0) (match-end 0)) + (insert replacement) + (setq matches (1+ matches))) + (and (not (zerop matches)) + matches))))) (defun replace-regexp-in-region (regexp replacement &optional start end) "Replace REGEXP with REPLACEMENT in the region from START to END. @@ -4254,14 +4256,16 @@ REPLACEMENT can use the following special elements: (error "End after end of buffer")) (setq end (point-max))) (save-excursion - (let ((matches 0) - (case-fold-search nil)) - (goto-char start) - (while (re-search-forward regexp end t) - (replace-match replacement t) - (setq matches (1+ matches))) - (and (not (zerop matches)) - matches)))) + (goto-char start) + (save-restriction + (narrow-to-region start end) + (let ((matches 0) + (case-fold-search nil)) + (while (re-search-forward regexp nil t) + (replace-match replacement t) + (setq matches (1+ matches))) + (and (not (zerop matches)) + matches))))) (defun yank-handle-font-lock-face-property (face start end) "If `font-lock-defaults' is nil, apply FACE as a `face' property. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 4310b7291a..3011713210 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -968,7 +968,21 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." (insert "Foo bar zot foobar") (should (= (replace-string-in-region "Foo" "new" (point-min)) 1)) - (should (equal (buffer-string) "new bar zot foobar")))) + (should (equal (buffer-string) "new bar zot foobar"))) + + (with-temp-buffer + (insert "foo bar baz") + (should (= (replace-string-in-region "ba" "quux corge grault" (point-min)) + 2)) + (should (equal (buffer-string) + "foo quux corge graultr quux corge graultz"))) + + (with-temp-buffer + (insert "foo bar bar") + (should (= (replace-string-in-region " bar" "" (point-min) 8) + 1)) + (should (equal (buffer-string) + "foo bar")))) (ert-deftest test-replace-regexp-in-region () (with-temp-buffer @@ -991,7 +1005,21 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." (insert "Foo bar zot foobar") (should (= (replace-regexp-in-region "Fo+" "new" (point-min)) 1)) - (should (equal (buffer-string) "new bar zot foobar")))) + (should (equal (buffer-string) "new bar zot foobar"))) + + (with-temp-buffer + (insert "foo bar baz") + (should (= (replace-regexp-in-region "ba." "quux corge grault" (point-min)) + 2)) + (should (equal (buffer-string) + "foo quux corge grault quux corge grault"))) + + (with-temp-buffer + (insert "foo bar bar") + (should (= (replace-regexp-in-region " bar" "" (point-min) 8) + 1)) + (should (equal (buffer-string) + "foo bar")))) (ert-deftest test-with-existing-directory () (let ((dir (make-temp-name "/tmp/not-exist-"))) commit cba83d989359d667e52dad4e0e9eadf6f77cc38f Author: Michael Albinus Date: Sun Sep 11 14:53:14 2022 +0200 Disable Tramp cache for relative file names * lisp/net/tramp.el (tramp-file-name-unify): Return `tramp-cache-undefined' if LOCALNAME is a relative file name. * lisp/net/tramp-cache.el (tramp-get-file-property) (tramp-set-file-property, tramp-file-property-p) (tramp-flush-file-property, tramp-flush-file-upper-properties) (tramp-flush-file-properties): Handle KEY being `tramp-cache-undefined'. (tramp-flush-file-function): Revert last change. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 93bcdf4b97..58954c238e 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -28,7 +28,7 @@ ;; An implementation of information caching for remote files. ;; Each connection, identified by a `tramp-file-name' structure or by -;; a process, has a unique cache. We distinguish 4 kind of caches, +;; a process, has a unique cache. We distinguish 5 kind of caches, ;; depending on the key: ;; ;; - localname is nil. These are reusable properties. Examples: @@ -37,13 +37,14 @@ ;; host when starting a Perl script. These properties are saved in ;; the file `tramp-persistency-file-name'. ;; -;; - localname is a string. These are temporary properties, which are -;; related to the file localname is referring to. Examples: -;; "file-exists-p" is t or nil, depending on the file existence, or -;; "file-attributes" caches the result of the function +;; - localname is an absolute file name. These are temporary +;; properties, which are related to the file localname is referring +;; to. Examples: "file-exists-p" is t or nil, depending on the file +;; existence, or "file-attributes" caches the result of the function ;; `file-attributes'. These entries have a timestamp, and they ;; expire after `remote-file-name-inhibit-cache' seconds if this -;; variable is set. +;; variable is set. These properties are taken into account only if +;; the connection is established, or `non-essential' is nil. ;; ;; - The key is a process. These are temporary properties related to ;; an open connection. Examples: "scripts" keeps shell script @@ -135,39 +136,41 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil." Return DEFAULT if not set." ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) - (let* ((hash (tramp-get-hash-table key)) - (cached (and (hash-table-p hash) (gethash property hash))) - (cached-at (and (consp cached) (format-time-string "%T" (car cached)))) - (value default) - cache-used) - - (when ;; We take the value only if there is any, and - ;; `remote-file-name-inhibit-cache' indicates that it is - ;; still valid. Otherwise, DEFAULT is set. - (and (consp cached) - (or (null remote-file-name-inhibit-cache) - (and (integerp remote-file-name-inhibit-cache) - (time-less-p - nil - (time-add (car cached) remote-file-name-inhibit-cache))) - (and (consp remote-file-name-inhibit-cache) - (time-less-p - remote-file-name-inhibit-cache (car cached))))) - (setq value (cdr cached) - cache-used t)) - - (tramp-message - key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s" - (tramp-file-name-localname key) - property value remote-file-name-inhibit-cache cache-used cached-at) - ;; For analysis purposes, count the number of getting this file attribute. - (when (>= tramp-verbose 10) - (let* ((var (intern (concat "tramp-cache-get-count-" property))) - (val (or (and (boundp var) (numberp (symbol-value var)) - (symbol-value var)) - 0))) - (set var (1+ val)))) - value)) + (if (eq key tramp-cache-undefined) default + (let* ((hash (tramp-get-hash-table key)) + (cached (and (hash-table-p hash) (gethash property hash))) + (cached-at + (and (consp cached) (format-time-string "%T" (car cached)))) + (value default) + cache-used) + + (when ;; We take the value only if there is any, and + ;; `remote-file-name-inhibit-cache' indicates that it is + ;; still valid. Otherwise, DEFAULT is set. + (and (consp cached) + (or (null remote-file-name-inhibit-cache) + (and (integerp remote-file-name-inhibit-cache) + (time-less-p + nil + (time-add (car cached) remote-file-name-inhibit-cache))) + (and (consp remote-file-name-inhibit-cache) + (time-less-p + remote-file-name-inhibit-cache (car cached))))) + (setq value (cdr cached) + cache-used t)) + + (tramp-message + key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s" + (tramp-file-name-localname key) + property value remote-file-name-inhibit-cache cache-used cached-at) + ;; For analysis purposes, count the number of getting this file attribute. + (when (>= tramp-verbose 10) + (let* ((var (intern (concat "tramp-cache-get-count-" property))) + (val (or (and (boundp var) (numberp (symbol-value var)) + (symbol-value var)) + 0))) + (set var (1+ val)))) + value))) (add-hook 'tramp-cache-unload-hook (lambda () @@ -180,19 +183,20 @@ Return DEFAULT if not set." Return VALUE." ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) - (let ((hash (tramp-get-hash-table key))) - ;; We put the timestamp there. - (puthash property (cons (current-time) value) hash) - (tramp-message - key 8 "%s %s %s" (tramp-file-name-localname key) property value) - ;; For analysis purposes, count the number of setting this file attribute. - (when (>= tramp-verbose 10) - (let* ((var (intern (concat "tramp-cache-set-count-" property))) - (val (or (and (boundp var) (numberp (symbol-value var)) - (symbol-value var)) - 0))) - (set var (1+ val)))) - value)) + (if (eq key tramp-cache-undefined) value + (let ((hash (tramp-get-hash-table key))) + ;; We put the timestamp there. + (puthash property (cons (current-time) value) hash) + (tramp-message + key 8 "%s %s %s" (tramp-file-name-localname key) property value) + ;; For analysis purposes, count the number of setting this file attribute. + (when (>= tramp-verbose 10) + (let* ((var (intern (concat "tramp-cache-set-count-" property))) + (val (or (and (boundp var) (numberp (symbol-value var)) + (symbol-value var)) + 0))) + (set var (1+ val)))) + value))) (add-hook 'tramp-cache-unload-hook (lambda () @@ -202,19 +206,22 @@ Return VALUE." ;;;###tramp-autoload (defun tramp-file-property-p (key file property) "Check whether PROPERTY of FILE is defined in the cache context of KEY." - (not (eq (tramp-get-file-property key file property tramp-cache-undefined) - tramp-cache-undefined))) + (and + (not (eq key tramp-cache-undefined)) + (not (eq (tramp-get-file-property key file property tramp-cache-undefined) + tramp-cache-undefined)))) ;;;###tramp-autoload (defun tramp-flush-file-property (key file property) "Remove PROPERTY of FILE in the cache context of KEY." ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) - (remhash property (tramp-get-hash-table key)) - (tramp-message key 8 "%s %s" (tramp-file-name-localname key) property) - (when (>= tramp-verbose 10) - (let ((var (intern (concat "tramp-cache-set-count-" property)))) - (makunbound var)))) + (unless (eq key tramp-cache-undefined) + (remhash property (tramp-get-hash-table key)) + (tramp-message key 8 "%s %s" (tramp-file-name-localname key) property) + (when (>= tramp-verbose 10) + (let ((var (intern (concat "tramp-cache-set-count-" property)))) + (makunbound var))))) (defun tramp-flush-file-upper-properties (key file) "Remove some properties of FILE's upper directory." @@ -224,12 +231,14 @@ Return VALUE." (file (directory-file-name file))) ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) - (dolist (property (hash-table-keys (tramp-get-hash-table key))) - (when (string-match-p - (rx - bos (| "directory-" "file-name-all-completions" "file-entries")) - property) - (tramp-flush-file-property key file property)))))) + (unless (eq key tramp-cache-undefined) + (dolist (property (hash-table-keys (tramp-get-hash-table key))) + (when (string-match-p + (rx + bos (| "directory-" "file-name-all-completions" + "file-entries")) + property) + (tramp-flush-file-property key file property))))))) ;;;###tramp-autoload (defun tramp-flush-file-properties (key file) @@ -237,14 +246,15 @@ Return VALUE." (let ((truename (tramp-get-file-property key file "file-truename"))) ;; Unify localname. Remove hop from `tramp-file-name' structure. (setq key (tramp-file-name-unify key file)) - (tramp-message key 8 "%s" (tramp-file-name-localname key)) - (remhash key tramp-cache-data) - ;; Remove file properties of symlinks. - (when (and (stringp truename) - (not (string-equal file (directory-file-name truename)))) - (tramp-flush-file-properties key truename)) - ;; Remove selected properties of upper directory. - (tramp-flush-file-upper-properties key file))) + (unless (eq key tramp-cache-undefined) + (tramp-message key 8 "%s" (tramp-file-name-localname key)) + (remhash key tramp-cache-data) + ;; Remove file properties of symlinks. + (when (and (stringp truename) + (not (string-equal file (directory-file-name truename)))) + (tramp-flush-file-properties key truename)) + ;; Remove selected properties of upper directory. + (tramp-flush-file-upper-properties key file)))) ;;;###tramp-autoload (defun tramp-flush-directory-properties (key directory) @@ -285,8 +295,7 @@ This is suppressed for temporary buffers." (tramp-verbose 0)) (when (tramp-tramp-file-p bfn) (tramp-flush-file-properties - (tramp-dissect-file-name bfn) - (tramp-file-local-name (expand-file-name bfn)))))))) + (tramp-dissect-file-name bfn) (tramp-file-local-name bfn))))))) (add-hook 'before-revert-hook #'tramp-flush-file-function) (add-hook 'eshell-pre-command-hook #'tramp-flush-file-function) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 15380ed94d..90cc03c188 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1504,23 +1504,21 @@ If nil, return `tramp-default-port'." ;;;###tramp-autoload (defun tramp-file-name-unify (vec &optional localname) "Unify VEC by removing localname and hop from `tramp-file-name' structure. -If LOCALNAME is a string, set it as localname. +If LOCALNAME is an absolute file name, set it as localname. If +LOCALNAME is a relative file name, return `tramp-cache-undefined'. Objects returned by this function compare `equal' if they refer to the same connection. Make a copy in order to avoid side effects." - (when (tramp-file-name-p vec) - (setq vec (copy-tramp-file-name vec)) - (setf (tramp-file-name-localname vec) - (and (stringp localname) - ;; FIXME: This is a sanity check. When this error - ;; doesn't happen for a while, it can be removed. - (or (file-name-absolute-p localname) - (tramp-error - vec 'file-error - "File `%s' must be absolute, please report a bug!" - localname)) - (tramp-compat-file-name-unquote (directory-file-name localname))) - (tramp-file-name-hop vec) nil)) - vec) + (if (and (stringp localname) + (not (file-name-absolute-p localname))) + (setq vec tramp-cache-undefined) + (when (tramp-file-name-p vec) + (setq vec (copy-tramp-file-name vec)) + (setf (tramp-file-name-localname vec) + (and (stringp localname) + (tramp-compat-file-name-unquote + (directory-file-name localname))) + (tramp-file-name-hop vec) nil)) + vec)) (put #'tramp-file-name-unify 'tramp-suppress-trace t) commit f47a5324f44e5b8d0016cff2a4f995ff418a5d19 Author: Richard Hansen Date: Tue Jun 28 16:25:43 2022 -0400 whitespace: Redo BoB/EoB empty line highlighting * lisp/whitespace.el (whitespace--empty-at-bob-matcher, whitespace--empty-at-eob-matcher, whitespace--update-bob-eob, whitespace-color-off, whitespace-color-on, whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp, whitespace-looking-back, whitespace-post-command-hook): Redo the `empty' line highlighting logic to ensure that a buffer change causes all affected `empty' lines to become (un)highlighted (bug#37467). Also, for improved UX, don't highlight BoB empty lines at or below point (not just when point is at 1), or EoB empty lines at or above point (not just when point is `eobp'). (whitespace-bob-marker, whitespace-eob-marker): Clarify documentation. * test/lisp/whitespace-tests.el (whitespace--with-test-buffer, whitespace--fu, whitespace-tests--empty-bob, whitespace-tests--empty-eob): Add tests. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 8146eff9b0..ae4d8ae3f0 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1139,12 +1139,21 @@ Used by function `whitespace-trailing-regexp' (which see).") "Region whose highlighting depends on `whitespace-point'.") (defvar-local whitespace-bob-marker nil - "Used to save locally the bob marker value. -Used by function `whitespace-post-command-hook' (which see).") + "Position of the buffer's first non-empty line. +This marker is positioned at the beginning of the first line in +the buffer that contains a non-space character. If no such line +exists, this is positioned at the end of the buffer (which could +be after `whitespace-eob-marker' if the buffer contains nothing +but empty lines).") (defvar-local whitespace-eob-marker nil - "Used to save locally the eob marker value. -Used by function `whitespace-post-command-hook' (which see).") + "Position after the buffer's last non-empty line. +This marker is positioned at the beginning of the first line +immediately following the last line in the buffer that contains a +non-space character. If no such line exists, this is positioned +at the beginning of the buffer (which could be before +`whitespace-bob-marker' if the buffer contains nothing but empty +lines).") (defvar-local whitespace-buffer-changed nil "Used to indicate locally if buffer changed. @@ -2059,9 +2068,14 @@ resultant list will be returned." (delete-overlay ol) ol)) (setq-local whitespace-bob-marker (point-min-marker)) (setq-local whitespace-eob-marker (point-max-marker)) + (whitespace--update-bob-eob) (setq-local whitespace-buffer-changed nil) (add-hook 'post-command-hook #'whitespace-post-command-hook nil t) (add-hook 'before-change-functions #'whitespace-buffer-changed nil t) + (add-hook 'after-change-functions #'whitespace--update-bob-eob + ;; The -1 ensures that it runs before any + ;; `font-lock-mode' hook functions. + -1 t) ;; Add whitespace-mode color into font lock. (setq whitespace-font-lock-keywords @@ -2114,11 +2128,11 @@ resultant list will be returned." `((,whitespace-big-indent-regexp 1 'whitespace-big-indent t))) ,@(when (memq 'empty whitespace-active-style) ;; Show empty lines at beginning of buffer. - `((,#'whitespace-empty-at-bob-regexp - 1 whitespace-empty t) + `((,#'whitespace--empty-at-bob-matcher + 0 whitespace-empty t) ;; Show empty lines at end of buffer. - (,#'whitespace-empty-at-eob-regexp - 1 whitespace-empty t))) + (,#'whitespace--empty-at-eob-matcher + 0 whitespace-empty t))) ,@(when (or (memq 'space-after-tab whitespace-active-style) (memq 'space-after-tab::tab whitespace-active-style) (memq 'space-after-tab::space whitespace-active-style)) @@ -2153,6 +2167,8 @@ resultant list will be returned." (when (whitespace-style-face-p) (remove-hook 'post-command-hook #'whitespace-post-command-hook t) (remove-hook 'before-change-functions #'whitespace-buffer-changed t) + (remove-hook 'after-change-functions #'whitespace--update-bob-eob + t) (font-lock-remove-keywords nil whitespace-font-lock-keywords) (font-lock-flush))) @@ -2201,115 +2217,83 @@ resultant list will be returned." (format ".\\{%d\\}" rem))))) limit t)) -(defun whitespace-empty-at-bob-regexp (limit) - "Match spaces at beginning of buffer (BOB) which do not contain point at BOB." - (let ((b (point)) - r) - (cond - ;; at bob - ((= b 1) - (setq r (and (looking-at whitespace-empty-at-bob-regexp) - (or (/= whitespace-point 1) - (progn (whitespace-point--used (match-beginning 0) - (match-end 0)) - nil)))) - (set-marker whitespace-bob-marker (if r (match-end 1) b))) - ;; inside bob empty region - ((<= limit whitespace-bob-marker) - (setq r (looking-at whitespace-empty-at-bob-regexp)) - (if r - (when (< (match-end 1) limit) - (set-marker whitespace-bob-marker (match-end 1))) - (set-marker whitespace-bob-marker b))) - ;; intersection with end of bob empty region - ((<= b whitespace-bob-marker) - (setq r (looking-at whitespace-empty-at-bob-regexp)) - (set-marker whitespace-bob-marker (if r (match-end 1) b))) - ;; it is not inside bob empty region - (t - (setq r nil))) - ;; move to end of matching - (and r (goto-char (match-end 1))) - r)) - - -(defsubst whitespace-looking-back (regexp limit) +(defun whitespace--empty-at-bob-matcher (limit) + "Match empty/space-only lines at beginning of buffer (BoB). +Match does not extend past position LIMIT. For improved UX, the +line containing `whitespace-point' and subsequent lines are +excluded from the match. (The idea is that the user might be +about to start typing, and if they do, that line and any +following empty lines will no longer be BoB empty lines. +Highlighting those lines can be distracting.)" + (let ((p (point)) + (e (min whitespace-bob-marker limit + ;; EoB marker will be before BoB marker if the buffer + ;; has nothing but empty lines. + whitespace-eob-marker + (save-excursion (goto-char whitespace-point) + (line-beginning-position))))) + (when (= p 1) + ;; See the comment in `whitespace--update-bob-eob' for why this + ;; text property is added here. + (put-text-property 1 whitespace-bob-marker + 'font-lock-multiline t)) + (when (< p e) + (set-match-data (list p e)) + (goto-char e)))) + +(defsubst whitespace--looking-back (regexp) (save-excursion - (when (/= 0 (skip-chars-backward " \t\n" limit)) + (when (/= 0 (skip-chars-backward " \t\n")) (unless (bolp) (forward-line 1)) (looking-at regexp)))) - -(defun whitespace-empty-at-eob-regexp (limit) - "Match spaces at end of buffer which do not contain the point at end of \ -buffer." - (let ((b (point)) - (e (1+ (buffer-size))) - r) - (cond - ;; at eob - ((= limit e) - (goto-char limit) - (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)) - (when (and r (= whitespace-point e)) - (setq r nil) - (whitespace-point--used (match-beginning 0) (match-end 0))) - (if r - (set-marker whitespace-eob-marker (match-beginning 1)) - (set-marker whitespace-eob-marker limit) - (goto-char b))) ; return back to initial position - ;; inside eob empty region - ((>= b whitespace-eob-marker) - (goto-char limit) - (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)) - (if r - (when (> (match-beginning 1) b) - (set-marker whitespace-eob-marker (match-beginning 1))) - (set-marker whitespace-eob-marker limit) - (goto-char b))) ; return back to initial position - ;; intersection with beginning of eob empty region - ((>= limit whitespace-eob-marker) - (goto-char limit) - (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)) - (if r - (set-marker whitespace-eob-marker (match-beginning 1)) - (set-marker whitespace-eob-marker limit) - (goto-char b))) ; return back to initial position - ;; it is not inside eob empty region - (t - (setq r nil))) - r)) - +(defun whitespace--empty-at-eob-matcher (limit) + "Match empty/space-only lines at end of buffer (EoB). +Match does not extend past position LIMIT. For improved UX, the +line containing `whitespace-point' and preceding lines are +excluded from the match. (The idea is that the user might be +about to start typing, and if they do, that line and previous +empty lines will no longer be EoB empty lines. Highlighting +those lines can be distracting.)" + (when (= limit (1+ (buffer-size))) + ;; See the comment in `whitespace--update-bob-eob' for why this + ;; text property is added here. + (put-text-property whitespace-eob-marker limit + 'font-lock-multiline t)) + (let ((b (max (point) whitespace-eob-marker + whitespace-bob-marker ; See comment in the bob func. + (save-excursion (goto-char whitespace-point) + (forward-line 1) + (point))))) + (when (< b limit) + (set-match-data (list b limit)) + (goto-char limit)))) (defun whitespace-buffer-changed (_beg _end) "Set `whitespace-buffer-changed' variable to t." (setq whitespace-buffer-changed t)) - (defun whitespace-post-command-hook () "Save current point into `whitespace-point' variable. Also refontify when necessary." (unless (and (eq whitespace-point (point)) (not whitespace-buffer-changed)) + (when (and (not whitespace-buffer-changed) + (memq 'empty whitespace-active-style)) + ;; No need to handle the `whitespace-buffer-changed' case here + ;; because that is taken care of by the `font-lock-multiline' + ;; text property. + (when (<= (min (point) whitespace-point) whitespace-bob-marker) + (font-lock-flush 1 whitespace-bob-marker)) + (when (>= (max (point) whitespace-point) whitespace-eob-marker) + (font-lock-flush whitespace-eob-marker (1+ (buffer-size))))) (setq-local whitespace-buffer-changed nil) (setq whitespace-point (point)) ; current point position - (let ((refontify - (cond - ;; It is at end of buffer (eob). - ((= whitespace-point (1+ (buffer-size))) - (when (whitespace-looking-back whitespace-empty-at-eob-regexp - nil) - (match-beginning 0))) - ;; It is at end of line ... - ((and (eolp) - ;; ... with trailing SPACE or TAB - (or (memq (preceding-char) '(?\s ?\t)))) - (line-beginning-position)) - ;; It is at beginning of buffer (bob). - ((and (= whitespace-point 1) - (looking-at whitespace-empty-at-bob-regexp)) - (match-end 0)))) + (let ((refontify (and (eolp) ; It is at end of line ... + ;; ... with trailing SPACE or TAB + (or (memq (preceding-char) '(?\s ?\t))) + (line-beginning-position))) (ostart (overlay-start whitespace-point--used))) (cond ((not refontify) @@ -2363,6 +2347,77 @@ to `indent-tabs-mode' and `tab-width'." (when whitespace-mode (font-lock-flush))))) +(defun whitespace--update-bob-eob (&optional beg end &rest _) + "Update `whitespace-bob-marker' and `whitespace-eob-marker'. +Also apply `font-lock-multiline' text property. If BEG and END +are non-nil, assume that only characters in that range have +changed since the last call to this function (for optimization +purposes)." + (when (memq 'empty whitespace-active-style) + ;; When a line is changed, `font-lock-mode' normally limits + ;; re-processing to only the changed line. That behavior is + ;; problematic for highlighting `empty' lines because adding or + ;; deleting a character might affect lines before or after the + ;; change. To address this, all `empty' lines are marked with a + ;; non-nil `font-lock-multiline' text property. This forces + ;; `font-lock-mode' to re-process all of the lines whenever + ;; there's an edit within any one of them. + ;; + ;; The text property must be set on `empty' lines twice per + ;; relevant change: + ;; + ;; 1. Before the change. This is necessary to ensure that + ;; previously highlighted lines become un-highlighted if + ;; necessary. The text property must be added after the + ;; previous `font-lock-mode' run (the run in reaction to the + ;; previous change) because `font-lock-mode' clears the text + ;; property when it runs. + ;; + ;; 2. After the change, but before `font-lock-mode' reacts to + ;; the change. This is necessary to ensure that new `empty' + ;; lines become highlighted. + ;; + ;; This hook function is responsible for #2, while the + ;; `whitespace--empty-at-bob-matcher' and + ;; `whitespace--empty-at-eob-matcher' functions are responsible + ;; for #1. (Those functions run after `font-lock-mode' clears the + ;; text property and before the next change.) + (save-excursion + (save-restriction + (widen) + (when (or (null beg) + (<= beg (save-excursion + (goto-char whitespace-bob-marker) + ;; Any change in the first non-`empty' + ;; line, even if it's not the first + ;; character in the line, can potentially + ;; cause subsequent lines to become + ;; classified as `empty' (e.g., delete the + ;; "x" from " x"). + (forward-line 1) + (point)))) + (goto-char 1) + (set-marker whitespace-bob-marker (point)) + (save-match-data + (when (looking-at whitespace-empty-at-bob-regexp) + (set-marker whitespace-bob-marker (match-end 1)) + (put-text-property (match-beginning 1) (match-end 1) + 'font-lock-multiline t)))) + (when (or (null end) + (>= end (save-excursion + (goto-char whitespace-eob-marker) + ;; See above comment for the BoB case. + (forward-line -1) + (point)))) + (goto-char (1+ (buffer-size))) + (set-marker whitespace-eob-marker (point)) + (save-match-data + (when (whitespace--looking-back + whitespace-empty-at-eob-regexp) + (set-marker whitespace-eob-marker (match-beginning 1)) + (put-text-property (match-beginning 1) (match-end 1) + 'font-lock-multiline t)))))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Hacked from visws.el (Miles Bader ) diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el index 2a59bfe9d8..792e157ec0 100644 --- a/test/lisp/whitespace-tests.el +++ b/test/lisp/whitespace-tests.el @@ -20,8 +20,35 @@ ;;; Code: (require 'ert) +(require 'ert-x) +(require 'faceup) (require 'whitespace) +(defmacro whitespace-tests--with-test-buffer (style &rest body) + "Run BODY in a buffer with `whitespace-mode' style STYLE. +The buffer is displayed in `selected-window', and +`noninteractive' is set to nil even in batch mode." + (declare (debug ((style form) def-body)) + (indent 1)) + `(ert-with-test-buffer-selected () + ;; In case global-*-mode is enabled. + (whitespace-mode -1) + (font-lock-mode -1) + (let ((noninteractive nil) + (whitespace-style ,style)) + (font-lock-mode 1) + (whitespace-mode 1) + ,@body))) + +(defun whitespace-tests--faceup (&rest lines) + "Convenience wrapper around `faceup-test-font-lock-buffer'. +Returns non-nil if the concatenated LINES match the current +buffer's content." + (faceup-test-font-lock-buffer nil (apply #'concat lines))) +(let ((x (get 'faceup-test-font-lock-buffer 'ert-explainer))) + (put 'whitespace-tests--faceup 'ert-explainer + (lambda (&rest lines) (funcall x nil (apply #'concat lines))))) + (defun whitespace-tests--cleanup-string (string) (with-temp-buffer (insert string) @@ -80,6 +107,209 @@ (whitespace-turn-off) buffer-display-table)))))) +(ert-deftest whitespace-tests--empty-bob () + (whitespace-tests--with-test-buffer '(face empty) + (electric-indent-mode -1) + + ;; Insert some empty lines. None of the lines should be + ;; highlighted even though point is on the last line because the + ;; entire buffer is empty lines. + (execute-kbd-macro (kbd "SPC RET C-q TAB RET RET SPC")) + (should (equal (buffer-string) " \n\t\n\n ")) + (should (equal (line-number-at-pos) 4)) + (should (whitespace-tests--faceup " \n" + "\t\n" + "\n" + " ")) + + ;; Adding content on the last line (and keeping point there) + ;; should cause the previous lines to be highlighted. Note that + ;; the `whitespace-empty' face applies to the newline just before + ;; the last line, which has the desired property of extending the + ;; highlight the full width of the window. + (execute-kbd-macro (kbd "x")) + (should (equal (buffer-string) " \n\t\n\n x")) + (should (equal (line-number-at-pos) 4)) + (should (whitespace-tests--faceup "«:whitespace-empty: \n" + "\t\n" + "\n" + "» x")) + + ;; Lines should become un-highlighted as point moves up into the + ;; empty lines. + (execute-kbd-macro (kbd "")) + (should (equal (line-number-at-pos) 3)) + (should (whitespace-tests--faceup "«:whitespace-empty: \n" + "\t\n" + "»\n" + " x")) + (execute-kbd-macro (kbd "")) + (should (equal (line-number-at-pos) 2)) + (should (whitespace-tests--faceup "«:whitespace-empty: \n" + "»\t\n" + "\n" + " x")) + (execute-kbd-macro (kbd " ")) + (should (equal (point) 1)) + (should (whitespace-tests--faceup " \n" + "\t\n" + "\n" + " x")) + + ;; Line 1 should be un-highlighted when point is in line 1 even if + ;; point is not bobp. + (execute-kbd-macro (kbd "")) + (should (equal (line-number-at-pos) 1)) + (should (> (point) 1)) + (should (whitespace-tests--faceup " \n" + "\t\n" + "\n" + " x")) + + ;; Make sure lines become re-highlighted as point moves down. + (execute-kbd-macro (kbd "")) + (should (equal (line-number-at-pos) 2)) + (should (whitespace-tests--faceup "«:whitespace-empty: \n" + "»\t\n" + "\n" + " x")) + (execute-kbd-macro (kbd "")) + (should (equal (line-number-at-pos) 3)) + (should (whitespace-tests--faceup "«:whitespace-empty: \n" + "\t\n" + "»\n" + " x")) + (execute-kbd-macro (kbd "")) + (should (equal (line-number-at-pos) 4)) + (should (whitespace-tests--faceup "«:whitespace-empty: \n" + "\t\n" + "\n" + "» x")) + + ;; Inserting content on line 2 should un-highlight lines 2 and 3. + (execute-kbd-macro (kbd " ")) + (should (equal (line-number-at-pos) 2)) + (should (equal (- (point) (line-beginning-position)) 1)) + (execute-kbd-macro (kbd "y ")) + (should (equal (line-number-at-pos) 4)) + (should (whitespace-tests--faceup "«:whitespace-empty: \n" + "»\ty\n" + "\n" + " x")) + + ;; Removing the content on line 2 should re-highlight lines 2 and + ;; 3. + (execute-kbd-macro (kbd " ")) + (should (equal (line-number-at-pos) 2)) + (should (equal (- (point) (line-beginning-position)) 2)) + (execute-kbd-macro (kbd "DEL ")) + (should (equal (line-number-at-pos) 4)) + (should (whitespace-tests--faceup "«:whitespace-empty: \n" + "\t\n" + "\n" + "» x")))) + +(ert-deftest whitespace-tests--empty-eob () + (whitespace-tests--with-test-buffer '(face empty) + (electric-indent-mode -1) + + ;; Insert some empty lines. None of the lines should be + ;; highlighted even though point is on line 1 because the entire + ;; buffer is empty lines. + (execute-kbd-macro (kbd "RET RET C-q TAB RET SPC C-")) + (should (equal (buffer-string) "\n\n\t\n ")) + (should (equal (line-number-at-pos) 1)) + (should (whitespace-tests--faceup "\n" + "\n" + "\t\n" + " ")) + + ;; Adding content on the first line (and keeping point there) + ;; should cause the subsequent lines to be highlighted. + (execute-kbd-macro (kbd "x")) + (should (equal (buffer-string) "x\n\n\t\n ")) + (should (equal (line-number-at-pos) 1)) + (should (whitespace-tests--faceup "x\n" + "«:whitespace-empty:\n" + "\t\n" + " »")) + + ;; Lines should become un-highlighted as point moves down into the + ;; empty lines. + (execute-kbd-macro (kbd "")) + (should (equal (line-number-at-pos) 2)) + (should (whitespace-tests--faceup "x\n" + "\n" + "«:whitespace-empty:\t\n" + " »")) + (execute-kbd-macro (kbd "")) + (should (equal (line-number-at-pos) 3)) + (should (whitespace-tests--faceup "x\n" + "\n" + "\t\n" + "«:whitespace-empty: »")) + (execute-kbd-macro (kbd "C-")) + (should (equal (line-number-at-pos) 4)) + (should (eobp)) + (should (equal (- (point) (line-beginning-position)) 1)) + (should (whitespace-tests--faceup "x\n" + "\n" + "\t\n" + " ")) + + ;; The last line should be un-highlighted when point is in that + ;; line even if point is not eobp. + (execute-kbd-macro (kbd "")) + (should (equal (line-number-at-pos) 4)) + (should (not (eobp))) + (should (whitespace-tests--faceup "x\n" + "\n" + "\t\n" + " ")) + + ;; Make sure lines become re-highlighted as point moves up. + (execute-kbd-macro (kbd "")) + (should (equal (line-number-at-pos) 3)) + (should (whitespace-tests--faceup "x\n" + "\n" + "\t\n" + "«:whitespace-empty: »")) + (execute-kbd-macro (kbd "")) + (should (equal (line-number-at-pos) 2)) + (should (whitespace-tests--faceup "x\n" + "\n" + "«:whitespace-empty:\t\n" + " »")) + (execute-kbd-macro (kbd "")) + (should (equal (line-number-at-pos) 1)) + (should (whitespace-tests--faceup "x\n" + "«:whitespace-empty:\n" + "\t\n" + " »")) + + ;; Inserting content on line 3 should un-highlight lines 2 and 3. + (execute-kbd-macro (kbd " ")) + (should (equal (line-number-at-pos) 3)) + (should (equal (- (point) (line-beginning-position)) 0)) + (execute-kbd-macro (kbd "y ")) + (should (equal (line-number-at-pos) 1)) + (should (whitespace-tests--faceup "x\n" + "\n" + "y\t\n" + "«:whitespace-empty: »")) + + ;; Removing the content on line 3 should re-highlight lines 2 and + ;; 3. + (execute-kbd-macro (kbd " ")) + (should (equal (line-number-at-pos) 3)) + (should (equal (- (point) (line-beginning-position)) 0)) + (execute-kbd-macro (kbd " ")) + (should (equal (line-number-at-pos) 1)) + (should (whitespace-tests--faceup "x\n" + "«:whitespace-empty:\n" + "\t\n" + " »")))) + (provide 'whitespace-tests) ;;; whitespace-tests.el ends here commit 395786f42b0eed361ee34cd398bc8ee33802ed04 Author: Richard Hansen Date: Tue Jun 28 15:05:04 2022 -0400 whitespace: Include empty final line in BoB empty match * lisp/whitespace.el (whitespace-empty-at-bob-regexp): Include any last line trailing whitespace in the BoB empty line match to ensure that those characters get highlighted. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 4a8117b75e..8146eff9b0 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -730,7 +730,7 @@ Used when `whitespace-style' includes `indentation', :group 'whitespace) -(defcustom whitespace-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)" +(defcustom whitespace-empty-at-bob-regexp "\\`\\([ \t\n]*\\(?:\n\\|$\\)\\)" "Specify regexp for empty lines at beginning of buffer. Used when `whitespace-style' includes `empty'." commit 99e8faa7257affd84c030fe02108769fe354709e Author: Richard Hansen Date: Wed Jun 22 17:29:39 2022 -0400 whitespace: Reset `whitespace-buffer-changed' when refontifying * lisp/whitespace.el (whitespace-post-command-hook): Add missing reset of `whitespace-buffer-changed' back to nil between commands. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 57c2214695..4a8117b75e 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -2292,6 +2292,7 @@ buffer." Also refontify when necessary." (unless (and (eq whitespace-point (point)) (not whitespace-buffer-changed)) + (setq-local whitespace-buffer-changed nil) (setq whitespace-point (point)) ; current point position (let ((refontify (cond commit dd02725c57088550255ec00438513f849dcf6a4c Author: Richard Hansen Date: Wed Jun 22 19:02:42 2022 -0400 ; whitespace: Use `defvar-local' for buffer-local vars diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 1d28ae2e1c..57c2214695 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1129,24 +1129,24 @@ SYMBOL is a valid symbol associated with CHAR. See `whitespace-style-value-list'.") -(defvar whitespace-active-style nil +(defvar-local whitespace-active-style nil "Used to save locally `whitespace-style' value.") -(defvar whitespace-point (point) +(defvar-local whitespace-point (point) "Used to save locally current point value. Used by function `whitespace-trailing-regexp' (which see).") (defvar-local whitespace-point--used nil "Region whose highlighting depends on `whitespace-point'.") -(defvar whitespace-bob-marker nil +(defvar-local whitespace-bob-marker nil "Used to save locally the bob marker value. Used by function `whitespace-post-command-hook' (which see).") -(defvar whitespace-eob-marker nil +(defvar-local whitespace-eob-marker nil "Used to save locally the eob marker value. Used by function `whitespace-post-command-hook' (which see).") -(defvar whitespace-buffer-changed nil +(defvar-local whitespace-buffer-changed nil "Used to indicate locally if buffer changed. Used by `whitespace-post-command-hook' and `whitespace-buffer-changed' functions (which see).") @@ -1766,7 +1766,7 @@ cleaning up these problems." ;;;; Internal functions -(defvar whitespace-font-lock-keywords nil +(defvar-local whitespace-font-lock-keywords nil "Used to save the value `whitespace-color-on' adds to `font-lock-keywords'.") @@ -1993,10 +1993,10 @@ resultant list will be returned." the-list) -(defvar whitespace-display-table nil +(defvar-local whitespace-display-table nil "Used to save a local display table.") -(defvar whitespace-display-table-was-local nil +(defvar-local whitespace-display-table-was-local nil "Used to remember whether a buffer initially had a local display table.") (defun whitespace-turn-on () commit b6da1e4221ae50fe75c246deafe9d2455d4ca558 Author: Richard Hansen Date: Wed Jun 22 18:06:49 2022 -0400 ; whitespace: Delete unused `whitespace-font-lock-refontify' var diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 41b0a34f9e..1d28ae2e1c 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1138,10 +1138,6 @@ Used by function `whitespace-trailing-regexp' (which see).") (defvar-local whitespace-point--used nil "Region whose highlighting depends on `whitespace-point'.") -(defvar whitespace-font-lock-refontify nil - "Used to save locally the font-lock refontify state. -Used by function `whitespace-post-command-hook' (which see).") - (defvar whitespace-bob-marker nil "Used to save locally the bob marker value. Used by function `whitespace-post-command-hook' (which see).") @@ -2061,7 +2057,6 @@ resultant list will be returned." (setq whitespace-point--used (let ((ol (make-overlay (point) (point) nil nil t))) (delete-overlay ol) ol)) - (setq-local whitespace-font-lock-refontify 0) (setq-local whitespace-bob-marker (point-min-marker)) (setq-local whitespace-eob-marker (point-max-marker)) (setq-local whitespace-buffer-changed nil) commit 10573e0db7789f933a578d9a89d18b83a1cf6729 Author: Richard Hansen Date: Tue Jun 28 01:10:48 2022 -0400 ert-x: New `ert-with-test-buffer-selected' convenience macro * lisp/emacs-lisp/ert-x.el (ert-with-test-buffer-selected): New convenience macro that extends `ert-with-test-buffer' by displaying the test buffer in a temporary selected window. This makes it easier to simulate user input in the body via `execute-kbd-macro'. * test/lisp/emacs-lisp/ert-x-tests.el (ert-test-test-buffer-selected/*): Add tests. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 4436d0a4b1..fe291290a2 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -102,6 +102,35 @@ the name of the test and the result of NAME-FORM." (indent 1)) `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) +(cl-defmacro ert-with-test-buffer-selected ((&key name) + &body body) + "Create a test buffer, switch to it, and run BODY. + +This extends `ert-with-test-buffer' by displaying the test +buffer (whose name is derived from NAME) in a temporary window. +The temporary window becomes the `selected-window' before BODY is +evaluated. The modification hooks `before-change-functions' and +`after-change-functions' are not inhibited during the evaluation +of BODY, which makes it easier to use `execute-kbd-macro' to +simulate user interaction. The window configuration is restored +before returning, even if BODY exits nonlocally. The return +value is the last form in BODY." + (declare (debug ((":name" form) def-body)) + (indent 1)) + (let ((ret (make-symbol "ert--with-test-buffer-selected-ret"))) + `(save-window-excursion + (let (,ret) + (ert-with-test-buffer (:name ,name) + (with-current-buffer-window (current-buffer) + `(display-buffer-below-selected + (body-function + . ,(lambda (window) + (select-window window t) + (let ((inhibit-modification-hooks nil)) + (setq ,ret (progn ,@body)))))) + nil)) + ,ret)))) + ;;;###autoload (defun ert-kill-all-test-buffers () "Kill all test buffers that are still live." diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index 3869804110..63e7cd7608 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -82,6 +82,21 @@ (should-not (buffer-live-p buffer-1)) (should (buffer-live-p buffer-2)))))) +(ert-deftest ert-test-with-test-buffer-selected/selected () + (ert-with-test-buffer-selected () + (should (eq (window-buffer) (current-buffer))))) + +(ert-deftest ert-test-with-test-buffer-selected/modification-hooks () + (ert-with-test-buffer-selected () + (should (null inhibit-modification-hooks)))) + +(ert-deftest ert-test-with-test-buffer-selected/return-value () + (should (equal (ert-with-test-buffer-selected () "foo") "foo"))) + +(ert-deftest ert-test-with-test-buffer-selected/buffer-name () + (should (equal (ert-with-test-buffer (:name "foo") (buffer-name)) + (ert-with-test-buffer-selected (:name "foo") + (buffer-name))))) (ert-deftest ert-filter-string () (should (equal (ert-filter-string "foo bar baz" "quux") commit feffb03a362ecb9c68d8a852a0cbc6c37c0c6c4b Author: Philip Kaludercic Date: Sun Sep 11 13:28:38 2022 +0200 Revert "Add new command 'toggle-theme'" This reverts commit f31b9d86a67f1b3fd70339f277dff52478890351. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 3dabba9d2f..ff7ab83190 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -667,11 +667,6 @@ type @kbd{M-x disable-theme}. the @file{*Custom Themes*} buffer; or type @kbd{M-x describe-theme} anywhere in Emacs and enter the theme name. -@findex toggle-theme - Some themes have dual variants (most often these are light and dark -pairs). You can switch between these by typing @kbd{M-x -toggle-theme}. Note that this only works if only one theme is active. - @node Creating Custom Themes @subsection Creating Custom Themes @cindex custom themes, creating diff --git a/etc/themes/leuven-dark-theme.el b/etc/themes/leuven-dark-theme.el index cef40782c1..0e162c8bab 100644 --- a/etc/themes/leuven-dark-theme.el +++ b/etc/themes/leuven-dark-theme.el @@ -5,7 +5,7 @@ ;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")> ;; Contributor: Thibault Polge <(concat "thibault" at-sign "thb.lt")> ;; URL: https://github.com/fniessen/emacs-leuven-dark-theme -;; Version: 20220906.2016 +;; Version: 20220202.1126 ;; Keywords: color theme ;; This file is part of GNU Emacs. @@ -1083,8 +1083,6 @@ more...") (add-to-list 'custom-theme-load-path (file-name-as-directory (file-name-directory load-file-name)))) -(put 'leuven-dark 'dual-theme 'leuven) ;see `toggle-theme' - (provide-theme 'leuven-dark) ;; This is for the sake of Emacs. diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el index 73ac96d28d..d9a8d5391a 100644 --- a/etc/themes/leuven-theme.el +++ b/etc/themes/leuven-theme.el @@ -4,7 +4,7 @@ ;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")> ;; URL: https://github.com/fniessen/emacs-leuven-theme -;; Version: 20220906.2016 +;; Version: 20200513.1928 ;; Keywords: color theme ;; This file is part of GNU Emacs. @@ -1065,8 +1065,6 @@ more...") (add-to-list 'custom-theme-load-path (file-name-as-directory (file-name-directory load-file-name)))) -(put 'leuven 'dual-theme 'leuven-dark) ;see `toggle-theme' - (provide-theme 'leuven) ;; This is for the sake of Emacs. diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el index f9f2692ac5..ef00d2ac49 100644 --- a/etc/themes/tango-dark-theme.el +++ b/etc/themes/tango-dark-theme.el @@ -190,8 +190,6 @@ Semantic, and Ansi-Color faces are included.") `(ansi-color-bright-white ((,class (:background ,alum-1 :foreground ,alum-1)))))) -(put 'tango-dark 'dual-theme 'tango) ;see `toggle-theme' - (provide-theme 'tango-dark) ;;; tango-dark-theme.el ends here diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el index 8d1686f05e..ecbbf03753 100644 --- a/etc/themes/tango-theme.el +++ b/etc/themes/tango-theme.el @@ -173,8 +173,6 @@ Semantic, and Ansi-Color faces are included.") `(ansi-color-bright-white ((,class (:background ,alum-1 :foreground ,alum-1)))))) -(put 'tango 'dual-theme 'tango-dark) ;see `toggle-theme' - (provide-theme 'tango) ;;; tango-theme.el ends here diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el index ad54eb3df0..a88ad75520 100644 --- a/etc/themes/tsdh-dark-theme.el +++ b/etc/themes/tsdh-dark-theme.el @@ -142,8 +142,6 @@ '(widget-field ((t (:box (:line-width 2 :color "grey75" :style pressed-button))))) '(window-number-face ((t (:foreground "red" :weight bold))))) -(put 'tsdh-dark 'dual-theme 'tsdh-light) ;see `toggle-theme' - (provide-theme 'tsdh-dark) ;;; tsdh-dark-theme.el ends here diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el index 64c048f7e5..d9d09b702b 100644 --- a/etc/themes/tsdh-light-theme.el +++ b/etc/themes/tsdh-light-theme.el @@ -104,8 +104,6 @@ Used and created by Tassilo Horn.") '(show-paren-mismatch ((t (:background "deep pink" :weight bold)))) '(window-number-face ((t (:foreground "red" :weight bold))))) -(put 'tsdh-light 'dual-theme 'tsdh-dark) ;see `toggle-theme' - (provide-theme 'tsdh-light) ;;; tsdh-light-theme.el ends here diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 80cae6d663..90680ff68f 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -515,8 +515,6 @@ It includes all faces in list FACES." (end-of-file nil))))) (and (eq (car-safe sexp) 'deftheme) (setq doc (nth 2 sexp))))))) - (when-let ((dual (get theme 'dual-theme))) - (princ (format " The dual theme is `%s'" dual))) (princ "\n\nDocumentation:\n") (princ (if (stringp doc) (substitute-command-keys doc) diff --git a/lisp/custom.el b/lisp/custom.el index b4d1ba7317..352b5b0e16 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1372,25 +1372,6 @@ Return t if THEME was successfully loaded, nil otherwise." (enable-theme theme)) t) -(defun toggle-theme (&optional no-confirm no-enable) - "Toggle the current active theme by enabling its dual pair. -The current theme will be immediately disabled before the dual -theme has been enabled. If THEME is not active an error will be -raised. If theme is nil For NO-CONFIRM and NO-ENABLE, see -`load-theme'." - (interactive) - (cond - ((length= custom-enabled-themes 0) - (user-error "No theme is active, cannot toggle")) - ((length> custom-enabled-themes 1) - (user-error "More than one theme active, cannot unambiguously toggle"))) - (let* ((theme (car custom-enabled-themes)) - (dual (get theme 'dual-theme))) - (unless dual - (error "`%s' has no dual theme to toggle between" theme)) - (disable-theme theme) - (load-theme dual no-confirm no-enable))) - (defun custom-theme-load-confirm (hash) "Query the user about loading a Custom theme that may not be safe. The theme should be in the current buffer. If the user agrees, commit 3f0944c51f1657b8fea9600d554890c68fa2dabe Author: Philip Kaludercic Date: Sun Sep 11 13:28:36 2022 +0200 Revert "Add new user option 'custom-ensure-single-theme'" This reverts commit b4dbf7184cd68ecd8d1a27fbc1407be0eae7e64c. diff --git a/etc/NEWS b/etc/NEWS index 2d2bd789fb..2f52e9bc37 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2932,17 +2932,6 @@ These are run after enabling and disabling a theme, respectively. Using 'make-obsolete' on a theme is now supported. This will make 'load-theme' issue a warning when loading the theme. -+++ -*** New command 'toggle-theme' -If a theme defines a dual pair (e.g. a light or dark variant) this -command can be used disable the current one and enable the other. - ---- -*** New user option 'custom-ensure-single-active-theme' -If non-nil, all themes will be disabled before a new theme is enabled, -so that there is always at most one active theme at any time. - - +++ ** New hook 'display-monitors-changed-functions'. It is called whenever the configuration of different monitors on a diff --git a/lisp/custom.el b/lisp/custom.el index d8baf21d96..b4d1ba7317 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1280,12 +1280,6 @@ This variable cannot be set in a Custom theme." :risky t :version "24.1") -(defcustom custom-ensure-single-active-theme nil - "Non-nil means that `load-theme' should ensure only one theme is active." - :type 'boolean - :group 'customize - :version "29.1") - (defun load-theme (theme &optional no-confirm no-enable) "Load Custom theme named THEME from its file and possibly enable it. The theme file is named THEME-theme.el, in one of the directories @@ -1310,9 +1304,6 @@ This function is normally called through Customize when setting should be called with a non-nil NO-CONFIRM argument, or after `custom-safe-themes' has been loaded. -If `custom-ensure-single-active-theme' is non-nil, all other active -themes will be disabled before THEME is enabled. - Return t if THEME was successfully loaded, nil otherwise." (interactive (list @@ -1376,9 +1367,6 @@ Return t if THEME was successfully loaded, nil otherwise." (setq tail (cdr tail))) (when found (put theme 'theme-settings (cons found (delq found settings))))) - ;; Check if the user only wants one theme to be active - (when custom-ensure-single-active-theme - (mapc #'disable-theme custom-enabled-themes)) ;; Finally, enable the theme. (unless no-enable (enable-theme theme)) commit 1c1aaa0ecd69184d4ade076d835e22f460e490ab Author: Philip Kaludercic Date: Sun Sep 11 13:12:39 2022 +0200 ; Use US spelling docstring * lisp/vc/diff-mode.el (diff-add-log-use-relative-names): Update docstring. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index d9eb9bba60..a9591c9d82 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2341,7 +2341,7 @@ Call FUN with two args (BEG and END) for each hunk." (defcustom diff-add-log-use-relative-names nil "Use relative file names when generating ChangeLog skeletons. The files will be relative to the root directory of the VC -repository. This option affects the behaviour of +repository. This option affects the behavior of `diff-add-log-current-defuns'." :type 'boolean :safe #'booleanp commit b4dbf7184cd68ecd8d1a27fbc1407be0eae7e64c Author: Philip Kaludercic Date: Tue Sep 6 21:04:08 2022 +0200 Add new user option 'custom-ensure-single-theme' * etc/NEWS: Mention it. * lisp/custom.el (custom-ensure-single-active-theme): Add it. (load-theme): Use it. diff --git a/etc/NEWS b/etc/NEWS index 2f52e9bc37..2d2bd789fb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2932,6 +2932,17 @@ These are run after enabling and disabling a theme, respectively. Using 'make-obsolete' on a theme is now supported. This will make 'load-theme' issue a warning when loading the theme. ++++ +*** New command 'toggle-theme' +If a theme defines a dual pair (e.g. a light or dark variant) this +command can be used disable the current one and enable the other. + +--- +*** New user option 'custom-ensure-single-active-theme' +If non-nil, all themes will be disabled before a new theme is enabled, +so that there is always at most one active theme at any time. + + +++ ** New hook 'display-monitors-changed-functions'. It is called whenever the configuration of different monitors on a diff --git a/lisp/custom.el b/lisp/custom.el index b4d1ba7317..d8baf21d96 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1280,6 +1280,12 @@ This variable cannot be set in a Custom theme." :risky t :version "24.1") +(defcustom custom-ensure-single-active-theme nil + "Non-nil means that `load-theme' should ensure only one theme is active." + :type 'boolean + :group 'customize + :version "29.1") + (defun load-theme (theme &optional no-confirm no-enable) "Load Custom theme named THEME from its file and possibly enable it. The theme file is named THEME-theme.el, in one of the directories @@ -1304,6 +1310,9 @@ This function is normally called through Customize when setting should be called with a non-nil NO-CONFIRM argument, or after `custom-safe-themes' has been loaded. +If `custom-ensure-single-active-theme' is non-nil, all other active +themes will be disabled before THEME is enabled. + Return t if THEME was successfully loaded, nil otherwise." (interactive (list @@ -1367,6 +1376,9 @@ Return t if THEME was successfully loaded, nil otherwise." (setq tail (cdr tail))) (when found (put theme 'theme-settings (cons found (delq found settings))))) + ;; Check if the user only wants one theme to be active + (when custom-ensure-single-active-theme + (mapc #'disable-theme custom-enabled-themes)) ;; Finally, enable the theme. (unless no-enable (enable-theme theme)) commit f31b9d86a67f1b3fd70339f277dff52478890351 Author: Philip Kaludercic Date: Tue Sep 6 20:53:35 2022 +0200 Add new command 'toggle-theme' * doc/emacs/custom.texi (Custom Themes): Mention it. * etc/themes/leuven-dark-theme.el (leuven-dark): Add dual theme. * etc/themes/leuven-theme.el (leuven): Add dual theme. * etc/themes/tango-dark-theme.el (tango-dark): Add dual theme. * etc/themes/tango-theme.el (tango): Add dual theme. * etc/themes/tsdh-dark-theme.el (tsdh-dark): Add dual theme. * etc/themes/tsdh-light-theme.el (tsdh-light): Add dual theme. * lisp/cus-theme.el (describe-theme-1): Say if a theme has a dual. * lisp/custom.el (toggle-theme): Add new command. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index ff7ab83190..3dabba9d2f 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -667,6 +667,11 @@ type @kbd{M-x disable-theme}. the @file{*Custom Themes*} buffer; or type @kbd{M-x describe-theme} anywhere in Emacs and enter the theme name. +@findex toggle-theme + Some themes have dual variants (most often these are light and dark +pairs). You can switch between these by typing @kbd{M-x +toggle-theme}. Note that this only works if only one theme is active. + @node Creating Custom Themes @subsection Creating Custom Themes @cindex custom themes, creating diff --git a/etc/themes/leuven-dark-theme.el b/etc/themes/leuven-dark-theme.el index 0e162c8bab..cef40782c1 100644 --- a/etc/themes/leuven-dark-theme.el +++ b/etc/themes/leuven-dark-theme.el @@ -5,7 +5,7 @@ ;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")> ;; Contributor: Thibault Polge <(concat "thibault" at-sign "thb.lt")> ;; URL: https://github.com/fniessen/emacs-leuven-dark-theme -;; Version: 20220202.1126 +;; Version: 20220906.2016 ;; Keywords: color theme ;; This file is part of GNU Emacs. @@ -1083,6 +1083,8 @@ more...") (add-to-list 'custom-theme-load-path (file-name-as-directory (file-name-directory load-file-name)))) +(put 'leuven-dark 'dual-theme 'leuven) ;see `toggle-theme' + (provide-theme 'leuven-dark) ;; This is for the sake of Emacs. diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el index d9a8d5391a..73ac96d28d 100644 --- a/etc/themes/leuven-theme.el +++ b/etc/themes/leuven-theme.el @@ -4,7 +4,7 @@ ;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")> ;; URL: https://github.com/fniessen/emacs-leuven-theme -;; Version: 20200513.1928 +;; Version: 20220906.2016 ;; Keywords: color theme ;; This file is part of GNU Emacs. @@ -1065,6 +1065,8 @@ more...") (add-to-list 'custom-theme-load-path (file-name-as-directory (file-name-directory load-file-name)))) +(put 'leuven 'dual-theme 'leuven-dark) ;see `toggle-theme' + (provide-theme 'leuven) ;; This is for the sake of Emacs. diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el index ef00d2ac49..f9f2692ac5 100644 --- a/etc/themes/tango-dark-theme.el +++ b/etc/themes/tango-dark-theme.el @@ -190,6 +190,8 @@ Semantic, and Ansi-Color faces are included.") `(ansi-color-bright-white ((,class (:background ,alum-1 :foreground ,alum-1)))))) +(put 'tango-dark 'dual-theme 'tango) ;see `toggle-theme' + (provide-theme 'tango-dark) ;;; tango-dark-theme.el ends here diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el index ecbbf03753..8d1686f05e 100644 --- a/etc/themes/tango-theme.el +++ b/etc/themes/tango-theme.el @@ -173,6 +173,8 @@ Semantic, and Ansi-Color faces are included.") `(ansi-color-bright-white ((,class (:background ,alum-1 :foreground ,alum-1)))))) +(put 'tango 'dual-theme 'tango-dark) ;see `toggle-theme' + (provide-theme 'tango) ;;; tango-theme.el ends here diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el index a88ad75520..ad54eb3df0 100644 --- a/etc/themes/tsdh-dark-theme.el +++ b/etc/themes/tsdh-dark-theme.el @@ -142,6 +142,8 @@ '(widget-field ((t (:box (:line-width 2 :color "grey75" :style pressed-button))))) '(window-number-face ((t (:foreground "red" :weight bold))))) +(put 'tsdh-dark 'dual-theme 'tsdh-light) ;see `toggle-theme' + (provide-theme 'tsdh-dark) ;;; tsdh-dark-theme.el ends here diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el index d9d09b702b..64c048f7e5 100644 --- a/etc/themes/tsdh-light-theme.el +++ b/etc/themes/tsdh-light-theme.el @@ -104,6 +104,8 @@ Used and created by Tassilo Horn.") '(show-paren-mismatch ((t (:background "deep pink" :weight bold)))) '(window-number-face ((t (:foreground "red" :weight bold))))) +(put 'tsdh-light 'dual-theme 'tsdh-dark) ;see `toggle-theme' + (provide-theme 'tsdh-light) ;;; tsdh-light-theme.el ends here diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 90680ff68f..80cae6d663 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -515,6 +515,8 @@ It includes all faces in list FACES." (end-of-file nil))))) (and (eq (car-safe sexp) 'deftheme) (setq doc (nth 2 sexp))))))) + (when-let ((dual (get theme 'dual-theme))) + (princ (format " The dual theme is `%s'" dual))) (princ "\n\nDocumentation:\n") (princ (if (stringp doc) (substitute-command-keys doc) diff --git a/lisp/custom.el b/lisp/custom.el index 352b5b0e16..b4d1ba7317 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1372,6 +1372,25 @@ Return t if THEME was successfully loaded, nil otherwise." (enable-theme theme)) t) +(defun toggle-theme (&optional no-confirm no-enable) + "Toggle the current active theme by enabling its dual pair. +The current theme will be immediately disabled before the dual +theme has been enabled. If THEME is not active an error will be +raised. If theme is nil For NO-CONFIRM and NO-ENABLE, see +`load-theme'." + (interactive) + (cond + ((length= custom-enabled-themes 0) + (user-error "No theme is active, cannot toggle")) + ((length> custom-enabled-themes 1) + (user-error "More than one theme active, cannot unambiguously toggle"))) + (let* ((theme (car custom-enabled-themes)) + (dual (get theme 'dual-theme))) + (unless dual + (error "`%s' has no dual theme to toggle between" theme)) + (disable-theme theme) + (load-theme dual no-confirm no-enable))) + (defun custom-theme-load-confirm (hash) "Query the user about loading a Custom theme that may not be safe. The theme should be in the current buffer. If the user agrees, commit 1d08e480201f39c99a964f090672308b8c92bef8 Author: Miha Rihtaršič Date: Sun Sep 11 12:59:02 2022 +0200 Improve some shell highlight doc strings * lisp/shell.el (shell-highlight-undef-mode-restart): Rename function. * lisp/shell.el (shell-comint-fl-enable): (shell--highlight-undef-indirect) * lisp/ielm.el (ielm-comint-fl-enable): * lisp/comint.el: (comint--fl-fontify-region): Improve doc strings. diff --git a/lisp/comint.el b/lisp/comint.el index 751e561d3e..696dac3d12 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -4030,9 +4030,13 @@ 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." + "Hook run in an indirect buffer for input fontification. +Input fontification and indentation, if enabled, is performed in +an indirect buffer, whose major mode and syntax highlighting are +set up according to `comint-indirect-setup-function'. After this +setup is done, run this hook with the indirect buffer as the +current buffer. This can be used to further customize +fontification and other behaviour of the indirect buffer." :group 'comint :type 'hook :version "29.1") @@ -4117,8 +4121,8 @@ setting." (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 +First, fontify the region between BEG and END using FUN. Then +fontify 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." diff --git a/lisp/ielm.el b/lisp/ielm.el index 211804210c..4a10c00297 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -475,16 +475,23 @@ nonempty, then flushes the buffer." ;;; Input fontification (defcustom ielm-comint-fl-enable t - "Enable highlighting of input in ielm buffers. + "Enable fontification 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 +the command `comint-fl-mode' to toggle fontification 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." + "Hook run in an indirect buffer for input fontification. +Input fontification and indentation of an IELM buffer, if +enabled, is performed in an indirect buffer, whose indentation +and syntax highlighting are set up with `emacs-lisp-mode'. In +addition to `comint-indirect-setup-hook', run this hook with the +indirect buffer as the current buffer after its setup is done. +This can be used to further customize fontification and other +behaviour of the indirect buffer." :type 'boolean :safe 'booleanp :version "29.1") diff --git a/lisp/shell.el b/lisp/shell.el index eccac66376..87fd36a592 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -309,16 +309,23 @@ for Shell mode only." :group 'shell) (defcustom shell-comint-fl-enable t - "Enable highlighting of input in shell buffers. + "Enable fontification 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." +command `comint-fl-mode' to toggle fontification 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." + "Hook run in an indirect buffer for input fontification. +Input fontification and indentation of a `shell-mode' buffer, if +enabled, is performed in an indirect buffer, whose indentation +and syntax highlighting is set up with `sh-mode'. In addition to +`comint-indirect-setup-hook', run this hook with the indirect +buffer as the current buffer after its setup is done. This can +be used to further customize fontification and other behaviour of +the indirect buffer." :type 'boolean :group 'shell :safe 'booleanp @@ -1680,7 +1687,7 @@ Similar to `executable-find', but use cache stored in t)) (defvar-local shell--highlight-undef-indirect nil - "t if shell commands are fontified in `comint-indirect-buffer'.") + "Non-nil if shell commands are fontified in `comint-indirect-buffer'.") (declare-function sh-feature "sh-script" (alist &optional function)) (defvar sh-leading-keywords) @@ -1700,7 +1707,7 @@ works better if `comint-fl-mode' is enabled." (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) + #'shell-highlight-undef-mode-restart t) (when shell-highlight-undef-mode (when comint-use-prompt-regexp @@ -1742,12 +1749,16 @@ works better if `comint-fl-mode' is enabled." (t (funcall setup)))) (add-hook 'comint-fl-mode-hook - #'shell-highlight-undef-reset-mode nil t)) + #'shell-highlight-undef-mode-restart nil t)) (font-lock-flush)) -(defun shell-highlight-undef-reset-mode () - "If `shell-highlight-undef-mode' is on, turn it off and on." +(defun shell-highlight-undef-mode-restart () + "If `shell-highlight-undef-mode' is on, restart it. +`shell-highlight-undef-mode' performs its setup differently +depending on `comint-fl-mode'. It's useful to call this function +when switching `comint-fl-mode' in order to make +`shell-highlight-undef-mode' redo its setup." (when shell-highlight-undef-mode (shell-highlight-undef-mode 1))) commit a380ce2008e944486946b0083aa58cc8161176c6 Author: Po Lu Date: Sun Sep 11 16:50:16 2022 +0800 Make it easier to clear the Motif drag window for debugging * src/xterm.c (xm_get_drag_window_1): Add comment explaining side effect of x_special_window_exists_p. (handle_one_xevent): Clear Motif drag window upon DestroyNotify. In addition to debugging, it also reduces syncs necessary to communicate via the Motif protocol after a defective/old client sets the drag window without setting the disconnect mode. diff --git a/src/xterm.c b/src/xterm.c index 4ac42a9138..12234351a3 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1971,6 +1971,10 @@ xm_get_drag_window_1 (struct x_display_info *dpyinfo) && tmp_data) { drag_window = *(Window *) tmp_data; + + /* This has the side effect of selecting for + StructureNotifyMask, meaning that we will get notifications + once it is deleted. */ rc = x_special_window_exists_p (dpyinfo, drag_window); if (!rc) @@ -20707,6 +20711,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, == dpyinfo->net_supported_window) dpyinfo->net_supported_window = None; + if (event->xdestroywindow.window + == dpyinfo->motif_drag_window) + /* We get DestroyNotify events for the drag window because + x_special_window_exists_p selects for structure + notification. The drag window is not supposed to go away + but not all clients obey that requirement when setting the + drag window property. */ + dpyinfo->motif_drag_window = None; + xft_settings_event (dpyinfo, event); break; commit 8a902013e4d390ec077baff29f96e9fd12e2f392 Author: Juri Linkov Date: Sun Sep 11 11:22:11 2022 +0300 * lisp/vc/vc.el (vc-diff-patch-string): Fix arg in revert-buffer-function. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index c4f0671d64..c75356c4bd 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1808,7 +1808,8 @@ in the output buffer." (setq buffer-read-only t) (diff-mode) (setq-local diff-vc-backend (vc-responsible-backend default-directory)) - (setq-local revert-buffer-function (lambda (_ _) (vc-diff-patch-string))) + (setq-local revert-buffer-function + (lambda (_ _) (vc-diff-patch-string patch-string))) (setq-local vc-patch-string patch-string) (pop-to-buffer (current-buffer)) (vc-run-delayed (vc-diff-finish (current-buffer) nil))))