commit 31919508392dd2a6749588b2b8ffe376a4a4444d (HEAD, refs/remotes/origin/master) Merge: 89ccf78db2 cfb1e21844 Author: Stefan Kangas Date: Sat Oct 8 06:30:23 2022 +0200 Merge from origin/emacs-28 cfb1e21844 Update name of hs-mouse-toggle-hiding in Emacs manual commit 89ccf78db2f3515611b163aae5756199fbcbdf52 Author: Stefan Kangas Date: Fri Oct 7 23:14:52 2022 +0200 ; Silence byte-compiler in benchmark.el * lisp/emacs-lisp/benchmark.el (cl-lib): Require. diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el index 47bc3a4524..4bf61abe54 100644 --- a/lisp/emacs-lisp/benchmark.el +++ b/lisp/emacs-lisp/benchmark.el @@ -31,6 +31,7 @@ ;;; Code: +(require 'cl-lib) (eval-when-compile (require 'subr-x)) ;For `named-let'. (defmacro benchmark-elapse (&rest forms) commit 5b28c3784f2b5f14a3c2a0b4d2d0045be26193ba Author: Stefan Kangas Date: Fri Oct 7 22:43:51 2022 +0200 Prefer defvar-keymap in bibtex.el * lisp/textmodes/bibtex.el (bibtex-mode-map): Prefer defvar-keymap. diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 8135d40d26..f4b557f443 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1,7 +1,6 @@ ;;; bibtex.el --- BibTeX mode for GNU Emacs -*- lexical-binding: t -*- -;; Copyright (C) 1992, 1994-1999, 2001-2022 Free Software Foundation, -;; Inc. +;; Copyright (C) 1992-2022 Free Software Foundation, Inc. ;; Author: Stefan Schoef ;; Bengt Martensson @@ -29,14 +28,13 @@ ;;; Commentary: -;; Major mode for editing and validating BibTeX files. +;; Major mode for editing and validating BibTeX files. -;; Usage: -;; See documentation for `bibtex-mode' or type "M-x describe-mode" -;; when you are in BibTeX mode. +;; See documentation for `bibtex-mode' or type `M-x describe-mode' +;; when you are in BibTeX mode. -;; Todo: -;; Distribute texinfo file. +;; Todo: +;; Distribute texinfo file. ;;; Code: @@ -1548,65 +1546,65 @@ Set this variable before loading BibTeX mode." st) "Syntax table used in BibTeX mode buffers.") -(defvar bibtex-mode-map - (let ((km (make-sparse-keymap))) - ;; The Key `C-c&' is reserved for reftex.el - (define-key km "\t" 'bibtex-find-text) - (define-key km "\n" 'bibtex-next-field) - (define-key km [remap forward-paragraph] 'bibtex-next-entry) - (define-key km [remap backward-paragraph] 'bibtex-previous-entry) - (define-key km "\M-\t" 'completion-at-point) - (define-key km "\C-c\"" 'bibtex-remove-delimiters) - (define-key km "\C-c{" 'bibtex-remove-delimiters) - (define-key km "\C-c}" 'bibtex-remove-delimiters) - (define-key km "\C-c\C-c" 'bibtex-clean-entry) - (define-key km "\C-c\C-q" 'bibtex-fill-entry) - (define-key km "\C-c\C-s" 'bibtex-search-entry) - (define-key km "\C-c\C-x" 'bibtex-search-crossref) - (define-key km "\C-c\C-t" 'bibtex-copy-summary-as-kill) - (define-key km "\C-c?" 'bibtex-print-help-message) - (define-key km "\C-c\C-p" 'bibtex-pop-previous) - (define-key km "\C-c\C-n" 'bibtex-pop-next) - (define-key km "\C-c\C-k" 'bibtex-kill-field) - (define-key km "\C-c\M-k" 'bibtex-copy-field-as-kill) - (define-key km "\C-c\C-w" 'bibtex-kill-entry) - (define-key km "\C-c\M-w" 'bibtex-copy-entry-as-kill) - (define-key km "\C-c\C-y" 'bibtex-yank) - (define-key km "\C-c\M-y" 'bibtex-yank-pop) - (define-key km "\C-c\C-d" 'bibtex-empty-field) - (define-key km "\C-c\C-f" 'bibtex-make-field) - (define-key km "\C-c\C-u" 'bibtex-entry-update) - (define-key km "\C-c$" 'bibtex-ispell-abstract) - (define-key km "\M-\C-a" 'bibtex-beginning-of-entry) - (define-key km "\M-\C-e" 'bibtex-end-of-entry) - (define-key km "\C-\M-l" 'bibtex-reposition-window) - (define-key km "\C-\M-h" 'bibtex-mark-entry) - (define-key km "\C-c\C-b" 'bibtex-entry) - (define-key km "\C-c\C-rn" 'bibtex-narrow-to-entry) - (define-key km "\C-c\C-rw" 'widen) - (define-key km "\C-c\C-l" 'bibtex-url) - (define-key km "\C-c\C-a" 'bibtex-search-entries) - (define-key km "\C-c\C-o" 'bibtex-remove-OPT-or-ALT) - (define-key km "\C-c\C-e\C-i" 'bibtex-InProceedings) - (define-key km "\C-c\C-ei" 'bibtex-InCollection) - (define-key km "\C-c\C-eI" 'bibtex-InBook) - (define-key km "\C-c\C-e\C-a" 'bibtex-Article) - (define-key km "\C-c\C-e\C-b" 'bibtex-InBook) - (define-key km "\C-c\C-eb" 'bibtex-Book) - (define-key km "\C-c\C-eB" 'bibtex-Booklet) - (define-key km "\C-c\C-e\C-c" 'bibtex-InCollection) - (define-key km "\C-c\C-e\C-m" 'bibtex-Manual) - (define-key km "\C-c\C-em" 'bibtex-MastersThesis) - (define-key km "\C-c\C-eM" 'bibtex-Misc) - (define-key km "\C-c\C-e\C-p" 'bibtex-InProceedings) - (define-key km "\C-c\C-ep" 'bibtex-Proceedings) - (define-key km "\C-c\C-eP" 'bibtex-PhdThesis) - (define-key km "\C-c\C-e\M-p" 'bibtex-Preamble) - (define-key km "\C-c\C-e\C-s" 'bibtex-String) - (define-key km "\C-c\C-e\C-t" 'bibtex-TechReport) - (define-key km "\C-c\C-e\C-u" 'bibtex-Unpublished) - km) - "Keymap used in BibTeX mode.") +(defvar-keymap bibtex-mode-map + :doc "Keymap used in BibTeX mode." + ;; The Key `C-c &' is reserved for reftex.el + "TAB" #'bibtex-find-text + "C-j" #'bibtex-next-field + "M-TAB" #'completion-at-point + "C-c \"" #'bibtex-remove-delimiters + "C-c {" #'bibtex-remove-delimiters + "C-c }" #'bibtex-remove-delimiters + "C-c C-c" #'bibtex-clean-entry + "C-c C-q" #'bibtex-fill-entry + "C-c C-s" #'bibtex-search-entry + "C-c C-x" #'bibtex-search-crossref + "C-c C-t" #'bibtex-copy-summary-as-kill + "C-c ?" #'bibtex-print-help-message + "C-c C-p" #'bibtex-pop-previous + "C-c C-n" #'bibtex-pop-next + "C-c C-k" #'bibtex-kill-field + "C-c M-k" #'bibtex-copy-field-as-kill + "C-c C-w" #'bibtex-kill-entry + "C-c M-w" #'bibtex-copy-entry-as-kill + "C-c C-y" #'bibtex-yank + "C-c M-y" #'bibtex-yank-pop + "C-c C-d" #'bibtex-empty-field + "C-c C-f" #'bibtex-make-field + "C-c C-u" #'bibtex-entry-update + "C-c $" #'bibtex-ispell-abstract + "C-M-a" #'bibtex-beginning-of-entry + "C-M-e" #'bibtex-end-of-entry + "C-M-l" #'bibtex-reposition-window + "C-M-h" #'bibtex-mark-entry + "C-c C-b" #'bibtex-entry + "C-c C-r n" #'bibtex-narrow-to-entry + "C-c C-r w" #'widen + "C-c C-l" #'bibtex-url + "C-c C-a" #'bibtex-search-entries + "C-c C-o" #'bibtex-remove-OPT-or-ALT + ;; Most below functions seem to be undefined, which makes the + ;; byte-compiler warn if we quote them with #'. + "C-c C-e TAB" 'bibtex-InProceedings + "C-c C-e i" 'bibtex-InCollection + "C-c C-e I" 'bibtex-InBook + "C-c C-e C-a" 'bibtex-Article + "C-c C-e C-b" 'bibtex-InBook + "C-c C-e b" 'bibtex-Book + "C-c C-e B" 'bibtex-Booklet + "C-c C-e C-c" 'bibtex-InCollection + "C-c C-e RET" 'bibtex-Manual + "C-c C-e m" 'bibtex-MastersThesis + "C-c C-e M" 'bibtex-Misc + "C-c C-e C-p" 'bibtex-InProceedings + "C-c C-e p" 'bibtex-Proceedings + "C-c C-e P" 'bibtex-PhdThesis + "C-c C-e M-p" #'bibtex-Preamble + "C-c C-e C-s" #'bibtex-String + "C-c C-e C-t" 'bibtex-TechReport + "C-c C-e C-u" 'bibtex-Unpublished + " " #'bibtex-next-entry + " " #'bibtex-previous-entry) (easy-menu-define bibtex-edit-menu bibtex-mode-map "BibTeX-Edit Menu in BibTeX mode." commit 5e83c0117e822536aea4bd5db8f97ab7e9224ec3 Author: Stefan Kangas Date: Fri Oct 7 22:07:09 2022 +0200 Fix setting the wallpaper with "swaybg" and "wbg" * lisp/image/wallpaper.el (wallpaper-setter): Add 'init-action' and 'detach' fields to structure. (wallpaper--init-action-kill): New helper function. (wallpaper--default-setters): Use above new fields for "swaybg" and "wbg", to start/restart the corresponding processes as needed. (wallpaper-default-set-function): Call 'init-action' function if there is one. If 'detach', use 'call-process' instead of 'start-process'. (Bug#57781) * test/lisp/image/wallpaper-tests.el (wallpaper--find-setter) (wallpaper--find-setter/call-predicate) (wallpaper--find-setter/set-current-setter) (wallpaper-set/runs-command, wallpaper-set/runs-command/detach) (wallpaper-set/calls-init-action) (wallpaper-set/calls-wallpaper-set-function): New tests. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index ab3df437d9..f083477ddf 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -26,7 +26,8 @@ ;; desktop background. ;; ;; On GNU/Linux and other Unix-like systems, it uses an external -;; command to set the desktop background. +;; command to set the desktop background. This should work seamlessly +;; on both X and Wayland. ;; ;; Finding an external command to use is obviously a bit tricky to get ;; right, as there is no lack of platforms, window managers, desktop @@ -94,9 +95,11 @@ the image file to set the wallpaper to.") (args (if (or (listp args-raw) (symbolp args-raw)) args-raw (string-split args-raw))) - (predicate (plist-get rest-plist :predicate)))) + (predicate (plist-get rest-plist :predicate)) + (init-action (plist-get rest-plist :init-action)) + (detach (plist-get rest-plist :detach)))) (:copier wallpaper-setter-copy)) - "Structure containing a command to set the wallpaper. + "Structure containing a method to set the wallpaper. NAME is a description of the setter (e.g. the name of the Desktop Environment). @@ -106,15 +109,41 @@ COMMAND is the executable to run to set the wallpaper. ARGS is the default list of command line arguments for COMMAND. PREDICATE is a function that will be called without any arguments -and returns non-nil if this setter should be used." +and returns non-nil if this setter should be used. + +INIT-ACTION is a function that will be called without any +arguments before trying to set the wallpaper. + +DETACH, if non-nil, means that the wallpaper process should +continue running even after exiting Emacs." name command args - (predicate #'always)) + (predicate #'always) + init-action + detach) ;;;###autoload (put 'wallpaper-setter-create 'lisp-indent-function 1) +(defun wallpaper--init-action-kill (process-name) + "Return kill function for `init-action' of a `wallpaper-setter' structure. +The returned function kills any process named PROCESS-NAME owned +by the current effective user id." + (lambda () + (when-let ((procs + (seq-filter (lambda (p) (let-alist p + (and (= .euid (user-uid)) + (equal .comm process-name)))) + (mapcar (lambda (pid) + (cons (cons 'pid pid) + (process-attributes pid))) + (list-system-processes))))) + (dolist (proc procs) + (let-alist proc + (when (y-or-n-p (format "Kill \"%s\" process with PID %d?" .comm .pid)) + (signal-process .pid 'TERM))))))) + (defmacro wallpaper--default-methods-create (&rest items) "Helper macro for defining `wallpaper--default-setters'." (cons 'list @@ -198,12 +227,16 @@ and returns non-nil if this setter should be used." "swaybg" "-o * -i %f -m fill" :predicate (lambda () (and (getenv "WAYLAND_DISPLAY") - (getenv "SWAYSOCK")))) + (getenv "SWAYSOCK"))) + :init-action (wallpaper--init-action-kill "swaybg") + :detach t) ("wbg" "wbg" "%f" :predicate (lambda () - (getenv "WAYLAND_DISPLAY"))) + (getenv "WAYLAND_DISPLAY")) + :init-action (wallpaper--init-action-kill "wbg") + :detach t) ;; X general. ("GraphicsMagick" @@ -257,7 +290,8 @@ order in which they appear.") (defun wallpaper--find-setter () (when (wallpaper--use-default-set-function-p) - (or wallpaper--current-setter + (or (and (wallpaper-setter-p wallpaper--current-setter) + wallpaper--current-setter) (setq wallpaper--current-setter (catch 'found (dolist (setter wallpaper--default-setters) @@ -486,28 +520,36 @@ This is the default function for `wallpaper-set-function'." (real-args (mapcar (lambda (arg) (wallpaper--format-arg arg file)) args)) (bufname (format " *wallpaper-%s*" (random))) - (process - (and wallpaper-command - (apply #'start-process "set-wallpaper" bufname - wallpaper-command real-args)))) - (unless wallpaper-command - (error "Couldn't find a suitable command for setting the wallpaper")) + (setter (and (wallpaper-setter-p wallpaper--current-setter) + (equal (wallpaper-setter-command wallpaper--current-setter) + wallpaper-command) + wallpaper--current-setter)) + (init-action (and setter (wallpaper-setter-init-action setter))) + (detach (and setter (wallpaper-setter-detach setter))) + process) + (when init-action + (funcall init-action)) (wallpaper-debug "Using command: \"%s %s\"" - wallpaper-command (string-join real-args " ")) - (setf (process-sentinel process) - (lambda (process status) - (unwind-protect - (if (and (eq (process-status process) 'exit) - (zerop (process-exit-status process))) - (message "Desktop wallpaper changed to %s" - (abbreviate-file-name file)) - (message "command \"%s %s\": %S" - (string-join (process-command process) " ") - (string-replace "\n" "" status) - (with-current-buffer (process-buffer process) - (string-clean-whitespace (buffer-string))))) - (ignore-errors - (kill-buffer (process-buffer process)))))) + wallpaper-command (string-join real-args " ")) + (if detach + (apply #'call-process wallpaper-command nil 0 nil real-args) + (setq process + (apply #'start-process "set-wallpaper" bufname + wallpaper-command real-args)) + (setf (process-sentinel process) + (lambda (process status) + (unwind-protect + (if (and (eq (process-status process) 'exit) + (zerop (process-exit-status process))) + (message "Desktop wallpaper changed to %s" + (abbreviate-file-name file)) + (message "command \"%s %s\": %S" + (string-join (process-command process) " ") + (string-replace "\n" "" status) + (with-current-buffer (process-buffer process) + (string-clean-whitespace (buffer-string))))) + (ignore-errors + (kill-buffer (process-buffer process))))))) process)) ;;;###autoload diff --git a/test/lisp/image/wallpaper-tests.el b/test/lisp/image/wallpaper-tests.el index 52011fe797..cb6818f8c1 100644 --- a/test/lisp/image/wallpaper-tests.el +++ b/test/lisp/image/wallpaper-tests.el @@ -23,6 +23,101 @@ (require 'ert-x) (require 'wallpaper) +(ert-deftest wallpaper--find-setter () + (skip-unless (executable-find "touch")) + (let (wallpaper--current-setter + (wallpaper--default-setters + (wallpaper--default-methods-create + ("touch" "touch" "/tmp/touched")))) + (should (wallpaper--find-setter)))) + +(ert-deftest wallpaper--find-setter/call-predicate () + (skip-unless (executable-find "touch")) + (let* ( wallpaper--current-setter called + (wallpaper--default-setters + (wallpaper--default-methods-create + ("touch" "touch" "/tmp/touched" + :predicate (lambda () (setq called t)))))) + (should-not called) + (wallpaper--find-setter) + (should called))) + +(ert-deftest wallpaper--find-setter/set-current-setter () + (skip-unless (executable-find "touch")) + (let (wallpaper--current-setter + (wallpaper--default-setters + (wallpaper--default-methods-create + ("touch" "touch" "/tmp/touched")))) + (wallpaper--find-setter) + (should wallpaper--current-setter))) + +(ert-deftest wallpaper-set/runs-command () + (skip-unless (executable-find "touch")) + (ert-with-temp-file fil-jpg + :suffix ".jpg" + (ert-with-temp-file fil + (let* ( wallpaper--current-setter + (wallpaper--default-setters + (wallpaper--default-methods-create + ("touch" "touch" fil))) + (wallpaper-command (wallpaper--find-command)) + (wallpaper-command-args (wallpaper--find-command-args))) + (delete-file fil) + (let ((process (wallpaper-set fil-jpg))) + (while (process-live-p process) + (sit-for 0.001)) + ;; Touch has recreated the file: + (should (file-exists-p fil))))))) + +(ert-deftest wallpaper-set/runs-command/detach () + (skip-unless (executable-find "touch")) + (ert-with-temp-file fil-jpg + :suffix ".jpg" + (ert-with-temp-file fil + (let* ( wallpaper--current-setter + (wallpaper--default-setters + (wallpaper--default-methods-create + ("touch" "touch" fil + :detach t))) + (wallpaper-command (wallpaper--find-command)) + (wallpaper-command-args (wallpaper--find-command-args))) + (delete-file fil) + (wallpaper-set fil-jpg) + (while (not (file-exists-p fil)) + (sit-for 0.001)) + ;; Touch has recreated the file: + (should (file-exists-p fil)))))) + +(ert-deftest wallpaper-set/calls-init-action () + (skip-unless (executable-find "touch")) + (ert-with-temp-file fil-jpg + :suffix ".jpg" + (ert-with-temp-file fil + (let* ( wallpaper--current-setter called + (wallpaper--default-setters + (wallpaper--default-methods-create + ("touch" "touch" fil + :init-action (lambda () (setq called t))))) + (wallpaper-command (wallpaper--find-command)) + (wallpaper-command-args (wallpaper--find-command-args))) + (should (functionp (wallpaper-setter-init-action wallpaper--current-setter))) + (wallpaper-set fil-jpg) + (should called))))) + +(ert-deftest wallpaper-set/calls-wallpaper-set-function () + (skip-unless (executable-find "touch")) + (ert-with-temp-file fil-jpg + :suffix ".jpg" + (let* ( wallpaper--current-setter called + (wallpaper--default-setters + (wallpaper--default-methods-create + ("touch" "touch" "foo"))) + (wallpaper-set-function + (lambda (file) (setq called file)))) + (wallpaper--find-setter) + (wallpaper-set fil-jpg) + (should (equal called fil-jpg))))) + (ert-deftest wallpaper--find-command/return-string () (should (or (not (wallpaper--find-command)) (stringp (wallpaper--find-command))))) commit d6831d1b0a18882d688a842721dd1592884a06e2 Author: Stefan Monnier Date: Fri Oct 7 14:15:40 2022 -0400 subr.el (inhibit-point-motion-hooks): Mark it as obsolete When Emacs-25 changed the default of `inhibit-point-motion-hooks` to t, /etc/NEWS declared it as obsolete and so did its docstring, but it was not marked as obsolete so as not to emit too many warnings in code where it was impractical to remove the let-binding while keeping backward compatibility with older Emacsen. Those backward compatibility issues are not serious any more now that Emacs-25 is itself considered old. * lisp/subr.el (inhibit-point-motion-hooks): Mark it as obsolete. * src/textprop.c (inhibit-point-motion-hooks): Don't mention it being obsolete in the docstring any more. * lisp/simple.el (line-move-1, line-move-finish): Silence warnings. diff --git a/lisp/simple.el b/lisp/simple.el index 49ce95dfcf..d2dcbe27a0 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -7837,6 +7837,7 @@ If NOERROR, don't signal an error if we can't move that many lines." (defun line-move-1 (arg &optional noerror _to-end) ;; Don't run any point-motion hooks, and disregard intangibility, ;; for intermediate positions. + (with-suppressed-warnings ((obsolete inhibit-point-motion-hooks)) (let ((outer-ipmh inhibit-point-motion-hooks) (inhibit-point-motion-hooks t) (opoint (point)) @@ -7961,7 +7962,7 @@ If NOERROR, don't signal an error if we can't move that many lines." (goto-char npoint))) (t (line-move-finish (or goal-column temporary-goal-column) - opoint (> orig-arg 0) (not outer-ipmh))))))) + opoint (> orig-arg 0) (not outer-ipmh)))))))) (defun line-move-finish (column opoint forward &optional not-ipmh) (let ((repeat t)) @@ -8014,42 +8015,44 @@ If NOERROR, don't signal an error if we can't move that many lines." ;; unnecessarily. Note that we move *forward* past intangible ;; text when the initial and final points are the same. (goto-char new) - (let ((inhibit-point-motion-hooks (not not-ipmh))) - (goto-char new) - - ;; If intangibility moves us to a different (later) place - ;; in the same line, use that as the destination. - (if (<= (point) line-end) - (setq new (point)) - ;; If that position is "too late", - ;; try the previous allowable position. - ;; See if it is ok. - (backward-char) - (if (if forward - ;; If going forward, don't accept the previous - ;; allowable position if it is before the target line. - (< line-beg (point)) - ;; If going backward, don't accept the previous - ;; allowable position if it is still after the target line. - (<= (point) line-end)) - (setq new (point)) - ;; As a last resort, use the end of the line. - (setq new line-end)))) + (with-suppressed-warnings ((obsolete inhibit-point-motion-hooks)) + (let ((inhibit-point-motion-hooks (not not-ipmh))) + (goto-char new) + + ;; If intangibility moves us to a different (later) place + ;; in the same line, use that as the destination. + (if (<= (point) line-end) + (setq new (point)) + ;; If that position is "too late", + ;; try the previous allowable position. + ;; See if it is ok. + (backward-char) + (if (if forward + ;; If going forward, don't accept the previous + ;; allowable position if it is before the target line. + (< line-beg (point)) + ;; If going backward, don't accept the previous + ;; allowable position if it is still after the target line. + (<= (point) line-end)) + (setq new (point)) + ;; As a last resort, use the end of the line. + (setq new line-end))))) ;; Now move to the updated destination, processing fields ;; as well as intangibility. (goto-char opoint) - (let ((inhibit-point-motion-hooks (not not-ipmh))) - (goto-char - ;; Ignore field boundaries if the initial and final - ;; positions have the same `field' property, even if the - ;; fields are non-contiguous. This seems to be "nicer" - ;; behavior in many situations. - (if (eq (get-char-property new 'field) - (get-char-property opoint 'field)) - new - (constrain-to-field new opoint t t - 'inhibit-line-move-field-capture)))) + (with-suppressed-warnings ((obsolete inhibit-point-motion-hooks)) + (let ((inhibit-point-motion-hooks (not not-ipmh))) + (goto-char + ;; Ignore field boundaries if the initial and final + ;; positions have the same `field' property, even if the + ;; fields are non-contiguous. This seems to be "nicer" + ;; behavior in many situations. + (if (eq (get-char-property new 'field) + (get-char-property opoint 'field)) + new + (constrain-to-field new opoint t t + 'inhibit-line-move-field-capture))))) ;; If all this moved us to a different line, ;; retry everything within that new line. diff --git a/lisp/subr.el b/lisp/subr.el index c975c216bb..56ce9fa69b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1837,7 +1837,12 @@ be a list of the form returned by `event-start' and `event-end'." (set-advertised-calling-convention 'time-convert '(time form) "29.1") ;;;; Obsolescence declarations for variables, and aliases. - +(make-obsolete-variable + 'inhibit-point-motion-hooks + "use `cursor-intangible-mode' or `cursor-sensor-mode' instead" + ;; It's been announced as obsolete in NEWS and in the docstring since Emacs-25, + ;; but it's only been marked for compilation warnings since Emacs-29. + "25.1") (make-obsolete-variable 'redisplay-dont-pause nil "24.5") (make-obsolete-variable 'operating-system-release nil "28.1") (make-obsolete-variable 'inhibit-changing-match-data 'save-match-data "29.1") diff --git a/src/textprop.c b/src/textprop.c index c91a2b729c..c22b579af2 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -2389,15 +2389,7 @@ returned. */); DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks, doc: /* If non-nil, don't run `point-left' and `point-entered' text properties. -This also inhibits the use of the `intangible' text property. - -This variable is obsolete since Emacs-25.1. Use `cursor-intangible-mode' -or `cursor-sensor-mode' instead. */); - /* FIXME: We should make-obsolete-variable, but that signals too many - warnings in code which does (let ((inhibit-point-motion-hooks t)) ...) - Ideally, make-obsolete-variable should let us specify that only the nil - value is obsolete, but that requires too many changes in bytecomp.el, - so for now we'll keep it "obsolete via the docstring". */ +This also inhibits the use of the `intangible' text property. */); Vinhibit_point_motion_hooks = Qt; DEFVAR_LISP ("text-property-default-nonsticky", commit e3824f0a3189d0902d64a70ae9c82ff1240aed5f Author: Stefan Monnier Date: Fri Oct 7 14:07:17 2022 -0400 * lisp/isearch.el (isearch-search): Don't bind `inhibit-point-motion-hooks` The let-binding was added back in 1997 (commit 79c7a4fa5f974a9d3b) "because we might have to search inside invisible and intangible text". So it's been redundant since Emacs-25 changed the default to t. diff --git a/lisp/isearch.el b/lisp/isearch.el index 3e840b014f..bc3697deb0 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -3649,8 +3649,7 @@ Optional third argument, if t, means if fail just return nil (no error). (setq isearch-case-fold-search (isearch-no-upper-case-p isearch-string isearch-regexp))) (condition-case lossage - (let ((inhibit-point-motion-hooks isearch-invisible) - (inhibit-quit nil) + (let ((inhibit-quit nil) (case-fold-search isearch-case-fold-search) (search-invisible isearch-invisible) (retry t)) commit c61010567f418e38dad2fcdc4e102c0561ce23c3 Author: Stefan Monnier Date: Fri Oct 7 13:54:36 2022 -0400 verilog-mode.el: Don't bind `inhibit-point-motion-hooks` Keep binding it in Emacs<25 but not in Emacs≥25 (where such bindings are redundant and the var is declared obsolete). * lisp/progmodes/verilog-mode.el (verilog-save-buffer-state): Don't bind `inhibit-point-motion-hooks` if Emacs≥25. (verilog-save-font-no-change-functions): Same, and refrain from binding `before/after-change-functions` as well while we're at it, since `inhibit-modification-hooks` already covers it in Emacs≥25. diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index fa799a0fb3..d6b8edaa36 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -3409,7 +3409,8 @@ A change is considered significant if it affects the buffer text in any way that isn't completely restored again. Any user-visible changes to the buffer must not be within a `verilog-save-buffer-state'." - `(let ((inhibit-point-motion-hooks t) + `(let (,@(unless (>= emacs-major-version 25) + '((inhibit-point-motion-hooks t))) (verilog-no-change-functions t)) ,(if (fboundp 'with-silent-modifications) `(with-silent-modifications ,@body) @@ -3455,11 +3456,13 @@ For insignificant changes, see instead `verilog-save-buffer-state'." (run-hook-with-args 'before-change-functions (point-min) (point-max)) (unwind-protect ;; Must inhibit and restore hooks before restoring font-lock - (let* ((inhibit-point-motion-hooks t) + (let* (,@(unless (>= emacs-major-version 25) + '((inhibit-point-motion-hooks t) ;Obsolete since 25.1 + ;; XEmacs and pre-Emacs 21 ignore + ;; `inhibit-modification-hooks'. + before-change-functions after-change-functions)) (inhibit-modification-hooks t) - (verilog-no-change-functions t) - ;; XEmacs and pre-Emacs 21 ignore inhibit-modification-hooks. - before-change-functions after-change-functions) + (verilog-no-change-functions t)) (progn ,@body)) ;; Unwind forms (run-hook-with-args 'after-change-functions (point-min) (point-max) commit 3c7f05133c80ccb48b5adeeed28a36a4039bfe45 Author: Stefan Monnier Date: Fri Oct 7 13:25:36 2022 -0400 (nxml-with-invisible-motion): Delete macro. Don't use this macro any more since it doesn't do anything since Emacs-25 changed the default of `inhibit-point-motion-hooks` to t. * lisp/nxml/nxml-util.el (nxml-with-invisible-motion): Delete macro. * lisp/nxml/nxml-mode.el (nxml-mode, nxml-cleanup): * lisp/nxml/rng-valid.el (rng-do-some-validation): * lisp/nxml/rng-nxml.el (rng-set-state-after): Don't use it. diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index dfe5c369e2..9cbab29504 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -536,8 +536,7 @@ Many aspects this mode can be customized using (save-restriction (widen) (with-silent-modifications - (nxml-with-invisible-motion - (nxml-scan-prolog))))) + (nxml-scan-prolog)))) (setq-local syntax-ppss-table sgml-tag-syntax-table) (setq-local syntax-propertize-function #'nxml-syntax-propertize) (add-function :filter-return (local 'filter-buffer-substring-function) @@ -584,8 +583,7 @@ Many aspects this mode can be customized using (save-excursion (widen) (with-silent-modifications - (nxml-with-invisible-motion - (remove-text-properties (point-min) (point-max) '(face nil))))) + (remove-text-properties (point-min) (point-max) '(face nil)))) (remove-hook 'change-major-mode-hook #'nxml-cleanup t)) (defun nxml-degrade (context err) diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el index 662d43842e..241c54488f 100644 --- a/lisp/nxml/nxml-util.el +++ b/lisp/nxml/nxml-util.el @@ -65,12 +65,6 @@ This is the inverse of `nxml-make-namespace'." (nxml-degrade ,context ,error-symbol)))) `(progn ,@body))) -(defmacro nxml-with-invisible-motion (&rest body) - "Evaluate body without calling any point motion hooks." - (declare (indent 0) (debug t)) - `(let ((inhibit-point-motion-hooks t)) - ,@body)) - (defun nxml-display-file-parse-error (err) (let* ((filename (nth 1 err)) (buffer (find-file-noselect filename)) diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el index ccbf4d8de2..b1beb19503 100644 --- a/lisp/nxml/rng-nxml.el +++ b/lisp/nxml/rng-nxml.el @@ -366,45 +366,44 @@ set `xmltok-dtd'. Returns the position of the end of the token." (save-excursion (save-restriction (widen) - (nxml-with-invisible-motion - (if (= pos (point-min)) - (rng-set-initial-state) - (let ((state (get-text-property (1- pos) 'rng-state))) - (cond (state - (rng-restore-state state) - (goto-char pos)) - (t - (let ((start (previous-single-property-change pos - 'rng-state))) - (cond (start - (rng-restore-state (get-text-property (1- start) - 'rng-state)) - (goto-char start)) - (t (rng-set-initial-state)))))))) - (xmltok-save - (if (= (point) 1) - (xmltok-forward-prolog) - (setq xmltok-dtd rng-dtd)) - (cond ((and (< pos (point)) - ;; This handles the case where the prolog ends - ;; with a < without any following name-start - ;; character. This will be treated by the parser - ;; as part of the prolog, but we want to treat - ;; it as the start of the instance. - (eq (char-after pos) ?<) - (<= (point) - (save-excursion - (goto-char (1+ pos)) - (skip-chars-forward " \t\r\n") - (point)))) - pos) - ((< (point) pos) - (let ((rng-dt-namespace-context-getter - '(nxml-ns-get-context)) - (rng-parsing-for-state t)) - (rng-forward pos)) - (point)) - (t pos))))))) + (if (= pos (point-min)) + (rng-set-initial-state) + (let ((state (get-text-property (1- pos) 'rng-state))) + (cond (state + (rng-restore-state state) + (goto-char pos)) + (t + (let ((start (previous-single-property-change pos + 'rng-state))) + (cond (start + (rng-restore-state (get-text-property (1- start) + 'rng-state)) + (goto-char start)) + (t (rng-set-initial-state)))))))) + (xmltok-save + (if (= (point) 1) + (xmltok-forward-prolog) + (setq xmltok-dtd rng-dtd)) + (cond ((and (< pos (point)) + ;; This handles the case where the prolog ends + ;; with a < without any following name-start + ;; character. This will be treated by the parser + ;; as part of the prolog, but we want to treat + ;; it as the start of the instance. + (eq (char-after pos) ?<) + (<= (point) + (save-excursion + (goto-char (1+ pos)) + (skip-chars-forward " \t\r\n") + (point)))) + pos) + ((< (point) pos) + (let ((rng-dt-namespace-context-getter + '(nxml-ns-get-context)) + (rng-parsing-for-state t)) + (rng-forward pos)) + (point)) + (t pos)))))) (defun rng-adjust-state-for-attribute (lt-pos start) (xmltok-save diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index ad5c9c7a15..d82c8470d7 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el @@ -441,25 +441,24 @@ The schema is set like `rng-auto-set-schema'." (save-excursion (save-restriction (widen) - (nxml-with-invisible-motion - (condition-case-unless-debug err - (and (rng-validate-prepare) - (let ((rng-dt-namespace-context-getter '(nxml-ns-get-context))) - (with-silent-modifications - (rng-do-some-validation-1 continue-p-function)))) - ;; errors signaled from a function run by an idle timer - ;; are ignored; if we don't catch them, validation - ;; will get mysteriously stuck at a single place - (rng-compile-error - (message "Incorrect schema. %s" (nth 1 err)) - (rng-validate-mode 0) - nil) - (error - (message "Internal error in rng-validate-mode triggered at buffer position %d. %s" - (point) - (error-message-string err)) - (rng-validate-mode 0) - nil)))))) + (condition-case-unless-debug err + (and (rng-validate-prepare) + (let ((rng-dt-namespace-context-getter '(nxml-ns-get-context))) + (with-silent-modifications + (rng-do-some-validation-1 continue-p-function)))) + ;; errors signaled from a function run by an idle timer + ;; are ignored; if we don't catch them, validation + ;; will get mysteriously stuck at a single place + (rng-compile-error + (message "Incorrect schema. %s" (nth 1 err)) + (rng-validate-mode 0) + nil) + (error + (message "Internal error in rng-validate-mode triggered at buffer position %d. %s" + (point) + (error-message-string err)) + (rng-validate-mode 0) + nil))))) (defun rng-validate-prepare () "Prepare to do some validation, initializing point and the state. commit 42fd433acabc97cec035748be0508234bda39750 Author: Stefan Monnier Date: Fri Oct 7 12:54:29 2022 -0400 * lisp/pcomplete.el (pcomplete-arg): Simplify diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 6fe29d9dcf..8cb0aa3b7a 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -646,15 +646,12 @@ parts of the list. The OFFSET argument is added to/taken away from the index that will be used. This is really only useful with `first' and `last', for accessing absolute argument positions." - (setq index - (if (eq index 'first) - 0 - (if (eq index 'last) - pcomplete-last - (- pcomplete-index (or index 0))))) - (if offset - (setq index (+ index offset))) - (nth index pcomplete-args)) + (nth (+ (pcase index + ('first 0) + ('last pcomplete-last) + (_ (- pcomplete-index (or index 0)))) + (or offset 0)) + pcomplete-args)) (defun pcomplete-begin (&optional index offset) "Return the beginning position of the INDEXth argument. commit 3bf53ad05c60794bc4586d2c7afd8bfa11ba99c7 Author: Stefan Monnier Date: Fri Oct 7 12:51:14 2022 -0400 (line-move-1): Obey `inhibit-point-motion-hooks` `line-move-1` was written back before `inhibit-point-motion-hooks` was made obsolete and it's written under the assumption that its value is nil, whereas since Emacs-25 it's t. To work around problems linked to a nil value of `inhibit-point-motion-hooks`, the code temporarily binds that var to t while it moves around trying to find the final destination and then later in a few key spots it binds it "back" to nil so as to run the point-motion hooks according to the final destination, as if the overall motion had been made "normally". Change the code so that the "bind back" indeed binds the var back to the value it had originally, rather than always to nil. * lisp/simple.el (line-move-1): Obey `inhibit-point-motion-hooks` (line-move-finish): New optional arg `not-ipmh`. diff --git a/lisp/simple.el b/lisp/simple.el index 7556b5adcf..49ce95dfcf 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -7837,7 +7837,8 @@ If NOERROR, don't signal an error if we can't move that many lines." (defun line-move-1 (arg &optional noerror _to-end) ;; Don't run any point-motion hooks, and disregard intangibility, ;; for intermediate positions. - (let ((inhibit-point-motion-hooks t) + (let ((outer-ipmh inhibit-point-motion-hooks) + (inhibit-point-motion-hooks t) (opoint (point)) (orig-arg arg)) (if (consp temporary-goal-column) @@ -7949,20 +7950,20 @@ If NOERROR, don't signal an error if we can't move that many lines." ;; point-left-hooks. (let* ((npoint (prog1 (line-end-position) (goto-char opoint))) - (inhibit-point-motion-hooks nil)) + (inhibit-point-motion-hooks outer-ipmh)) (goto-char npoint))) ((< arg 0) ;; If we did not move up as far as desired, ;; at least go to beginning of line. (let* ((npoint (prog1 (line-beginning-position) (goto-char opoint))) - (inhibit-point-motion-hooks nil)) + (inhibit-point-motion-hooks outer-ipmh)) (goto-char npoint))) (t (line-move-finish (or goal-column temporary-goal-column) - opoint (> orig-arg 0))))))) + opoint (> orig-arg 0) (not outer-ipmh))))))) -(defun line-move-finish (column opoint forward) +(defun line-move-finish (column opoint forward &optional not-ipmh) (let ((repeat t)) (while repeat ;; Set REPEAT to t to repeat the whole thing. @@ -8013,7 +8014,7 @@ If NOERROR, don't signal an error if we can't move that many lines." ;; unnecessarily. Note that we move *forward* past intangible ;; text when the initial and final points are the same. (goto-char new) - (let ((inhibit-point-motion-hooks nil)) + (let ((inhibit-point-motion-hooks (not not-ipmh))) (goto-char new) ;; If intangibility moves us to a different (later) place @@ -8038,7 +8039,7 @@ If NOERROR, don't signal an error if we can't move that many lines." ;; Now move to the updated destination, processing fields ;; as well as intangibility. (goto-char opoint) - (let ((inhibit-point-motion-hooks nil)) + (let ((inhibit-point-motion-hooks (not not-ipmh))) (goto-char ;; Ignore field boundaries if the initial and final ;; positions have the same `field' property, even if the commit f3769bc32a3d32377a83b33d416205f80814e422 Author: Stefan Monnier Date: Fri Oct 7 12:29:56 2022 -0400 org.el: Improve bindings of `inhibit-*` vars Remove binding of `inhibit-point-motion-hooks` (it's t by default anyway and it's obsolete) and don't "manually" bind `inhibit-modification-hooks`. * lisp/org/org.el (org-unfontify-region): Use `with-silent-modifications`. (org-display-inline-remove-overlay): Remove ineffective binding of `inhibit-modification-hooks` around code which doesn't modify the buffer anyway. diff --git a/lisp/org/org.el b/lisp/org/org.el index 6f92cdeab5..7de907590e 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -5929,10 +5929,7 @@ If TAG is a number, get the corresponding match group." (defun org-unfontify-region (beg end &optional _maybe_loudly) "Remove fontification and activation overlays from links." (font-lock-default-unfontify-region beg end) - (let* ((buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark buffer-file-name buffer-file-truename) + (with-silent-modifications (decompose-region beg end) (remove-text-properties beg end '(mouse-face t keymap t org-linked-text t @@ -16702,10 +16699,9 @@ buffer boundaries with possible narrowing." (defun org-display-inline-remove-overlay (ov after _beg _end &optional _len) "Remove inline-display overlay if a corresponding region is modified." - (let ((inhibit-modification-hooks t)) - (when (and ov after) - (delete ov org-inline-image-overlays) - (delete-overlay ov)))) + (when (and ov after) + (delete ov org-inline-image-overlays) + (delete-overlay ov))) (defun org-remove-inline-images () "Remove inline display of images." commit 4840b91e41329cd1221e6224142af9ae13fd7606 Author: Stefan Monnier Date: Fri Oct 7 12:25:09 2022 -0400 Remove aliases of `with-silent-modifications` There were many reinventions of `with-silent-modifications` (tho many of them weren't reinventions but copy&paste of code from font-lock, IIUC). Now that those don't even need to let-bind `inhibit-point-motion-hooks` they're really just obsolete. * lisp/font-lock.el (save-buffer-state): Delete macro. (font-lock-unfontify-region, font-lock-default-fontify-region): Use `with-silent-modifications` instead. (font-lock-after-change-function, font-lock-fontify-block): Don't let-bind `inhibit-point-motion-hooks`. * lisp/htmlfontify.el (hfy-save-buffer-state): Delete macro. (hfy-mark-trailing-whitespace, hfy-unmark-trailing-whitespace): Use `with-silent-modifications` instead. * lisp/jit-lock.el (with-buffer-prepared-for-jit-lock): Delete macro. (jit-lock--debug-fontify, jit-lock-refontify, jit-lock-function) (jit-lock-fontify-now, jit-lock-force-redisplay) (jit-lock-deferred-fontify, jit-lock-context-fontify) (jit-lock-after-change): Use `with-silent-modifications` instead. * lisp/progmodes/antlr-mode.el (save-buffer-state-x): Delete macro. (antlr-hide-actions): Use `with-silent-modifications` instead. * lisp/progmodes/hideshow.el (hs-life-goes-on): Don't let-bind `inhibit-point-motion-hooks`. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index b6f4150964..d132de3a32 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -633,16 +633,6 @@ Major/minor modes can set this variable if they know which option applies.") ;; Font Lock mode. -(eval-when-compile - ;; - ;; We use this to preserve or protect things when modifying text properties. - (defmacro save-buffer-state (&rest body) - "Bind variables according to VARLIST and eval BODY restoring buffer state." - (declare (indent 0) (debug t)) - `(let ((inhibit-point-motion-hooks t)) - (with-silent-modifications - ,@body)))) - (defvar-local font-lock-set-defaults nil) ; Whether we have set up defaults. (defun font-lock-specified-p (mode) @@ -1002,7 +992,7 @@ This works by calling `font-lock-fontify-region-function'." (defun font-lock-unfontify-region (beg end) "Unfontify the text between BEG and END. This works by calling `font-lock-unfontify-region-function'." - (save-buffer-state + (with-silent-modifications (funcall font-lock-unfontify-region-function beg end))) (defvar font-lock-flush-function #'font-lock-after-change-function @@ -1152,7 +1142,7 @@ Put first the functions more likely to cause a change and cheaper to compute.") "Fontify the text between BEG and END. If LOUDLY is non-nil, print status messages while fontifying. This function is the default `font-lock-fontify-region-function'." - (save-buffer-state + (with-silent-modifications ;; Use the fontification syntax table, if any. (with-syntax-table (or font-lock-syntax-table (syntax-table)) ;; Extend the region to fontify so that it starts and ends at @@ -1211,8 +1201,7 @@ This function is the default `font-lock-unfontify-region-function'." ;; Called when any modification is made to buffer text. (defun font-lock-after-change-function (beg end &optional old-len) (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-quit t) + (let ((inhibit-quit t) (region (if font-lock-extend-after-change-region-function (funcall font-lock-extend-after-change-region-function beg end old-len)))) @@ -1307,8 +1296,7 @@ no ARG is given and `font-lock-mark-block-function' is nil. If `font-lock-mark-block-function' non-nil and no ARG is given, it is used to delimit the region to fontify." (interactive "P") - (let ((inhibit-point-motion-hooks t) - deactivate-mark) + (let (deactivate-mark) ;; Make sure we have the right `font-lock-keywords' etc. (if (not font-lock-mode) (font-lock-set-defaults)) (save-mark-and-excursion diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index b1fdbd2c4a..34092b1417 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1539,33 +1539,13 @@ See also `hfy-html-enkludge-buffer'." (if (get-text-property (match-beginning 0) 'hfy-quoteme) (replace-match (hfy-html-quote (match-string 1))) )) )) -;; Borrowed from font-lock.el -(defmacro hfy-save-buffer-state (varlist &rest body) - "Bind variables according to VARLIST and eval BODY restoring buffer state. -Do not record undo information during evaluation of BODY." - (declare (indent 1) (debug let)) - (let ((modified (make-symbol "modified"))) - `(let* ,(append varlist - `((,modified (buffer-modified-p)) - (buffer-undo-list t) - (inhibit-read-only t) - (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark - buffer-file-name - buffer-file-truename)) - (progn - ,@body) - (unless ,modified - (restore-buffer-modified-p nil))))) - (defun hfy-mark-trailing-whitespace () "Tag trailing whitespace with a hfy property if it is currently highlighted." (when show-trailing-whitespace (let ((inhibit-read-only t)) (save-excursion (goto-char (point-min)) - (hfy-save-buffer-state nil + (with-silent-modifications (while (re-search-forward "[ \t]+$" nil t) (put-text-property (match-beginning 0) (match-end 0) 'hfy-show-trailing-whitespace t))))))) @@ -1573,7 +1553,7 @@ Do not record undo information during evaluation of BODY." (defun hfy-unmark-trailing-whitespace () "Undo the effect of `hfy-mark-trailing-whitespace'." (when show-trailing-whitespace - (hfy-save-buffer-state nil + (with-silent-modifications (remove-text-properties (point-min) (point-max) '(hfy-show-trailing-whitespace nil))))) diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index 6ef46ad60b..ed7a3dbba3 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -27,16 +27,6 @@ ;;; Code: - -(eval-when-compile - (defmacro with-buffer-prepared-for-jit-lock (&rest body) - "Execute BODY in current buffer, overriding several variables. -Preserves the `buffer-modified-p' state of the current buffer." - (declare (debug t)) - `(let ((inhibit-point-motion-hooks t)) - (with-silent-modifications - ,@body)))) - ;;; Customization. (defgroup jit-lock nil @@ -328,7 +318,7 @@ like `debug-on-error' and Edebug can be used." (when (buffer-live-p buffer) (with-current-buffer buffer ;; (message "Jit-Debug %s" (buffer-name)) - (with-buffer-prepared-for-jit-lock + (with-silent-modifications (let ((pos (point-min))) (while (progn @@ -365,7 +355,7 @@ Only applies to the current buffer." (defun jit-lock-refontify (&optional beg end) "Force refontification of the region BEG..END (default whole buffer)." - (with-buffer-prepared-for-jit-lock + (with-silent-modifications (save-restriction (widen) (put-text-property (or beg (point-min)) (or end (point-max)) @@ -392,7 +382,7 @@ is active." (push (current-buffer) jit-lock-defer-buffers)) ;; Mark the area as defer-fontified so that the redisplay engine ;; is happy and so that the idle timer can find the places to fontify. - (with-buffer-prepared-for-jit-lock + (with-silent-modifications (put-text-property start (next-single-property-change start 'fontified nil @@ -426,7 +416,7 @@ is active." (defun jit-lock-fontify-now (&optional start end) "Fontify current buffer from START to END. Defaults to the whole buffer. END can be out of bounds." - (with-buffer-prepared-for-jit-lock + (with-silent-modifications (save-excursion (unless start (setq start (point-min))) (setq end (if end (min end (point-max)) (point-max))) @@ -502,7 +492,7 @@ Defaults to the whole buffer. END can be out of bounds." This applies to the buffer associated with marker START." (when (marker-buffer start) (with-current-buffer (marker-buffer start) - (with-buffer-prepared-for-jit-lock + (with-silent-modifications (when (> end (point-max)) (setq end (point-max) start (min start end))) (when (< start (point-min)) @@ -616,7 +606,7 @@ non-nil in a repeated invocation of this function." (when (buffer-live-p buffer) (with-current-buffer buffer ;; (message "Jit-Defer %s" (buffer-name)) - (with-buffer-prepared-for-jit-lock + (with-silent-modifications (let ((pos (point-min))) (while (progn @@ -664,7 +654,7 @@ non-nil in a repeated invocation of this function." jit-lock-context-unfontify-pos 'jit-lock-defer-multiline) (point-min)))) - (with-buffer-prepared-for-jit-lock + (with-silent-modifications ;; Force contextual refontification. (remove-text-properties jit-lock-context-unfontify-pos (point-max) @@ -695,7 +685,7 @@ will take place when text is fontified stealthily." (when (and jit-lock-mode (not memory-full)) (let ((jit-lock-start start) (jit-lock-end end)) - (with-buffer-prepared-for-jit-lock + (with-silent-modifications (run-hook-with-args 'jit-lock-after-change-extend-region-functions start end old-len) ;; Make sure we change at least one char (in case of deletions). diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 5002a3bbfa..733deebdf5 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -83,14 +83,6 @@ (require 'easymenu)) (require 'cc-mode) -;; More compile-time-macros -(eval-when-compile - (defmacro save-buffer-state-x (&rest body) ; similar to EMACS/lazy-lock.el - (declare (debug t) (indent 0)) - `(let ((inhibit-point-motion-hooks t)) - (with-silent-modifications - ,@body)))) - (defvar outline-level) (defvar imenu-use-markers) (defvar imenu-create-index-function) @@ -1320,7 +1312,7 @@ actions if ARG is 0 or negative. See `antlr-action-visibility'. Display a message unless optional argument SILENT is non-nil." (interactive "p") - (save-buffer-state-x + (with-silent-modifications (if (> arg 0) (let ((regexp (if (= arg 1) "[]}]" "}")) (diff (and antlr-action-visibility diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 2a1b6d6b7b..6de079f05a 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1994-2022 Free Software Foundation, Inc. ;; Author: Thien-Thi Nguyen -;; Dan Nicolaescu +;; Dan Nicolaescu ;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines ;; Maintainer-Version: 5.65.2.2 ;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning @@ -256,7 +256,7 @@ This has effect only if `search-invisible' is set to `open'." ;;;###autoload (defvar hs-special-modes-alist - (mapcar 'purecopy + (mapcar #'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) @@ -351,17 +351,17 @@ Use the command `hs-minor-mode' to toggle or set this variable.") (defvar hs-minor-mode-map (let ((map (make-sparse-keymap))) ;; These bindings roughly imitate those used by Outline mode. - (define-key map "\C-c@\C-h" 'hs-hide-block) - (define-key map "\C-c@\C-s" 'hs-show-block) - (define-key map "\C-c@\C-\M-h" 'hs-hide-all) - (define-key map "\C-c@\C-\M-s" 'hs-show-all) - (define-key map "\C-c@\C-l" 'hs-hide-level) - (define-key map "\C-c@\C-c" 'hs-toggle-hiding) - (define-key map "\C-c@\C-a" 'hs-show-all) - (define-key map "\C-c@\C-t" 'hs-hide-all) - (define-key map "\C-c@\C-d" 'hs-hide-block) - (define-key map "\C-c@\C-e" 'hs-toggle-hiding) - (define-key map [(shift mouse-2)] 'hs-toggle-hiding) + (define-key map "\C-c@\C-h" #'hs-hide-block) + (define-key map "\C-c@\C-s" #'hs-show-block) + (define-key map "\C-c@\C-\M-h" #'hs-hide-all) + (define-key map "\C-c@\C-\M-s" #'hs-show-all) + (define-key map "\C-c@\C-l" #'hs-hide-level) + (define-key map "\C-c@\C-c" #'hs-toggle-hiding) + (define-key map "\C-c@\C-a" #'hs-show-all) + (define-key map "\C-c@\C-t" #'hs-hide-all) + (define-key map "\C-c@\C-d" #'hs-hide-block) + (define-key map "\C-c@\C-e" #'hs-toggle-hiding) + (define-key map [(shift mouse-2)] #'hs-toggle-hiding) map) "Keymap for hideshow minor mode.") @@ -778,12 +778,10 @@ region (point MAXP)." (defmacro hs-life-goes-on (&rest body) "Evaluate BODY forms if variable `hs-minor-mode' is non-nil. -In the dynamic context of this macro, `inhibit-point-motion-hooks' -and `case-fold-search' are both t." +In the dynamic context of this macro, `case-fold-search' is t." (declare (debug t)) `(when hs-minor-mode - (let ((inhibit-point-motion-hooks t) - (case-fold-search t)) + (let ((case-fold-search t)) ,@body))) (defun hs-find-block-beginning-match () commit d28581101adb967b32b2d1de93aba34ce69e15d2 Author: Stefan Monnier Date: Fri Oct 7 12:16:47 2022 -0400 Remove redundant let-bindings of `inhibit-point-motion-hooks` `inhibit-point-motion-hooks` has defaulted to t (and been declared obsolete) since Emacs-25, so remove left-over bindings to that now default value. * lisp/dabbrev.el (dabbrev--search): * lisp/format.el (format-insert-file): * lisp/forms.el (forms-next-field, forms-prev-field): * lisp/minibuf-eldef.el (minibuf-eldef-setup-minibuffer): * lisp/simple.el (primitive-undo): * lisp/cedet/semantic/edit.el (semantic-change-function): * lisp/cedet/srecode/fields.el (srecode-field-mod-hook): * lisp/cedet/srecode/insert.el (srecode-insert-fcn): * lisp/erc/erc-button.el (erc-button-add-buttons): * lisp/erc/erc.el (erc-display-line): * lisp/eshell/em-script.el (eshell-source-file): * lisp/eshell/em-smart.el (eshell-smart-scroll-window): * lisp/eshell/esh-arg.el (eshell-parse-arguments): * lisp/eshell/esh-cmd.el (eshell-with-temp-command): * lisp/eshell/esh-mode.el (eshell-send-input, eshell-output-filter): * lisp/gnus/gnus-art.el (gnus-with-article-headers) (article-hide-headers, article-hide-boring-headers) (article-decode-mime-words, article-decode-charset) (article-decode-encoded-words, article-decode-group-name) (article-decode-idna-rhs, article-hide-list-identifiers) (article-strip-banner, article-really-strip-banner) (article-strip-leading-blank-lines) (article-strip-multiple-blank-lines, article-strip-leading-space) (article-strip-trailing-space, article-strip-all-blank-lines) (gnus-article-narrow-to-signature, gnus-article-show-hidden-text) (article-date-ut, article-verify-x-pgp-sig) (gnus-article-only-boring-p, gnus-article-highlight-signature) (gnus-article-add-buttons, gnus-signature-toggle, gnus-button-push): * lisp/gnus/gnus-cite.el (gnus-article-highlight-citation) (gnus-article-fill-cited-article, gnus-article-hide-citation) (gnus-article-toggle-cited-text, gnus-article-hide-citation-maybe) (gnus-cite-parse-wrapper, gnus-cite-add-face, gnus-cite-toggle): * lisp/gnus/gnus-gravatar.el (gnus-gravatar-insert): * lisp/gnus/gnus-rfc1843.el (rfc1843-decode-article-body): * lisp/gnus/gnus-sum.el (gnus-summary-toggle-header): * lisp/gnus/gnus-util.el (gnus-fetch-field): * lisp/gnus/message.el (message-fetch-field, message-reply) (message-followup, message-hide-headers): * lisp/net/goto-addr.el (goto-address-fontify): * lisp/obsolete/linum.el (linum-update-window): * lisp/play/zone.el (zone-shift-left, zone-shift-right) (zone-fill-out-screen): * lisp/progmodes/opascal.el (opascal-save-excursion): * lisp/progmodes/vhdl-mode.el (vhdl-prepare-search-2): * lisp/textmodes/enriched.el (enriched-encode): * lisp/textmodes/flyspell.el (flyspell-word-search-backward) (flyspell-word-search-forward): * lisp/textmodes/table.el (table--point-entered/left-cell-function): Remove let-binding of `inhibit-point-motion-hooks`. diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el index 7cb6768f7e..4efc283520 100644 --- a/lisp/cedet/semantic/edit.el +++ b/lisp/cedet/semantic/edit.el @@ -128,11 +128,9 @@ If nil, errors are still displayed, but informative messages are not." "Provide a mechanism for semantic tag management. Argument START, END, and LENGTH specify the bounds of the change." (setq semantic-unmatched-syntax-cache-check t) - (let ((inhibit-point-motion-hooks t) - ) - (save-match-data - (run-hook-with-args 'semantic-change-functions start end length) - ))) + (save-match-data + (run-hook-with-args 'semantic-change-functions start end length) + )) (defun semantic-changes-in-region (start end &optional buffer) "Find change overlays which exist in whole or in part between START and END. diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el index 2fc79d01a7..67ee82c73e 100644 --- a/lisp/cedet/srecode/fields.el +++ b/lisp/cedet/srecode/fields.el @@ -334,9 +334,7 @@ START and END are the bounds of the change. PRE-LEN is used in the after mode for the length of the changed text." (when (and after (not undo-in-progress)) (let* ((field (overlay-get ol 'srecode)) - (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - ) + (inhibit-modification-hooks t)) ;; Sometimes a field is deleted, but we might still get a stray ;; event. Let's just ignore those events. (when (slot-boundp field 'overlay) diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index db17b7f23f..f8cfe2a733 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -125,9 +125,7 @@ has set everything up already." ;; I tried `combine-after-change-calls', but it did not have ;; the effect I wanted. (let ((start (point))) - (let ((inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - ) + (let ((inhibit-modification-hooks t)) (srecode--insert-into-buffer template dictionary) ) ;; Now call those after change functions. diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 215425f136..e909da3c20 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -985,9 +985,6 @@ Leaves point at the location of the start of the expansion." "\\(" dabbrev--abbrev-char-regexp "\\)")) (pattern2 (concat (regexp-quote abbrev) "\\(\\(" dabbrev--abbrev-char-regexp "\\)+\\)")) - ;; This makes it possible to find matches in minibuffer prompts - ;; even when they are "inviolable". - (inhibit-point-motion-hooks t) found-string result) ;; Limited search. (save-restriction diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index bccf0e6f1f..445595e2da 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -248,7 +248,6 @@ specified by `erc-button-alist'." (save-excursion (with-syntax-table erc-button-syntax-table (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) (inhibit-field-text-motion t) (alist erc-button-alist) regexp) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 20f22c896f..f128387bcf 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2749,8 +2749,7 @@ current session. `active' means the current active buffer buffer is used. `erc-display-line-1' is used to display STRING. If STRING is nil, the function does nothing." - (let ((inhibit-point-motion-hooks t) - new-bufs) + (let (new-bufs) (dolist (buf (cond ((bufferp buffer) (list buffer)) ((listp buffer) buffer) diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el index e0bcd8b099..06ddda1424 100644 --- a/lisp/eshell/em-script.el +++ b/lisp/eshell/em-script.el @@ -90,8 +90,7 @@ This includes when running `eshell-command'." "Execute a series of Eshell commands in FILE, passing ARGS. Comments begin with `#'." (let ((orig (point)) - (here (point-max)) - (inhibit-point-motion-hooks t)) + (here (point-max))) (goto-char (point-max)) (with-silent-modifications ;; FIXME: Why not use a temporary buffer and avoid this diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index 6768cee4c3..c52ce31899 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -197,8 +197,7 @@ The options are `begin', `after' or `end'." (defun eshell-smart-scroll-window (wind _start) "Scroll the given Eshell window WIND accordingly." (unless eshell-currently-handling-window - (let ((inhibit-point-motion-hooks t) - (eshell-currently-handling-window t)) + (let ((eshell-currently-handling-window t)) (with-selected-window wind (eshell-smart-redisplay))))) diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 576d32b8c5..f87cc2f20a 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -285,8 +285,7 @@ Point is left at the end of the arguments." (save-restriction (goto-char beg) (narrow-to-region beg end) - (let ((inhibit-point-motion-hooks t) - (args (list t)) + (let ((args (list t)) delim) (with-silent-modifications (remove-text-properties (point-min) (point-max) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 413336e3eb..3f3a1616ee 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -372,8 +372,7 @@ The value returned is the last form in BODY." ;; Since parsing relies partly on buffer-local state ;; (e.g. that of `eshell-parse-argument-hook'), we need to ;; perform the parsing in the Eshell buffer. - (let ((begin (point)) end - (inhibit-point-motion-hooks t)) + (let ((begin (point)) end) (with-silent-modifications (insert reg) (setq end (point)) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 8f11e6f04a..92523fd99e 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -598,7 +598,6 @@ newline." ;; Note that the input string does not include its terminal newline. (let ((proc-running-p (and (eshell-head-process) (not queue-p))) - (inhibit-point-motion-hooks t) (inhibit-modification-hooks t)) (unless (and proc-running-p (not (eq (process-status @@ -687,7 +686,6 @@ newline." This is done after all necessary filtering has been done." (let ((oprocbuf (if process (process-buffer process) (current-buffer))) - (inhibit-point-motion-hooks t) (inhibit-modification-hooks t)) (when (and string oprocbuf (buffer-name oprocbuf)) (with-current-buffer oprocbuf diff --git a/lisp/format.el b/lisp/format.el index 2c368b8f9c..5cd2d4bfb4 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -440,10 +440,9 @@ a list (ABSOLUTE-FILE-NAME SIZE)." (file-name-nondirectory file))))) (list file fmt))) (let (value size old-undo) - ;; Record only one undo entry for the insertion. Inhibit point-motion and - ;; modification hooks as with `insert-file-contents'. - (let ((inhibit-point-motion-hooks t) - (inhibit-modification-hooks t)) + ;; Record only one undo entry for the insertion. + ;; Inhibit modification hooks as with `insert-file-contents'. + (let ((inhibit-modification-hooks t)) ;; Don't bind `buffer-undo-list' to t here to assert that ;; `insert-file-contents' may record whether the buffer was unmodified ;; before. diff --git a/lisp/forms.el b/lisp/forms.el index fdc44b5214..b97fdbe04c 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -1928,8 +1928,7 @@ after writing out the data." (let ((i 0) (here (point)) there - (cnt 0) - (inhibit-point-motion-hooks t)) + (cnt 0)) (if (zerop arg) (setq cnt 1) @@ -1955,8 +1954,7 @@ after writing out the data." (let ((i (length forms--markers)) (here (point)) there - (cnt 0) - (inhibit-point-motion-hooks t)) + (cnt 0)) (if (zerop arg) (setq cnt 1) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index fbcf801313..3bea1a4c1d 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1765,7 +1765,6 @@ Initialized from `text-mode-syntax-table'.") `(with-current-buffer gnus-article-buffer (save-restriction (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t) (case-fold-search t)) (article-narrow-to-head) ,@forms)))) @@ -1852,7 +1851,6 @@ Initialized from `text-mode-syntax-table'.") (let ((inhibit-read-only t) (case-fold-search t) (max (1+ (length gnus-sorted-header-list))) - (inhibit-point-motion-hooks t) (cur (current-buffer)) ignored visible beg) (save-excursion @@ -1919,8 +1917,7 @@ always hide." (not gnus-show-all-headers)) (save-excursion (save-restriction - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) + (let ((inhibit-read-only t)) (article-narrow-to-head) (dolist (elem gnus-boring-article-headers) (goto-char (point-min)) @@ -2567,8 +2564,7 @@ fill width." "Decode all MIME-encoded words in the article." (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer - (let ((inhibit-point-motion-hooks t) - (mail-parse-charset gnus-newsgroup-charset) + (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (with-current-buffer gnus-summary-buffer gnus-newsgroup-ignored-charsets))) @@ -2578,7 +2574,7 @@ fill width." "Decode charset-encoded text in the article. If PROMPT (the prefix), prompt for a coding system to use." (interactive "P" gnus-article-mode) - (let ((inhibit-point-motion-hooks t) (case-fold-search t) + (let ((case-fold-search t) (inhibit-read-only t) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets @@ -2620,8 +2616,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." - (let ((inhibit-point-motion-hooks t) - (mail-parse-charset gnus-newsgroup-charset) + (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (save-excursion (condition-case nil (set-buffer gnus-summary-buffer) @@ -2668,8 +2663,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (defun article-decode-group-name () "Decode group names in Newsgroups, Followup-To and Xref headers." - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t) + (let ((inhibit-read-only t) (method (gnus-find-method-for-group gnus-newsgroup-name)) regexp) (when (and (or gnus-group-name-charset-method-alist @@ -2699,8 +2693,7 @@ The following headers are decoded: From:, To:, Cc:, Reply-To:, Mail-Reply-To: and Mail-Followup-To:." (when gnus-use-idna (save-restriction - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) (article-narrow-to-head) (goto-char (point-min)) (while (re-search-forward "@[^ \t\n\r,>]*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t) @@ -3171,8 +3164,7 @@ images if any to the browser, and deletes them when exiting the group "Remove list identifiers from the Subject header. The `gnus-list-identifiers' variable specifies what to do." (interactive nil gnus-article-mode) - (let ((inhibit-point-motion-hooks t) - (regexp (gnus-group-get-list-identifiers gnus-newsgroup-name)) + (let ((regexp (gnus-group-get-list-identifiers gnus-newsgroup-name)) (inhibit-read-only t)) (when regexp (save-excursion @@ -3221,34 +3213,32 @@ always hide." (interactive nil gnus-article-mode) (save-excursion (save-restriction - (let ((inhibit-point-motion-hooks t)) - (when (gnus-parameter-banner gnus-newsgroup-name) - (article-really-strip-banner - (gnus-parameter-banner gnus-newsgroup-name))) - (when gnus-article-address-banner-alist - ;; Note that the From header is decoded here, so it is - ;; required that the *-extract-address-components function - ;; supports non-ASCII text. - (let ((from (save-restriction - (widen) - (article-narrow-to-head) - (mail-fetch-field "from")))) - (when (and from - (setq from - (cadr (funcall gnus-extract-address-components - from)))) - (catch 'found - (dolist (pair gnus-article-address-banner-alist) - (when (string-match (car pair) from) - (throw 'found - (article-really-strip-banner (cdr pair))))))))))))) + (when (gnus-parameter-banner gnus-newsgroup-name) + (article-really-strip-banner + (gnus-parameter-banner gnus-newsgroup-name))) + (when gnus-article-address-banner-alist + ;; Note that the From header is decoded here, so it is + ;; required that the *-extract-address-components function + ;; supports non-ASCII text. + (let ((from (save-restriction + (widen) + (article-narrow-to-head) + (mail-fetch-field "from")))) + (when (and from + (setq from + (cadr (funcall gnus-extract-address-components + from)))) + (catch 'found + (dolist (pair gnus-article-address-banner-alist) + (when (string-match (car pair) from) + (throw 'found + (article-really-strip-banner (cdr pair)))))))))))) (defun article-really-strip-banner (banner) "Strip the banner specified by the argument." (save-excursion (save-restriction - (let ((inhibit-point-motion-hooks t) - (gnus-signature-limit nil) + (let ((gnus-signature-limit nil) (inhibit-read-only t)) (article-goto-body) (cond @@ -3307,8 +3297,7 @@ always hide." "Remove all blank lines from the beginning of the article." (interactive nil gnus-article-mode) (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) (when (article-goto-body) (while (and (not (eobp)) (looking-at "[ \t]*$")) @@ -3349,8 +3338,7 @@ Point is left at the beginning of the narrowed-to region." "Replace consecutive blank lines with one empty line." (interactive nil gnus-article-mode) (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) ;; First make all blank lines empty. (article-goto-body) (while (re-search-forward "^[ \t]+$" nil t) @@ -3368,8 +3356,7 @@ Point is left at the beginning of the narrowed-to region." "Remove all white space from the beginning of the lines in the article." (interactive nil gnus-article-mode) (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) (article-goto-body) (while (re-search-forward "^[ \t]+" nil t) (replace-match "" t t))))) @@ -3378,8 +3365,7 @@ Point is left at the beginning of the narrowed-to region." "Remove all white space from the end of the lines in the article." (interactive nil gnus-article-mode) (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) (article-goto-body) (while (re-search-forward "[ \t]+$" nil t) (replace-match "" t t))))) @@ -3395,37 +3381,35 @@ Point is left at the beginning of the narrowed-to region." "Strip all blank lines." (interactive nil gnus-article-mode) (save-excursion - (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) (article-goto-body) (while (re-search-forward "^[ \t]*\n" nil t) (replace-match "" t t))))) (defun gnus-article-narrow-to-signature () "Narrow to the signature; return t if a signature is found, else nil." - (let ((inhibit-point-motion-hooks t)) - (when (gnus-article-search-signature) - (forward-line 1) - ;; Check whether we have some limits to what we consider - ;; to be a signature. - (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit - (list gnus-signature-limit))) - limit limited) - (while (setq limit (pop limits)) - (if (or (and (integerp limit) - (< (- (point-max) (point)) limit)) - (and (floatp limit) - (< (count-lines (point) (point-max)) limit)) - (and (functionp limit) - (funcall limit)) - (and (stringp limit) - (not (re-search-forward limit nil t)))) - () ; This limit did not succeed. - (setq limited t - limits nil))) - (unless limited - (narrow-to-region (point) (point-max)) - t))))) + (when (gnus-article-search-signature) + (forward-line 1) + ;; Check whether we have some limits to what we consider + ;; to be a signature. + (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit + (list gnus-signature-limit))) + limit limited) + (while (setq limit (pop limits)) + (if (or (and (integerp limit) + (< (- (point-max) (point)) limit)) + (and (floatp limit) + (< (count-lines (point) (point-max)) limit)) + (and (functionp limit) + (funcall limit)) + (and (stringp limit) + (not (re-search-forward limit nil t)))) + () ; This limit did not succeed. + (setq limited t + limits nil))) + (unless limited + (narrow-to-region (point) (point-max)) + t)))) (defun gnus-article-search-signature () "Search the current buffer for the signature separator. @@ -3485,8 +3469,7 @@ means show, 0 means toggle." (defun gnus-article-show-hidden-text (type &optional _dummy) "Show all hidden text of type TYPE. Originally it is hide instead of DUMMY." - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) + (let ((inhibit-read-only t)) (gnus-remove-text-properties-when 'article-type type (point-min) (point-max) @@ -3528,7 +3511,6 @@ possible values." (interactive (list 'ut t) gnus-article-mode) (let* ((case-fold-search t) (inhibit-read-only t) - (inhibit-point-motion-hooks t) (visible-date (mail-fetch-field "Date")) pos date bface eface) (save-excursion @@ -4351,8 +4333,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (insert-buffer-substring gnus-original-article-buffer) (setq items (split-string sig)) (message-narrow-to-head) - (let ((inhibit-point-motion-hooks t) - (case-fold-search t)) + (let ((case-fold-search t)) ;; Don't verify multiple headers. (setq headers (mapconcat (lambda (header) (concat header ": " @@ -6811,16 +6792,15 @@ not have a face in `gnus-article-boring-faces'." (boundp 'gnus-article-boring-faces) (symbol-value 'gnus-article-boring-faces)) (save-excursion - (let ((inhibit-point-motion-hooks t)) - (catch 'only-boring - (while (re-search-forward "\\b\\w\\w" nil t) - (forward-char -1) - (when (not (seq-intersection - (gnus-faces-at (point)) - (symbol-value 'gnus-article-boring-faces) - #'eq)) - (throw 'only-boring nil))) - (throw 'only-boring t)))))) + (catch 'only-boring + (while (re-search-forward "\\b\\w\\w" nil t) + (forward-char -1) + (when (not (seq-intersection + (gnus-faces-at (point)) + (symbol-value 'gnus-article-boring-faces) + #'eq)) + (throw 'only-boring nil))) + (throw 'only-boring t))))) (defun gnus-article-refer-article () "Read article specified by message-id around point." @@ -8112,18 +8092,17 @@ It does this by highlighting everything after `gnus-signature-separator' using the face `gnus-signature'." (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer - (let ((inhibit-point-motion-hooks t)) - (save-restriction - (when (and gnus-signature-face - (gnus-article-narrow-to-signature)) - (overlay-put (make-overlay (point-min) (point-max) nil t) - 'face gnus-signature-face) - (widen) - (gnus-article-search-signature) - (let ((start (match-beginning 0)) - (end (set-marker (make-marker) (1+ (match-end 0))))) - (gnus-article-add-button start (1- end) 'gnus-signature-toggle - end))))))) + (save-restriction + (when (and gnus-signature-face + (gnus-article-narrow-to-signature)) + (overlay-put (make-overlay (point-min) (point-max) nil t) + 'face gnus-signature-face) + (widen) + (gnus-article-search-signature) + (let ((start (match-beginning 0)) + (end (set-marker (make-marker) (1+ (match-end 0))))) + (gnus-article-add-button start (1- end) 'gnus-signature-toggle + end)))))) (defun gnus-button-in-region-p (b e prop) "Say whether PROP exists in the region." @@ -8135,8 +8114,7 @@ It does this by highlighting everything after specified by `gnus-button-alist'." (interactive nil gnus-article-mode gnus-summary-mode) (gnus-with-article-buffer - (let ((inhibit-point-motion-hooks t) - (case-fold-search t) + (let ((case-fold-search t) (alist gnus-button-alist) beg entry regexp) ;; We skip the headers. @@ -8292,19 +8270,18 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-signature-toggle (end) (gnus-with-article-buffer - (let ((inhibit-point-motion-hooks t)) - (if (text-property-any end (point-max) 'article-type 'signature) - (progn - (gnus-delete-wash-type 'signature) - (gnus-remove-text-properties-when - 'article-type 'signature end (point-max) - (cons 'article-type (cons 'signature - gnus-hidden-properties)))) - (gnus-add-wash-type 'signature) - (gnus-add-text-properties-when - 'article-type nil end (point-max) - (cons 'article-type (cons 'signature - gnus-hidden-properties))))) + (if (text-property-any end (point-max) 'article-type 'signature) + (progn + (gnus-delete-wash-type 'signature) + (gnus-remove-text-properties-when + 'article-type 'signature end (point-max) + (cons 'article-type (cons 'signature + gnus-hidden-properties)))) + (gnus-add-wash-type 'signature) + (gnus-add-text-properties-when + 'article-type nil end (point-max) + (cons 'article-type (cons 'signature + gnus-hidden-properties)))) (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) (gnus-set-mode-line 'article)))) @@ -8313,8 +8290,7 @@ url is put as the `gnus-button-url' overlay property on the button." (save-excursion (let* ((marker (car marker-and-entry)) (entry (cadr marker-and-entry)) - (regexp (car entry)) - (inhibit-point-motion-hooks t)) + (regexp (car entry))) (goto-char marker) ;; This is obviously true, or something bad is happening :) ;; But we need it to have the match-data diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index b4d7661d74..e344b071bf 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -341,7 +341,6 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (let ((buffer-read-only nil) (alist gnus-cite-prefix-alist) (faces gnus-cite-face-list) - (inhibit-point-motion-hooks t) face entry prefix skip numbers number face-alist) ;; Loop through citation prefixes. (while alist @@ -462,7 +461,6 @@ text (i.e., computer code and the like) will not be folded." (interactive "P" gnus-article-mode gnus-summary-mode) (with-current-buffer gnus-article-buffer (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) (marks (gnus-dissect-cited-text)) (adaptive-fill-mode nil) (fill-column (if width (prefix-numeric-value width) fill-column))) @@ -536,7 +534,6 @@ always hide." (with-current-buffer gnus-article-buffer (let ((buffer-read-only nil) marks - (inhibit-point-motion-hooks t) (props (nconc (list 'article-type 'cite) gnus-hidden-properties)) (point (point-min)) @@ -613,7 +610,6 @@ means show, nil means toggle." (start (cadr args)) (hidden (text-property-any beg (1- end) 'article-type 'cite)) - (inhibit-point-motion-hooks t) buffer-read-only) (when (or (null arg) (zerop arg) @@ -673,7 +669,6 @@ See also the documentation for `gnus-article-highlight-citation'." (let ((start (point)) (atts gnus-cite-attribution-alist) (buffer-read-only nil) - (inhibit-point-motion-hooks t) (hidden 0) total) (goto-char (point-max)) @@ -731,13 +726,12 @@ See also the documentation for `gnus-article-highlight-citation'." (defun gnus-cite-parse-wrapper () ;; Wrap chopped gnus-cite-parse. (article-goto-body) - (let ((inhibit-point-motion-hooks t)) - (save-excursion - (gnus-cite-parse-attributions)) - (save-excursion - (gnus-cite-parse)) - (save-excursion - (gnus-cite-connect-attributions)))) + (save-excursion + (gnus-cite-parse-attributions)) + (save-excursion + (gnus-cite-parse)) + (save-excursion + (gnus-cite-connect-attributions))) (defun gnus-cite-parse () ;; Parse and connect citation prefixes and attribution lines. @@ -1020,8 +1014,7 @@ See also the documentation for `gnus-article-highlight-citation'." (defun gnus-cite-add-face (number prefix face) ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. (when face - (let ((inhibit-point-motion-hooks t) - from to overlay) + (let (from to overlay) (goto-char (point-min)) (when (zerop (forward-line (1- number))) (forward-char (length prefix)) @@ -1041,7 +1034,6 @@ See also the documentation for `gnus-article-highlight-citation'." (gnus-cite-parse-maybe nil t) (let ((buffer-read-only nil) (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) - (inhibit-point-motion-hooks t) number) (while numbers (setq number (car numbers) diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index d64e000d70..93b18f9555 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el @@ -87,7 +87,6 @@ callback for `gravatar-retrieve'." (let ((real-name (car address)) (mail-address (cadr address)) (mark (point-marker)) - (inhibit-point-motion-hooks t) (case-fold-search t)) (save-restriction (article-narrow-to-head) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 35103e9c4f..e69f0857e7 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2651,6 +2651,7 @@ If EXCLUDE-GROUP, do not go to that group." (and best-point (gnus-group-group-name)))) ;; Is there something like an after-point-motion-hook? +;; FIXME: There's `cursor-sensor-mode's `cursor-sensor-functions' property. ;; (inhibit-point-motion-hooks?). Is there a tool-bar-update function? ;; (defun gnus-group-menu-bar-update () diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el index 9872f7b994..da1afb672a 100644 --- a/lisp/gnus/gnus-rfc1843.el +++ b/lisp/gnus/gnus-rfc1843.el @@ -40,8 +40,7 @@ (save-excursion (save-restriction (message-narrow-to-head) - (let* ((inhibit-point-motion-hooks t) - (case-fold-search t) + (let* ((case-fold-search t) (ct (message-fetch-field "Content-Type" t)) (ctl (and ct (mail-header-parse-content-type ct)))) (if (and ctl (not (string-search "/" (car ctl)))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 107ad8fd4a..18ba55a439 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9856,7 +9856,6 @@ If ARG is a negative number, hide the unwanted header lines." (widen) (article-narrow-to-head) (let* ((inhibit-read-only t) - (inhibit-point-motion-hooks t) (hidden (if (numberp arg) (>= arg 0) (or diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index fe556b155a..95c9539593 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -166,9 +166,8 @@ is slower." (require 'message) (save-excursion (save-restriction - (let ((inhibit-point-motion-hooks t)) - (nnheader-narrow-to-headers) - (message-fetch-field field))))) + (nnheader-narrow-to-headers) + (message-fetch-field field)))) (defun gnus-fetch-original-field (field) "Fetch FIELD from the original version of the current article." diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index beccef6f5f..67ec0531fa 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2172,8 +2172,7 @@ If FIRST is non-nil, only the first value is returned. The buffer is expected to be narrowed to just the header of the message; see `message-narrow-to-headers-or-head'." - (let* ((inhibit-point-motion-hooks t) - (value (mail-fetch-field header nil (not first)))) + (let* ((value (mail-fetch-field header nil (not first)))) (when value (while (string-match "\n[\t ]+" value) (setq value (replace-match " " t t value))) @@ -7309,7 +7308,6 @@ specified by FUNCTIONS, if non-nil, or by the variable (let ((cur (current-buffer)) from subject date references message-id follow-to - (inhibit-point-motion-hooks t) (message-this-is-mail t) gnus-warning) (save-restriction @@ -7370,7 +7368,6 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line." (let ((cur (current-buffer)) from subject date reply-to mrt mct references message-id follow-to - (inhibit-point-motion-hooks t) (message-this-is-news t) followup-to distribution newsgroups gnus-warning posted-to) (save-restriction @@ -8609,7 +8606,6 @@ From headers in the original article." (let ((regexps (if (stringp message-hidden-headers) (list message-hidden-headers) message-hidden-headers)) - (inhibit-point-motion-hooks t) (inhibit-modification-hooks t) end-of-headers) (when regexps diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el index ba7e68eb81..935c9111ee 100644 --- a/lisp/minibuf-eldef.el +++ b/lisp/minibuf-eldef.el @@ -110,8 +110,7 @@ should be displayed in its place.") "Set up a minibuffer for `minibuffer-electric-default-mode'. The prompt and initial input should already have been inserted." (let ((regexps minibuffer-default-in-prompt-regexps) - (match nil) - (inhibit-point-motion-hooks t)) + (match nil)) (save-excursion (save-restriction ;; Narrow to only the prompt. diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index 99ed14ca8b..86cf98004b 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -164,52 +164,51 @@ and `goto-address-fontify-p'." ;; Clean up from any previous go. (goto-address-unfontify (or start (point-min)) (or end (point-max))) (save-excursion - (let ((inhibit-point-motion-hooks t)) + (goto-char (or start (point-min))) + (when (or (eq t goto-address-fontify-maximum-size) + (< (- (or end (point-max)) (point)) + goto-address-fontify-maximum-size)) + (while (re-search-forward goto-address-url-regexp end t) + (let* ((s (match-beginning 0)) + (e (match-end 0)) + this-overlay) + (when (or (not goto-address-prog-mode) + ;; This tests for both comment and string + ;; syntax. + (nth 8 (syntax-ppss))) + (setq this-overlay (make-overlay s e)) + (and goto-address-fontify-p + (overlay-put this-overlay 'face goto-address-url-face)) + (overlay-put this-overlay 'evaporate t) + (overlay-put this-overlay + 'mouse-face goto-address-url-mouse-face) + (overlay-put this-overlay 'follow-link t) + (overlay-put this-overlay + 'help-echo "mouse-2, C-c RET: follow URL") + (overlay-put this-overlay + 'keymap goto-address-highlight-keymap) + (overlay-put this-overlay 'goto-address t)))) (goto-char (or start (point-min))) - (when (or (eq t goto-address-fontify-maximum-size) - (< (- (or end (point-max)) (point)) - goto-address-fontify-maximum-size)) - (while (re-search-forward goto-address-url-regexp end t) - (let* ((s (match-beginning 0)) - (e (match-end 0)) - this-overlay) - (when (or (not goto-address-prog-mode) - ;; This tests for both comment and string - ;; syntax. - (nth 8 (syntax-ppss))) - (setq this-overlay (make-overlay s e)) - (and goto-address-fontify-p - (overlay-put this-overlay 'face goto-address-url-face)) - (overlay-put this-overlay 'evaporate t) - (overlay-put this-overlay - 'mouse-face goto-address-url-mouse-face) - (overlay-put this-overlay 'follow-link t) - (overlay-put this-overlay - 'help-echo "mouse-2, C-c RET: follow URL") - (overlay-put this-overlay - 'keymap goto-address-highlight-keymap) - (overlay-put this-overlay 'goto-address t)))) - (goto-char (or start (point-min))) - (while (re-search-forward goto-address-mail-regexp end t) - (let* ((s (match-beginning 0)) - (e (match-end 0)) - this-overlay) - (when (or (not goto-address-prog-mode) - ;; This tests for both comment and string - ;; syntax. - (nth 8 (syntax-ppss))) - (setq this-overlay (make-overlay s e)) - (and goto-address-fontify-p - (overlay-put this-overlay 'face goto-address-mail-face)) - (overlay-put this-overlay 'evaporate t) - (overlay-put this-overlay 'mouse-face - goto-address-mail-mouse-face) - (overlay-put this-overlay 'follow-link t) - (overlay-put this-overlay - 'help-echo "mouse-2, C-c RET: mail this address") - (overlay-put this-overlay - 'keymap goto-address-highlight-keymap) - (overlay-put this-overlay 'goto-address t)))))))) + (while (re-search-forward goto-address-mail-regexp end t) + (let* ((s (match-beginning 0)) + (e (match-end 0)) + this-overlay) + (when (or (not goto-address-prog-mode) + ;; This tests for both comment and string + ;; syntax. + (nth 8 (syntax-ppss))) + (setq this-overlay (make-overlay s e)) + (and goto-address-fontify-p + (overlay-put this-overlay 'face goto-address-mail-face)) + (overlay-put this-overlay 'evaporate t) + (overlay-put this-overlay 'mouse-face + goto-address-mail-mouse-face) + (overlay-put this-overlay 'follow-link t) + (overlay-put this-overlay + 'help-echo "mouse-2, C-c RET: mail this address") + (overlay-put this-overlay + 'keymap goto-address-highlight-keymap) + (overlay-put this-overlay 'goto-address t))))))) (defun goto-address-fontify-region (start end) "Fontify URLs and e-mail addresses in the given region." diff --git a/lisp/obsolete/linum.el b/lisp/obsolete/linum.el index c6ce3d6d11..e94cf5086c 100644 --- a/lisp/obsolete/linum.el +++ b/lisp/obsolete/linum.el @@ -209,10 +209,7 @@ Linum mode is a buffer-local minor mode." (overlay-put ov 'before-string (propertize " " 'display `((margin left-margin) ,str))) (overlay-put ov 'linum-str str)))) - ;; Text may contain those nasty intangible properties, but that - ;; shouldn't prevent us from counting those lines. - (let ((inhibit-point-motion-hooks t)) - (forward-line)) + (forward-line) (setq line (1+ line))) (when (display-graphic-p) (setq width (ceiling diff --git a/lisp/play/zone.el b/lisp/play/zone.el index 34523fef05..b0ce0194cf 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -204,8 +204,7 @@ If the element is a function or a list of a function and a number, (insert s))) (defun zone-shift-left () - (let ((inhibit-point-motion-hooks t) - s) + (let (s) (while (not (eobp)) (unless (eolp) (setq s (buffer-substring (point) (1+ (point)))) @@ -216,8 +215,7 @@ If the element is a function or a list of a function and a number, (defun zone-shift-right () (goto-char (point-max)) - (let ((inhibit-point-motion-hooks t) - s) + (let (s) (while (not (bobp)) (unless (bolp) (setq s (buffer-substring (1- (point)) (point))) @@ -448,8 +446,7 @@ If the element is a function or a list of a function and a number, (defun zone-fill-out-screen (width height) (let ((start (window-start)) - (line (make-string width 32)) - (inhibit-point-motion-hooks t)) + (line (make-string width 32))) (goto-char start) ;; fill out rectangular ws block (while (progn (end-of-line) @@ -664,8 +661,7 @@ If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).") (setq c (point)) (move-to-column 9) (setq col (cons (buffer-substring (point) c) col)) -; (let ((inhibit-point-motion-hooks t)) - (end-of-line 0);) + (end-of-line 0) (forward-char -10)) (let ((life-patterns (vector (if (and col (search-forward "@" max t)) diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index 5ed719b5a7..fb1e501066 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -275,8 +275,7 @@ nested routine.") (declare (debug t)) `(save-excursion (save-match-data - (let ((inhibit-point-motion-hooks t) - (deactivate-mark nil)) + (let ((deactivate-mark nil)) (progn ,@forms))))) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index b763da3fbc..a36bb7fbe4 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -2507,11 +2507,10 @@ consistent searching." (defmacro vhdl-prepare-search-2 (&rest body) "Enable case insensitive search, switch to syntax table that includes `_', -arrange to ignore `intangible' overlays, then execute BODY, and finally restore -the old environment. Used for consistent searching." +then execute BODY, and finally restore the old environment. +Used for consistent searching." (declare (debug t)) - `(let ((case-fold-search t) ; case insensitive search - (inhibit-point-motion-hooks t)) + `(let ((case-fold-search t)) ; case insensitive search ;; use extended syntax table (with-syntax-table vhdl-mode-ext-syntax-table ;; execute BODY safely diff --git a/lisp/simple.el b/lisp/simple.el index 6b73ccb516..7556b5adcf 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3526,8 +3526,6 @@ Return what remains of the list." ;; In a writable buffer, enable undoing read-only text that is ;; so because of text properties. (inhibit-read-only t) - ;; Don't let `intangible' properties interfere with undo. - (inhibit-point-motion-hooks t) ;; We use oldlist only to check for EQ. ++kfs (oldlist buffer-undo-list) (did-apply nil) diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index 935be06812..26f22a9a4a 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -325,8 +325,7 @@ the region, and the START and END of each region." ;;;###autoload (defun enriched-encode (from to orig-buf) (if enriched-verbose (message "Enriched: encoding document...")) - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) + (let ((inhibit-read-only t)) (save-restriction (narrow-to-region from to) (delete-to-left-margin) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 774e7ac737..a66b72cfd0 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -1032,7 +1032,6 @@ Mostly we check word delimiters." (defun flyspell-word-search-backward (word bound &optional ignore-case) (save-excursion (let* ((r '()) - (inhibit-point-motion-hooks t) (flyspell-not-casechars (flyspell-get-not-casechars)) (bound (if (and bound (> bound (point-min))) @@ -1066,7 +1065,6 @@ Mostly we check word delimiters." (defun flyspell-word-search-forward (word bound) (save-excursion (let* ((r '()) - (inhibit-point-motion-hooks t) (flyspell-not-casechars (flyspell-get-not-casechars)) (bound (if (and bound (< bound (point-max))) diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index fc06c4c0da..964f94228b 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -5221,16 +5221,15 @@ instead of the current buffer and returns the OBJECT." "Point has entered a cell. Refresh the menu bar." ;; Avoid calling point-motion-hooks recursively. - (let ((inhibit-point-motion-hooks t)) - (force-mode-line-update) - (pcase dir - ('left - (setq table-mode-indicator nil) - (run-hooks 'table-point-left-cell-hook)) - ('entered - (setq table-mode-indicator t) - (table--warn-incompatibility) - (run-hooks 'table-point-entered-cell-hook))))) + (force-mode-line-update) + (pcase dir + ('left + (setq table-mode-indicator nil) + (run-hooks 'table-point-left-cell-hook)) + ('entered + (setq table-mode-indicator t) + (table--warn-incompatibility) + (run-hooks 'table-point-entered-cell-hook)))) (defun table--warn-incompatibility () "If called from interactive operation warn the know incompatibilities. diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index bb8ea0d942..ca0312d8fb 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1039,7 +1039,7 @@ says which mode to use." ;; have files annotated with -*- LaTeX -*- (e.g. because they received ;; them from someone using AUCTeX). ;; FIXME: Turn them into autoloads so that AUCTeX can override them -;; with it's own autoloads? Or maybe rely on `major-mode-remap-alist'? +;; with its own autoloads? Or maybe rely on `major-mode-remap-alist'? ;;;###autoload (defalias 'TeX-mode #'tex-mode) ;;;###autoload (defalias 'plain-TeX-mode #'plain-tex-mode) ;;;###autoload (defalias 'LaTeX-mode #'latex-mode) commit cfb1e218447c796f7a48347f648152b30f3edf92 (refs/remotes/origin/emacs-28) Author: Lars Ingebrigtsen Date: Fri Oct 7 14:40:38 2022 +0200 Update name of hs-mouse-toggle-hiding in Emacs manual * doc/emacs/programs.texi (Hideshow): Update the name of hs-mouse-toggle-hiding (bug#58331). diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 9eb11c602d..ef9b3885e7 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -1350,7 +1350,7 @@ count as blocks. @findex hs-show-region @findex hs-hide-level @findex hs-toggle-hiding -@findex hs-mouse-toggle-hiding +@findex hs-toggle-hiding @kindex C-c @@ C-h @kindex C-c @@ C-s @kindex C-c @@ C-c @@ -1367,9 +1367,8 @@ Hide the current block (@code{hs-hide-block}). Show the current block (@code{hs-show-block}). @item C-c @@ C-c @itemx C-c @@ C-e +@itemx S-mouse-2 Either hide or show the current block (@code{hs-toggle-hiding}). -@item S-mouse-2 -Toggle hiding for the block you click on (@code{hs-mouse-toggle-hiding}). @item C-c @@ C-M-h @itemx C-c @@ C-t Hide all top-level blocks (@code{hs-hide-all}). commit 67a20bb4b54de1faf840836015389bcc3d7a3eed Author: Matt Armstrong Date: Fri Oct 7 08:17:50 2022 -0400 Handle successive mime sections in decoding. rmailsum.el (rmail-epa-decode):Handle blank lines at start. Handle both ending delim and another starting delim. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 812e9a201b..f095d5e9c0 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4693,15 +4693,23 @@ Argument MIME is non-nil if this is a mime message." (save-excursion (goto-char (point-min)) (while (re-search-forward "--------------[0-9a-zA-Z]+\n" nil t) - (let ((delim (concat (substring (match-string 0) 0 -1) "--\n"))) + ;; The ending delimiter is a start delimiter if another section follows. + ;; Otherwise it is an end delimiter, with -- affixed. + (let ((delim (concat (substring (match-string 0) 0 -1) "\\(\\|--\\)\n"))) (when (looking-at "\ Content-Type: text/[a-z]+; charset=UTF-8; format=flowed Content-Transfer-Encoding: base64\n") (goto-char (match-end 0)) + ;; Sometimes the attachment's headers are followed by blank lines + (while (eolp) + (forward-line 1)) (let ((start (point)) (inhibit-read-only t)) - (search-forward delim) + (re-search-forward delim) (forward-line -1) + ;; Sometimes the attachment's contents are followed by blank lines + (while (save-excursion (forward-line -1) (eolp)) + (forward-line -1)) (base64-decode-region start (point)) (forward-line 1))))))) commit def6fa4246502befa174aa6409166b0967621f7b Author: Mattias Engdegård Date: Thu Oct 6 17:46:02 2022 +0200 Speed up string-lessp for multibyte strings Improve comparison speed when both arguments are multibyte strings, at least one of them containing a non-ASCII character. (All-ASCII multibyte strings are already fast.) The speed-up is about 2× for strings of 10 chars, 10× for strings of 100 chars. * src/fns.c (Fstring_lessp): Quickly skip the common prefix by comparing words. diff --git a/src/fns.c b/src/fns.c index 22e66d3653..bc4915eb25 100644 --- a/src/fns.c +++ b/src/fns.c @@ -454,23 +454,50 @@ Symbols are also allowed; their print names are used instead. */) && (!STRING_MULTIBYTE (string2) || SCHARS (string2) == SBYTES (string2))) { /* Each argument is either unibyte or all-ASCII multibyte: - we can compare bytewise. - (Arbitrary multibyte strings cannot be compared bytewise because - that would give a different order for raw bytes 80..FF.) */ + we can compare bytewise. */ int d = memcmp (SSDATA (string1), SSDATA (string2), n); return d < 0 || (d == 0 && n < SCHARS (string2)) ? Qt : Qnil; } else if (STRING_MULTIBYTE (string1) && STRING_MULTIBYTE (string2)) { - ptrdiff_t i1 = 0, i1_byte = 0, i2 = 0, i2_byte = 0; - while (i1 < n) - { - int c1 = fetch_string_char_advance_no_check (string1, &i1, &i1_byte); - int c2 = fetch_string_char_advance_no_check (string2, &i2, &i2_byte); - if (c1 != c2) - return c1 < c2 ? Qt : Qnil; - } - return i1 < SCHARS (string2) ? Qt : Qnil; + /* Two arbitrary multibyte strings: we cannot use memcmp because + the encoding for raw bytes would sort those between U+007F and U+0080 + which isn't where we want them. + Instead, we skip the longest common prefix and look at + what follows. */ + ptrdiff_t nb1 = SBYTES (string1); + ptrdiff_t nb2 = SBYTES (string2); + ptrdiff_t nb = min (nb1, nb2); + + /* First compare entire machine words. (String data is allocated + with word alignment.) */ + typedef size_t word_t; + int ws = sizeof (word_t); + const word_t *w1 = (const word_t *) SDATA (string1); + const word_t *w2 = (const word_t *) SDATA (string2); + ptrdiff_t b = 0; + while (b < nb - ws + 1 && w1[b / ws] == w2[b / ws]) + b += ws; + + /* Scan forward to the differing byte (at most ws-1 bytes). */ + while (b < nb && SREF (string1, b) == SREF (string2, b)) + b++; + + if (b >= nb) + /* One string is a prefix of the other. */ + return b < nb2 ? Qt : Qnil; + + /* Now back up to the start of the differing characters: + it's the last byte not having the bit pattern 10xxxxxx. */ + while ((SREF (string1, b) & 0xc0) == 0x80) + b--; + + /* Compare the differing characters. */ + ptrdiff_t i1 = 0, i2 = 0; + ptrdiff_t i1_byte = b, i2_byte = b; + int c1 = fetch_string_char_advance_no_check (string1, &i1, &i1_byte); + int c2 = fetch_string_char_advance_no_check (string2, &i2, &i2_byte); + return c1 < c2 ? Qt : Qnil; } else if (STRING_MULTIBYTE (string1)) { commit 6b4c17dec06b7cac4025317daef68c302c61d4e6 Author: Mattias Engdegård Date: Fri Oct 7 11:43:19 2022 +0200 Clearer byte-compiler arity warnings (bug#58319) * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-signature-string): Replace '3+' and '3-4' with '3 or more' and '3 or 4', respectively. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 03c45e44a5..74ba8984f2 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1469,9 +1469,11 @@ when printing the error message." (defun byte-compile-arglist-signature-string (signature) (cond ((null (cdr signature)) - (format "%d+" (car signature))) + (format "%d or more" (car signature))) ((= (car signature) (cdr signature)) (format "%d" (car signature))) + ((= (1+ (car signature)) (cdr signature)) + (format "%d or %d" (car signature) (cdr signature))) (t (format "%d-%d" (car signature) (cdr signature))))) (defun byte-compile-function-warn (f nargs def) commit e84b732cbc54d5ba66e0b6f824edccb2bcb18668 Author: Miha Rihtaršič Date: Thu Oct 6 20:22:39 2022 +0200 comint-fontify-input: Don't fontify output as input, different approach * lisp/comint.el (comint-output-filter): Propertize process output with field=output before inserting it into buffer to prevent comint-fontify-input from fontifying it (bug#58169). diff --git a/lisp/comint.el b/lisp/comint.el index e3eee8411c..07ced8d321 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2147,6 +2147,12 @@ Make backspaces delete the previous character." (goto-char (process-mark process)) (set-marker comint-last-output-start (point)) + ;; Before we call `comint--mark-as-output' later, + ;; redisplay can be called. We mark the inserted text as + ;; output early, to prevent redisplay from fontifying it + ;; as input in case of `comint-fontify-input-mode'. + (put-text-property 0 (length string) 'field 'output string) + ;; insert-before-markers is a bad thing. XXX ;; Luckily we don't have to use it any more, we use ;; window-point-insertion-type instead. commit 46c2f152c255198d91fa7404e5518feeecd215b2 Author: Miha Rihtaršič Date: Thu Oct 6 19:06:37 2022 +0200 Revert "comint-fl: Prevent fontification of output as input" This reverts commit 90744ff0be581b69cedea1194b7e78265bdb67a4. diff --git a/lisp/comint.el b/lisp/comint.el index b1f3ad8259..e3eee8411c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2150,26 +2150,24 @@ Make backspaces delete the previous character." ;; insert-before-markers is a bad thing. XXX ;; Luckily we don't have to use it any more, we use ;; window-point-insertion-type instead. - (make-local-variable 'jit-lock-mode) - (let ((jit-lock-mode nil)) - (insert string) + (insert string) - ;; Advance process-mark - (set-marker (process-mark process) (point)) + ;; Advance process-mark + (set-marker (process-mark process) (point)) - (unless comint-inhibit-carriage-motion + (unless comint-inhibit-carriage-motion ;; Interpret any carriage motion characters (newline, backspace) (comint-carriage-motion comint-last-output-start (point))) - ;; Run these hooks with point where the user had it. - (goto-char saved-point) - (run-hook-with-args 'comint-output-filter-functions string) - (set-marker saved-point (point)) + ;; Run these hooks with point where the user had it. + (goto-char saved-point) + (run-hook-with-args 'comint-output-filter-functions string) + (set-marker saved-point (point)) - (goto-char (process-mark process)) ; In case a filter moved it. + (goto-char (process-mark process)) ; In case a filter moved it. - (unless comint-use-prompt-regexp - (comint--mark-as-output comint-last-output-start (point)))) + (unless comint-use-prompt-regexp + (comint--mark-as-output comint-last-output-start (point))) ;; Highlight the prompt, where we define `prompt' to mean ;; the most recent output that doesn't end with a newline. commit 17d0f61c808c3d288de246518c1ed73e64e94b1d Author: Michael Albinus Date: Fri Oct 7 13:14:46 2022 +0200 * lisp/dired.el (dired-make-relative): Make change less aggressive. diff --git a/lisp/dired.el b/lisp/dired.el index f9a7743139..85a7131570 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2953,7 +2953,11 @@ Optional arg GLOBAL means to replace all matches." If DIR is omitted or nil, it defaults to `default-directory'. If FILE is not in the directory tree of DIR, return FILE unchanged." - (setq dir (expand-file-name (or dir default-directory))) + (or dir (setq dir default-directory)) + ;; This case comes into play if default-directory is set to + ;; use ~. + (if (string-match-p "\\(\\`\\|:\\)~" dir) + (setq dir (expand-file-name dir))) (if (string-match (concat "^" (regexp-quote dir)) file) (substring file (match-end 0)) file)) commit 6edb676c181d1b49a4f1b7c90fc093cc37569424 Author: Po Lu Date: Fri Oct 7 18:39:17 2022 +0800 Handle IM server disconnects during preedit * src/xterm.c (x_maybe_clear_preedit): New function. (xim_destroy_callback): Call that function. diff --git a/src/xterm.c b/src/xterm.c index 1d58e80f00..cdf99f278a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -25511,6 +25511,39 @@ x_new_font (struct frame *f, Lisp_Object font_object, int fontset) #ifdef HAVE_X11R6 +/* If preedit text is set on F, cancel preedit, free the text, and + generate the appropriate events to cancel the preedit display. + + This is mainly useful when the connection to the IM server is + dropped during preconversion. */ + +static void +x_maybe_clear_preedit (struct frame *f) +{ + struct x_output *output; + struct input_event ie; + + output = FRAME_X_OUTPUT (f); + + if (!output->preedit_chars) + return; + + EVENT_INIT (ie); + ie.kind = PREEDIT_TEXT_EVENT; + ie.arg = Qnil; + XSETFRAME (ie.frame_or_window, f); + XSETINT (ie.x, 0); + XSETINT (ie.y, 0); + kbd_buffer_store_event (&ie); + + xfree (output->preedit_chars); + + output->preedit_size = 0; + output->preedit_active = false; + output->preedit_chars = NULL; + output->preedit_caret = 0; +} + /* XIM destroy callback function, which is called whenever the connection to input method XIM dies. CLIENT_DATA contains a pointer to the x_display_info structure corresponding to XIM. */ @@ -25531,6 +25564,9 @@ xim_destroy_callback (XIM xim, XPointer client_data, XPointer call_data) { FRAME_XIC (f) = NULL; xic_free_xfontset (f); + + /* Free the preedit text if necessary. */ + x_maybe_clear_preedit (f); } } commit 6c956de80a7dadcb9d929c9a59b852b27fe83f2b Author: Stefan Kangas Date: Fri Oct 7 11:20:37 2022 +0200 Improve package-check-signature docstring * lisp/emacs-lisp/package.el (package-check-signature): Improve docstring. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 812e1eb0ff..4268f7d27a 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -346,21 +346,28 @@ default directory." (defcustom package-check-signature 'allow-unsigned "Non-nil means to check package signatures when installing. -More specifically the value can be: -- nil: package signatures are ignored. -- `allow-unsigned': install a package even if it is unsigned, but - if it is signed, we have the key for it, and OpenGPG is - installed, verify the signature. -- t: accept a package only if it comes with at least one verified signature. -- `all': same as t, except when the package has several signatures, - in which case we verify all the signatures. This also applies to the \"archive-contents\" file that lists the -contents of the archive." +contents of the archive. + +The value can be one of: + + t Accept a package only if it comes with at least + one verified signature. + + `all' Same as t, but verify all signatures if there + are more than one. + + `allow-unsigned' Install a package even if it is unsigned, + but verify the signature if possible (that + is, if it is signed, we have the key for it, + and GnuPG is installed). + + nil Package signatures are ignored." :type '(choice (const :value nil :tag "Never") (const :value allow-unsigned :tag "Allow unsigned") (const :value t :tag "Check always") - (const :value all :tag "Check all signatures")) + (const :value all :tag "Check always (all signatures)")) :risky t :version "27.1") commit 55bd6a5cd4398ae425408518a14c90083e917757 Author: Stefan Kangas Date: Fri Oct 7 10:53:55 2022 +0200 ; Make wallpaper--format-arg more resilient * lisp/image/wallpaper.el (wallpaper--format-arg): Make more resilient to errors. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index e23b65d616..ab3df437d9 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -440,9 +440,10 @@ FILE is the image file name." (format-spec format `((?f . ,(expand-file-name file)) - (?F . ,(mapconcat #'url-hexify-string - (file-name-split file) - "/")) + (?F . ,(lambda () + (mapconcat #'url-hexify-string + (file-name-split file) + "/"))) (?h . ,(lambda () (wallpaper--get-height-or-width "height" @@ -454,22 +455,25 @@ FILE is the image file name." #'display-pixel-width wallpaper-default-width))) ;; screen number - (?S . ,(let ((display (frame-parameter (selected-frame) 'display))) - (if (and display - (string-match (rx ":" (+ (in "0-9")) "." - (group (+ (in "0-9"))) eos) - display)) - (match-string 1 display) - "0"))) + (?S . ,(lambda () + (let ((display (frame-parameter (selected-frame) 'display))) + (if (and display + (string-match (rx ":" (+ (in "0-9")) "." + (group (+ (in "0-9"))) eos) + display)) + (match-string 1 display) + "0")))) ;; monitor name (?M . ,#'wallpaper--x-monitor-name) ;; workspace - (?W . ,(or (and (fboundp 'x-window-property) - (display-graphic-p) - (number-to-string - (or (x-window-property "_NET_CURRENT_DESKTOP" nil "CARDINAL" 0 nil t) - (x-window-property "WIN_WORKSPACE" nil "CARDINAL" 0 nil t)))) - "0"))))) + (?W . ,(lambda () + (or (and (fboundp 'x-window-property) + (display-graphic-p) + (number-to-string + (or (x-window-property "_NET_CURRENT_DESKTOP" nil "CARDINAL" 0 nil t) + (x-window-property "WIN_WORKSPACE" nil "CARDINAL" 0 nil t) + 0))) + "0")))))) (defun wallpaper-default-set-function (file) "Set the wallpaper to FILE using a command.