commit 2823eae0b7cb3bd3f2472fde9e13016a8d406a9a (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Sun Apr 14 10:36:50 2024 +0800 Remove leftover tasks from previous Emacs sessions on startup * java/org/gnu/emacs/EmacsService.java (onCreate): Call removeOldTasks. * java/org/gnu/emacs/EmacsWindowManager.java (removeOldTasks): New function. * java/proguard.conf: Optimize optimizer configuration. diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index b8ff98e79a7..fd052653087 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -234,6 +234,8 @@ public final class EmacsService extends Service final double scaledDensity; double tempScaledDensity; + super.onCreate (); + SERVICE = this; handler = new Handler (Looper.getMainLooper ()); manager = getAssets (); @@ -247,9 +249,9 @@ public final class EmacsService extends Service resolver = getContentResolver (); mainThread = Thread.currentThread (); - /* If the density used to compute the text size is lesser than - 160, there's likely a bug with display density computation. - Reset it to 160 in that case. + /* If the density used to compute the text size is smaller than 160, + there's likely a bug with display density computation. Reset it + to 160 in that case. Note that Android uses 160 ``dpi'' as the density where 1 point corresponds to 1 pixel, not 72 or 96 as used elsewhere. This @@ -262,6 +264,10 @@ public final class EmacsService extends Service the nested function below. */ scaledDensity = tempScaledDensity; + /* Remove all tasks from previous Emacs sessions but the task + created by the system at startup. */ + EmacsWindowManager.MANAGER.removeOldTasks (this); + try { /* Configure Emacs with the asset manager and other necessary diff --git a/java/org/gnu/emacs/EmacsWindowManager.java b/java/org/gnu/emacs/EmacsWindowManager.java index a193d49d0ec..49f0ebd5841 100644 --- a/java/org/gnu/emacs/EmacsWindowManager.java +++ b/java/org/gnu/emacs/EmacsWindowManager.java @@ -27,6 +27,7 @@ import android.app.ActivityManager; import android.app.ActivityOptions; +import android.content.ComponentName; import android.content.Context; import android.content.Intent; @@ -385,4 +386,44 @@ && isWindowEligible (consumer, window)) window.onActivityDetached (); } } + + /* Iterate over each of Emacs's tasks to delete such as belong to a + previous Emacs session, i.e., tasks created for a previous + session's non-initial frames. CONTEXT should be a context from + which to obtain a reference to the activity manager. */ + + public void + removeOldTasks (Context context) + { + List appTasks; + RecentTaskInfo info; + ComponentName name; + String target; + Object object; + + if (Build.VERSION.SDK_INT < Build.VERSION_CODES.LOLLIPOP) + return; + + if (activityManager == null) + { + object = context.getSystemService (Context.ACTIVITY_SERVICE); + activityManager = (ActivityManager) object; + } + + appTasks = activityManager.getAppTasks (); + target = ".EmacsMultitaskActivity"; + + for (AppTask task : appTasks) + { + info = task.getTaskInfo (); + + /* Test whether info is a reference to + EmacsMultitaskActivity. */ + if (info.baseIntent != null + && (name = info.baseIntent.getComponent ()) != null + && name.getShortClassName ().equals (target)) + /* Delete the task. */ + task.finishAndRemoveTask (); + } + } }; diff --git a/java/proguard.conf b/java/proguard.conf index e6b08f76fe4..5da402946bb 100644 --- a/java/proguard.conf +++ b/java/proguard.conf @@ -20,22 +20,22 @@ # The effect of the following lines is to inhibit the removal of variable or # method symbol names from symbols referenced from C. --keep,allowoptimization class org.gnu.emacs.EmacsClipboard { ; } --keep,allowoptimization class org.gnu.emacs.EmacsContextMenu { ; } --keep,allowoptimization class org.gnu.emacs.EmacsCursor { ; } --keep,allowoptimization class org.gnu.emacs.EmacsDesktopNotification { ; } --keep,allowoptimization class org.gnu.emacs.EmacsDialog { ; } --keep,allowoptimization class org.gnu.emacs.EmacsDirectoryEntry { ; } --keep,allowoptimization class org.gnu.emacs.EmacsFontDriver { ; } --keep,allowoptimization class org.gnu.emacs.EmacsFontDriver$* { ; } --keep,allowoptimization class org.gnu.emacs.EmacsGC { ; ; } --keep,allowoptimization class org.gnu.emacs.EmacsHandleObject { ; } --keep,allowoptimization class org.gnu.emacs.EmacsPixmap { ; } --keep,allowoptimization class org.gnu.emacs.EmacsService { ; } --keep,allowoptimization class org.gnu.emacs.EmacsWindow { ; } --keep,allowoptimization class org.gnu.emacs.EmacsNative { ; } --keep,allowoptimization class org.gnu.emacs.EmacsNoninteractive { ; } --keep,allowoptimization interface org.gnu.emacs.EmacsDrawable { ; } +-keep,allowoptimization class org.gnu.emacs.EmacsClipboard { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsContextMenu { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsCursor { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsDesktopNotification { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsDialog { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsDirectoryEntry { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsFontDriver { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsFontDriver$* { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsGC { public ; public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsHandleObject { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsPixmap { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsService { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsWindow { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsNative { public ; } +-keep,allowoptimization class org.gnu.emacs.EmacsNoninteractive { public ; } +-keep,allowoptimization interface org.gnu.emacs.EmacsDrawable { public ; } # And these lines inhibit the deletion of symbols that are referenced by # the operating system while enabling the compiler to minify or delete commit 845246093f8ae88db1061a9beaff04184685f8f4 Author: Arash Esbati Date: Sat Apr 13 22:31:25 2024 +0200 Recognize multicite macros from biblatex * lisp/textmodes/reftex-cite.el (reftex-all-used-citation-keys): Match the citation keys used with multicite macros provided by biblatex. (bug#38249) * test/lisp/textmodes/reftex-tests.el (reftex-all-used-citation-keys): Adjust test accordingly. diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index f7b155874de..34f40ba689f 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -1144,8 +1144,6 @@ recommended for follow mode. It works OK for individual lookups." (defun reftex-all-used-citation-keys () "Return a list of all citation keys used in document." (reftex-access-scan-info) - ;; FIXME: multicites macros provided by biblatex - ;; are not covered in this function. (let ((files (reftex-all-document-files)) (re (concat "\\\\" "\\(?:" @@ -1170,6 +1168,25 @@ recommended for follow mode. It works OK for individual lookups." "\\)" ;; Now match the key: "{\\([^}]+\\)}")) + ;; Multicites: Match \MACRONAME(Global Pre)(Global Post) + (re2 (concat "\\\\" + (regexp-opt '("cites" "Cites" + "parencites" "Parencites" + "footcites" "footcitetexts" + "smartcites" "Smartcites" + "textcites" "Textcites" + "supercites" + "autocites" "Autocites" + "volcites" "Volcites" + "pvolcites" "Pvolcites" + "fvolcites" "Fvolcites" + "svolcites" "Svolcites" + "tvolcites" "Tvolcites" + "avolcites" "Avolcites")) + "\\(?:([^)]*)\\)\\{0,2\\}")) + ;; For each key in list [prenote][postnote]{key} + (re3 (concat "\\(?:\\[[^]]*\\]\\)\\{0,2\\}" + "{\\([^}]+\\)}")) file keys kk k) (save-current-buffer (while (setq file (pop files)) @@ -1188,7 +1205,29 @@ recommended for follow mode. It works OK for individual lookups." (setq kk (split-string kk "[, \t\r\n]+")) (while (setq k (pop kk)) (or (member k keys) - (setq keys (cons k keys)))))))))) + (setq keys (cons k keys)))))) + ;; And now search for citation lists: + (goto-char (point-min)) + (while (re-search-forward re2 nil t) + ;; Make sure we're not inside a comment: + (unless (save-match-data + (nth 4 (syntax-ppss))) + (while (progn + ;; Ignore the value of + ;; `reftex-allow-detached-macro-args' since we + ;; expect a bigger number of args and detaching + ;; them seems natural for line breaks: + (while (looking-at "[ \t\r\n]+\\|%.*\n") + (goto-char (match-end 0))) + (and (looking-at re3) + (goto-char (match-end 0)))) + (setq kk (match-string-no-properties 1)) + (while (string-match "%.*\n?" kk) + (setq kk (replace-match "" t t kk))) + (setq kk (split-string kk "[, \t\r\n]+")) + (while (setq k (pop kk)) + (or (member k keys) + (setq keys (cons k keys))))))))))) (reftex-kill-temporary-buffers) keys)) diff --git a/test/lisp/textmodes/reftex-tests.el b/test/lisp/textmodes/reftex-tests.el index 7f7c99a40a4..456ee458865 100644 --- a/test/lisp/textmodes/reftex-tests.el +++ b/test/lisp/textmodes/reftex-tests.el @@ -285,6 +285,20 @@ Natbib compatibility commands: \\Citep[pre][pos]{Citep:2022} \\Citep*[pre][pos]{Citep*:2022} +Qualified Citation Lists: +\\cites(Global Prenote)(Global Postnote)[pre][post]{cites:1}[pre][post]{cites:2} +\\Cites(Global Prenote)(Global Postnote)[pre][post]{Cites:1}[pre][post]{Cites:2} +\\parencites(Global Prenote)(Global Postnote)[pre][post]{parencites:1} + [pre][post]{parencites:2} +\\Parencites(Global Prenote)(Global Postnote)[pre][post]{Parencites:1}{Parencites:2} +\\footcites[pre][post]{footcites:1}[pre][post]{footcites:2} +\\footcitetexts{footcitetexts:1}{footcitetexts:2} +\\smartcites{smartcites:1} +% This is comment about \\smartcites{smartcites:2} +[pre][post]{smartcites:2} +% And this should be ignored \\smartcites{smartcites:3}{smartcites:4} + + Test for bug#56655: There was a few \\% of increase in budget \\Citep*{bug:56655}. @@ -331,6 +345,14 @@ And this should be % \\cite{ignored}. "citealp:2022" "citealp*:2022" "Citet:2022" "Citet*:2022" "Citep:2022" "Citep*:2022" + ;; Qualified Citation Lists + "cites:1" "cites:2" + "Cites:1" "Cites:2" + "parencites:1" "parencites:2" + "Parencites:1" "Parencites:2" + "footcites:1" "footcites:2" + "footcitetexts:1" "footcitetexts:2" + "smartcites:1" "smartcites:2" "bug:56655") #'string<))) (kill-buffer (file-name-nondirectory tex-file))))) commit 7b94c6b00b287d2b69d466380a05de7e0ec21ee9 Author: Stefan Monnier Date: Sat Apr 13 15:35:46 2024 -0400 peg-tests.el: Fix test failures * lisp/progmodes/peg.el (peg-parse): Refine heuristic since unknown terminals are resolved at run-time rather than compile-time now. (peg--macroexpand) : Avoid generating a `let` with an empty body. (peg--translate-rule-body): Adjust to name change of `macroexp-warn-and-return` and the fact that it's always available. * test/lisp/progmodes/peg-tests.el (peg-parse-string): Add `indent` declaration. (peg-test): Check that the compiler emits the warnings we expect. diff --git a/lisp/progmodes/peg.el b/lisp/progmodes/peg.el index 2eb4a7384d0..bb57650d883 100644 --- a/lisp/progmodes/peg.el +++ b/lisp/progmodes/peg.el @@ -1,6 +1,6 @@ ;;; peg.el --- Parsing Expression Grammars in Emacs Lisp -*- lexical-binding:t -*- -;; Copyright (C) 2008-2023 Free Software Foundation, Inc. +;; Copyright (C) 2008-2024 Free Software Foundation, Inc. ;; ;; Author: Helmut Eller ;; Maintainer: Stefan Monnier @@ -320,7 +320,8 @@ moving point along the way. PEXS can also be a list of PEG rules, in which case the first rule is used." (if (and (consp (car pexs)) (symbolp (caar pexs)) - (not (ignore-errors (peg-normalize (car pexs))))) + (not (ignore-errors + (not (eq 'call (car (peg-normalize (car pexs)))))))) ;; `pexs' is a list of rules: use the first rule as entry point. `(with-peg-rules ,pexs (peg-run (peg ,(caar pexs)) #'peg-signal-failure)) `(peg-run (peg ,@pexs) #'peg-signal-failure))) @@ -544,7 +545,8 @@ rulesets defined previously with `define-peg-ruleset'." (let ((args (cdr (member '-- (reverse form)))) (values (cdr (member '-- form)))) (let ((form `(let ,(mapcar (lambda (var) `(,var (pop peg--stack))) args) - ,@(mapcar (lambda (val) `(push ,val peg--stack)) values)))) + ,@(or (mapcar (lambda (val) `(push ,val peg--stack)) values) + '(nil))))) `(action ,form)))) (defvar peg-char-classes @@ -642,11 +644,7 @@ rulesets defined previously with `define-peg-ruleset'." (code (peg-translate-exp exp))) (cond ((null msg) code) - ((fboundp 'macroexp--warn-and-return) - (macroexp--warn-and-return msg code)) - (t - (message "%s" msg) - code)))) + (t (macroexp-warn-and-return msg code))))) ;; This is the main translation function. (defun peg-translate-exp (exp) diff --git a/test/lisp/progmodes/peg-tests.el b/test/lisp/progmodes/peg-tests.el index 864e09b4200..e666e6f19d2 100644 --- a/test/lisp/progmodes/peg-tests.el +++ b/test/lisp/progmodes/peg-tests.el @@ -1,6 +1,6 @@ ;;; peg-tests.el --- Tests of PEG parsers -*- lexical-binding: t; -*- -;; Copyright (C) 2008-2023 Free Software Foundation, Inc. +;; Copyright (C) 2008-2024 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -30,6 +30,7 @@ "Parse STRING according to PEX. If NOERROR is non-nil, push nil resp. t if the parse failed resp. succeeded instead of signaling an error." + (declare (indent 1)) (let ((oldstyle (consp (car-safe pex)))) ;PEX is really a list of rules. `(with-temp-buffer (insert ,string) @@ -105,15 +106,33 @@ resp. succeeded instead of signaling an error." (substring [0-9])))) "ab0cd1ef2gh") '("2"))) - ;; The PEG rule `other' doesn't exist, which will cause a byte-compiler + ;; The PEG rule `doesntexist' doesn't exist, which will cause a byte-compiler ;; warning, but not an error at run time because the rule is not actually ;; used in this particular case. - (should (equal (peg-parse-string ((s (substring (or "a" other))) - ;; Unused left-recursive rule, should - ;; cause a byte-compiler warning. - (r (* "a") r)) - "af") - '("a"))) + (let* ((testfun '(lambda () + (peg-parse-string ((s (substring (or "a" doesntexist))) + ;; Unused left-recursive rule, should + ;; cause a byte-compiler warning. + (r (* "a") r)) + "af"))) + (compiledfun + (progn + (with-current-buffer (get-buffer-create "*Compile-Log*") + (let ((inhibit-read-only t)) (erase-buffer))) + (let ((lexical-binding t)) (byte-compile testfun))))) + (with-current-buffer (get-buffer-create "*Compile-Log*") + (goto-char (point-min)) + (should + ;; FIXME: The byte-compiler emits "not known to be defined" + ;; warnings when compiling a file but not from `byte-compile'. + ;; Instead, we have to dig it out of the mess it leaves behind. 🙂 + (or (assq 'peg-rule\ doesntexist byte-compile-unresolved-functions) + (should (re-search-forward + "peg-rule.? doesntexist.*not known to be defined" nil t)))) + (goto-char (point-min)) + (should (re-search-forward "left recursion.*r -> r" nil t))) + + (should (equal (funcall compiledfun) '("a")))) (should (equal (peg-parse-string ((s (list x y)) (x `(-- 1)) (y `(-- 2))) commit 17e26cf57e18c5df2172a7049591d89fc53b3fb6 Author: Stefan Monnier Date: Sat Apr 13 10:31:28 2024 -0400 (define-globalized-minor-mode): Require the use of `run-mode-hooks` When `define-globalized-minor-mode` was introduced (Emacs-22), `run-mode-hooks` was brand new, so we could not expect all major modes to use it and we had to rely on brittle workarounds to try and approximate `after-change-major-mode-hook`. These workarounds have undesirable side effects, and (we hope) they're not needed any more now that virtually all major modes have been changed to use `run-mode-hooks` (or `define-derived-mode`). * lisp/emacs-lisp/easy-mmode.el (define-globalized-minor-mode): Rely only on `after-change-major-mode-hook`, remove the "cmhh" [typo for the intended "cmmh", BTW] workaround. * doc/lispref/modes.texi (Mode Hooks): Clarify the importance of `after-change-major-mode-hook` w.r.t `define-globalized-minor-mode`. (Defining Minor Modes): Rewrite the explanation of which buffers are affected, including adjusting it to the fact that `fundamental-mode` has used run `run-mode-hooks` for last 10 years. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index b034fecd77b..ffede9e86f5 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1109,7 +1109,10 @@ Versions before 24 did not have @code{change-major-mode-after-body-hook}. When user-implemented major modes do not use @code{run-mode-hooks} and have not been updated to use these newer features, they won't entirely follow these conventions: they may run the parent's mode hook too early, -or fail to run @code{after-change-major-mode-hook}. If you encounter +or fail to run @code{after-change-major-mode-hook}. This will +have undesirable effects such as preventing minor modes defined +with @code{define-globalized-minor-mode} from being enabled in +buffers using these major modes. If you encounter such a major mode, please correct it to follow these conventions. When you define a major mode using @code{define-derived-mode}, it @@ -1985,10 +1988,10 @@ turn on the minor mode in a buffer, it uses the function function so it could determine whether to enable the minor mode or not when it is not a priori clear that it should always be enabled.) -Globally enabling the mode also affects buffers subsequently created -by visiting files, and buffers that use a major mode other than -Fundamental mode; but it does not detect the creation of a new buffer -in Fundamental mode. +Globally enabling the mode affects only those buffers subsequently +created that use a major mode which follows the convention to run +@code{run-mode-hooks}. The minor mode will not be enabled in those +major modes which fail to follow this convention. This macro defines the customization option @var{global-mode} (@pxref{Customization}), which can be toggled via the Customize diff --git a/etc/NEWS b/etc/NEWS index 933ca15b39c..7a73815179c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1680,6 +1680,14 @@ documentation and examples. * Incompatible Lisp Changes in Emacs 30.1 ++++ +** 'define-globalized-minor-mode' requires that modes use 'run-mode-hooks'. +Minor modes defined with 'define-globalized-minor-mode', such as +'global-font-lock-mode', will not be enabled any more in those buffers +whose major modes fails to use 'run-mode-hooks'. Major modes defined +with 'define-derived-mode' are not affected. `run-mode-hooks` has been the +recommended way to run major mode hooks since Emacs-22. + --- ** Old derived.el functions removed. The following functions have been deleted because they were only used diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index b09466d79fc..eaad9646985 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -495,11 +495,6 @@ on if the hook has explicitly disabled it. (MODE-buffers (intern (concat global-mode-name "-buffers"))) (MODE-enable-in-buffer (intern (concat global-mode-name "-enable-in-buffer"))) - (MODE-enable-in-buffers - (intern (concat global-mode-name "-enable-in-buffers"))) - (MODE-check-buffers - (intern (concat global-mode-name "-check-buffers"))) - (MODE-cmhh (intern (concat global-mode-name "-cmhh"))) (minor-MODE-hook (intern (concat mode-name "-hook"))) (MODE-set-explicitly (intern (concat mode-name "-set-explicitly"))) (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode"))) @@ -559,14 +554,9 @@ Disable the mode if ARG is a negative number.\n\n" ;; Setup hook to handle future mode changes and new buffers. (if ,global-mode - (progn - (add-hook 'after-change-major-mode-hook - #',MODE-enable-in-buffer) - (add-hook 'find-file-hook #',MODE-check-buffers) - (add-hook 'change-major-mode-hook #',MODE-cmhh)) - (remove-hook 'after-change-major-mode-hook #',MODE-enable-in-buffer) - (remove-hook 'find-file-hook #',MODE-check-buffers) - (remove-hook 'change-major-mode-hook #',MODE-cmhh)) + (add-hook 'after-change-major-mode-hook + #',MODE-enable-in-buffer) + (remove-hook 'after-change-major-mode-hook #',MODE-enable-in-buffer)) ;; Go through existing buffers. (dolist (buf (buffer-list)) @@ -623,51 +613,7 @@ list." (funcall ,turn-on-function)) (funcall ,turn-on-function)))) (setq ,MODE-major-mode major-mode)) - (put ',MODE-enable-in-buffer 'definition-name ',global-mode) - - ;; In the normal case, major modes run `after-change-major-mode-hook' - ;; which will have called `MODE-enable-in-buffer' for us. But some - ;; major modes don't use `run-mode-hooks' (customarily used via - ;; `define-derived-mode') and thus fail to run - ;; `after-change-major-mode-hook'. - ;; The functions below try to handle those major modes, with - ;; a combination of ugly hacks to try and catch those corner - ;; cases by listening to `change-major-mode-hook' to discover - ;; potential candidates and then checking in `post-command-hook' - ;; and `find-file-hook' if some of those still haven't run - ;; `after-change-major-mode-hook'. FIXME: We should try and get - ;; rid of this ugly hack and rely purely on - ;; `after-change-major-mode-hook' because they can (and do) end - ;; up running `MODE-enable-in-buffer' too early (when the major - ;; isn't yet fully setup) in some cases (see bug#58888). - - ;; The function that calls TURN-ON in each buffer. - (defun ,MODE-enable-in-buffers () - (let ((buffers ,MODE-buffers)) - ;; Clear MODE-buffers to avoid scanning the same list of - ;; buffers in recursive calls to MODE-enable-in-buffers. - ;; Otherwise it could lead to infinite recursion. - (setq ,MODE-buffers nil) - (dolist (buf buffers) - (when (buffer-live-p buf) - (with-current-buffer buf - (,MODE-enable-in-buffer)))))) - (put ',MODE-enable-in-buffers 'definition-name ',global-mode) - - (defun ,MODE-check-buffers () - (,MODE-enable-in-buffers) - (remove-hook 'post-command-hook #',MODE-check-buffers)) - (put ',MODE-check-buffers 'definition-name ',global-mode) - - ;; The function that catches kill-all-local-variables. - (defun ,MODE-cmhh () - ;; If `delay-mode-hooks' is set, it indicates that the current - ;; buffer's mode will run `run-mode-hooks' afterwards anyway, - ;; so we don't need to keep this buffer in MODE-buffers. - (unless delay-mode-hooks - (add-to-list ',MODE-buffers (current-buffer)) - (add-hook 'post-command-hook #',MODE-check-buffers))) - (put ',MODE-cmhh 'definition-name ',global-mode)))) + (put ',MODE-enable-in-buffer 'definition-name ',global-mode)))) (defun easy-mmode--globalized-predicate-p (predicate) (cond commit 3f7e26e2bed4ee7adab3a5d2bfa289517499e4c8 Author: Stefan Monnier Date: Sat Apr 13 10:10:19 2024 -0400 (define-globalized-minor-mode): Fix bug#58888 * lisp/emacs-lisp/easy-mmode.el (define-globalized-minor-mode) : Try and detect well-behaved modes so they're not affected by those which require the cmhh hack. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 095bd5faa03..b09466d79fc 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -661,8 +661,12 @@ list." ;; The function that catches kill-all-local-variables. (defun ,MODE-cmhh () - (add-to-list ',MODE-buffers (current-buffer)) - (add-hook 'post-command-hook #',MODE-check-buffers)) + ;; If `delay-mode-hooks' is set, it indicates that the current + ;; buffer's mode will run `run-mode-hooks' afterwards anyway, + ;; so we don't need to keep this buffer in MODE-buffers. + (unless delay-mode-hooks + (add-to-list ',MODE-buffers (current-buffer)) + (add-hook 'post-command-hook #',MODE-check-buffers))) (put ',MODE-cmhh 'definition-name ',global-mode)))) (defun easy-mmode--globalized-predicate-p (predicate) commit d67e08d6c3f9a00b824c827247a7de3d08ccad39 Merge: f950621e6a1 d7a83e23d47 Author: Stefan Monnier Date: Sat Apr 13 09:44:12 2024 -0400 Merge branch 'track-changes' commit d7a83e23d47ca9e3e6ca70078e956e31301e5e6d Author: Stefan Monnier Date: Fri Apr 5 17:37:32 2024 -0400 lisp/emacs-lisp/track-changes.el: New file (bug#70077) This new package provides an API that is easier to use right than our `*-change-functions` hooks. The patch includes changes to `diff-mode.el` and `eglot.el` to make use of this new package. * lisp/emacs-lisp/track-changes.el: New file. * test/lisp/emacs-lisp/track-changes-tests.el: New file. * doc/lispref/text.texi (Tracking changes): New subsection. * lisp/progmodes/eglot.el: Require `track-changes`. (eglot--virtual-pos-to-lsp-position): New function. (eglot--track-changes): New var. (eglot--managed-mode): Use `track-changes-register` i.s.o `after/before-change-functions` when available. (eglot--track-changes-signal): New function, partly extracted from `eglot--after-change`. (eglot--after-change): Use it. (eglot--track-changes-fetch): New function. (eglot--signal-textDocument/didChange): Use it. * lisp/vc/diff-mode.el: Require `track-changes`. Also require `easy-mmode` before the `eval-when-compile`s. (diff-unhandled-changes): Delete variable. (diff-after-change-function): Delete function. (diff--track-changes-function): Rename from `diff-post-command-hook` and adjust to new calling convention. (diff--track-changes): New variable. (diff--track-changes-signal): New function. (diff-mode, diff-minor-mode): Use it with `track-changes-register`. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 18f0ee88fe5..8774801f41f 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -6375,3 +6375,151 @@ hooks during a series of changes (typically for performance reasons), use @code{combine-change-calls} or @code{combine-after-change-calls} instead. @end defvar + +@node Tracking changes +@subsection Tracking changes +@cindex track-changes +@cindex change tracker + +Using @code{before-change-functions} and @code{after-change-functions} +can be difficult in practice because of a number of pitfalls, such as +the fact that the two calls are not always properly paired, or some +calls may be missing, either because some Emacs primitives failed to +properly pair them or because of incorrect use of +@code{inhibit-modification-hooks}. Furthermore, +many restrictions apply to those hook functions, such as the fact that +they basically should never modify the current buffer, nor use an +operation that may block, and they proceed quickly because +some commands may call these hooks a large number of times. + +The Track-Changes library fundamentally provides an alternative API, +built on top of those hooks. Compared to @code{after-change-functions}, +the first important difference is that, instead of providing the bounds +of the change and the previous length, it provides the bounds of the +change and the actual previous content of that region. The need to +extract information from the original contents of the buffer is one of +the main reasons why some packages need to use both +@code{before-change-functions} and @code{after-change-functions} and +then try to match them up. + +The second difference is that it decouples the notification of a change +from the act of processing it, and it automatically combines into +a single change operation all the changes that occur between the first +change and the actual processing. This makes it natural and easy to +process the changes at a larger granularity, such as once per command, +and eliminates most of the restrictions that apply to the usual change +hook functions, making it possible to use blocking operations or to +modify the buffer. + +To start tracking changes, you have to call +@code{track-changes-register}, passing it a @var{signal} function as +argument. This returns a tracker @var{id} which is used to identify +your change tracker to the other functions of the library. +When the buffer is modified, the library calls the @var{signal} +function to inform you of that change and immediately starts +accumulating subsequent changes into a single combined change. +The @var{signal} function serves only to warn that a modification +occurred but does not receive a description of the change. Also the +library will not call it again until after you retrieved the change. + +To retrieve changes, you need to call @code{track-changes-fetch}, which +provides you with the bounds of the changes accumulated since the +last call, as well as the previous content of that region. It also +``re-arms'' the @var{signal} function so that the library will call it +again after the next buffer modification. + +@defun track-changes-register signal &key nobefore disjoint immediate +This function creates a new @dfn{change tracker}. Change trackers are kept +abstract, so we refer to them as mere identities, and the function thus +returns the tracker's @var{id}. + +@var{signal} is a function that the library will call to notify of +a change. It will sometimes call it with a single argument and +sometimes with two. Upon the first change to the buffer since this +tracker last called @code{track-changes-fetch}, the library calls this +@var{signal} function with a single argument holding the @var{id} of +the tracker. + +By default, the call to the @var{signal} function does not happen +immediately, but is instead postponed with a 0 seconds timer +(@pxref{Timers}). This is usually desired to make sure the @var{signal} +function is not called too frequently and runs in a permissive context, +freeing the client from performance concerns or worries about which +operations might be problematic. If a client wants to have more +control, they can provide a non-@code{nil} value as the @var{immediate} +argument in which case the library calls the @var{signal} function +directly from @code{after-change-functions}. Beware that it means that +the @var{signal} function has to be careful not to modify the buffer or +use operations that may block. + +If you're not interested in the actual previous content of the buffer, +but are using this library only for its ability to combine many small +changes into a larger one and to delay the processing to a more +convenient time, you can specify a non-@code{nil} value for the +@var{nobefore} argument. In that case, @code{track-change-fetch} +provides you only with the length of the previous content, just like +@code{after-change-functions}. It also allows the library to save +some work. + +While you may like to accumulate many small changes into larger ones, +you may not want to do that if the changes are too far apart. If you +specify a non-@code{nil} value for the @var{disjoint} argument, the library +will let you know when a change is about to occur ``far'' from the +currently pending ones by calling the @var{signal} function right away, +passing it two arguments this time: the @var{id} of the tracker, and the +number of characters that separates the upcoming change from the +already pending changes. This in itself does not prevent combining this +new change with the previous ones, so if you think the upcoming change +is indeed too far, you need to call @code{track-change-fetch} +right away. +Beware that when the @var{signal} function is called because of +a disjoint change, this happens directly from +@code{before-change-functions}, so the usual restrictions apply about +modifying the buffer or using operations that may block. +@end defun + +@defun track-changes-fetch id func +This is the function that lets you find out what has changed in the +buffer. By providing the tracker @var{id} you let the library figure +out which changes have already been seen by your tracker. Instead of +returning a description of the changes, @code{track-changes-fetch} calls +the @var{func} function with that description in the form of +3 arguments: @var{beg}, @var{end}, and @var{before}, where +@code{@var{beg}..@var{end}} delimit the region that was modified and +@var{before} describes the previous content of that region. +Usually @var{before} is a string containing the previous text of the +modified region, but if you specified a non-@code{nil} @var{nobefore} argument +to @code{track-changes-register}, then it is replaced by the number of +characters of that previous text. + +In case no changes occurred since the last call, +@code{track-changes-fetch} simply does not call @var{func} and returns +@code{nil}. If changes did occur, it calls @var{func} and returns the value +returned by @var{func}. But note that @var{func} is called just once +regardless of how many changes occurred: those are summarized into +a single @var{beg}/@var{end}/@var{before} triplet. + +In some cases, the library is not properly notified of all changes, +for example because of a bug in the low-level C code or because of an +improper use of @code{inhibit-modification-hooks}. When it detects such +a problem, @var{func} receives a @code{@var{beg}..@var{end}} region +which covers the whole buffer and the @var{before} argument is the +symbol @code{error} to indicate that the library was unable to determine +what was changed. + +Once @var{func} finishes, @code{track-changes-fetch} re-enables the +@var{signal} function so that it will be called the next time a change +occurs. This is the reason why it calls @var{func} instead of returning +a description: it lets you process the change without worrying about the +risk that the @var{signal} function gets triggered in the middle of it, +because the @var{signal} is re-enabled only after @var{func} finishes. +@end defun + +@defun track-changes-unregister id +This function tells the library that the tracker @var{id} does not need +to know about buffer changes any more. Most clients will never want to +stop tracking changes, but for clients such as minor modes, it is +important to call this function when the minor mode is disabled, +otherwise the tracker will keep accumulating changes and consume more +and more resources. +@end defun diff --git a/etc/NEWS b/etc/NEWS index a2a3fe494cb..2cf6477ba99 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -15,6 +15,12 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing 'C-u C-h C-n'. +Temporary note: ++++ indicates that all relevant manuals in doc/ have been updated. +--- means no change in the manuals is needed. +When you add a new item, use the appropriate mark if you are sure it +applies, and please also update docstrings as needed. + * Installation Changes in Emacs 30.1 @@ -1586,6 +1592,18 @@ options of GNU 'ls'. * New Modes and Packages in Emacs 30.1 ++++ +** New package Track-Changes. +This library is a layer of abstraction above 'before-change-functions' +and 'after-change-functions' which provides a superset of +the functionality of 'after-change-functions': +- It provides the actual previous text rather than only its length. +- It takes care of accumulating and bundling changes until a time when + its client finds it convenient to react to them. +- It detects most cases where some changes were not properly + reported (calls to 'before/after-change-functions' that are + incorrectly paired, missing, etc...) and reports them adequately. + ** New major modes based on the tree-sitter library +++ diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el new file mode 100644 index 00000000000..1bab7ca38fd --- /dev/null +++ b/lisp/emacs-lisp/track-changes.el @@ -0,0 +1,624 @@ +;;; track-changes.el --- API to react to buffer modifications -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; Author: Stefan Monnier + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This library is a layer of abstraction above `before-change-functions' +;; and `after-change-functions' which takes care of accumulating changes +;; until a time when its client finds it convenient to react to them. +;; +;; It provides an API that is easier to use correctly than our +;; `*-change-functions' hooks. Problems that it claims to solve: +;; +;; - Before and after calls are not necessarily paired. +;; - The beg/end values don't always match. +;; - There's usually only one call to the hooks per command but +;; there can be thousands of calls from within a single command, +;; so naive users will tend to write code that performs poorly +;; in those rare cases. +;; - The hooks are run at a fairly low-level so there are things they +;; really shouldn't do, such as modify the buffer or wait. +;; - The after call doesn't get enough info to rebuild the before-change state, +;; so some callers need to use both before-c-f and after-c-f (and then +;; deal with the first two points above). +;; +;; The new API is almost like `after-change-functions' except that: +;; - It provides the "before string" (i.e. the previous content of +;; the changed area) rather than only its length. +;; - It can combine several changes into larger ones. +;; - Clients do not have to process changes right away, instead they +;; can let changes accumulate (by combining them into a larger change) +;; until it is convenient for them to process them. +;; - By default, changes are signaled at most once per command. + +;; The API consists in the following functions: +;; +;; (track-changes-register SIGNAL &key NOBEFORE DISJOINT IMMEDIATE) +;; (track-changes-fetch ID FUNC) +;; (track-changes-unregister ID) +;; +;; A typical use case might look like: +;; +;; (defvar my-foo--change-tracker nil) +;; (define-minor-mode my-foo-mode +;; "Fooing like there's no tomorrow." +;; (if (null my-foo-mode) +;; (when my-foo--change-tracker +;; (track-changes-unregister my-foo--change-tracker) +;; (setq my-foo--change-tracker nil)) +;; (unless my-foo--change-tracker +;; (setq my-foo--change-tracker +;; (track-changes-register +;; (lambda (id) +;; (track-changes-fetch +;; id (lambda (beg end before) +;; ..DO THE THING..)))))))) + +;;; Code: + +;; Random ideas: +;; - We could let trackers specify a function to record auxiliary info +;; about a state. This would be called from the first before-c-f +;; and then provided to FUNC. TeXpresso could use it to avoid needing +;; the BEFORE string: it could record the total number of bytes +;; in the "before" state so that from `track-changes-fetch' it could +;; compute the number of bytes that used to be in BEG/END. +;; - We could also let them provide another function to run in +;; before-c-f to signal errors if the change is not acceptable, +;; but contrary to before-c-f it would be called only when we +;; move t-c--before-beg/end so it scales better when there are +;; many small changes. + +(require 'cl-lib) + +;;;; Internal types and variables. + +(cl-defstruct (track-changes--tracker + (:noinline t) + (:constructor nil) + (:constructor track-changes--tracker ( signal state + &optional + nobefore immediate))) + signal state nobefore immediate) + +(cl-defstruct (track-changes--state + (:noinline t) + (:constructor nil) + (:constructor track-changes--state ())) + "Object holding a description of a buffer state. +A buffer state is described by a BEG/END/BEFORE triplet which say how to +recover that state from the next state. I.e. if the buffer's contents +reflects the next state, you can recover the previous state by replacing +the BEG..END region with the BEFORE string. + +NEXT is the next state object (i.e. a more recent state). +If NEXT is nil it means it's the most recent state and it may be incomplete +\(BEG/END/BEFORE may be nil), in which case those fields will take their +values from `track-changes--before-(beg|end|before)' when the next +state is created." + (beg (point-max)) + (end (point-min)) + (before nil) + (next nil)) + +(defvar-local track-changes--trackers () + "List of trackers currently registered in the buffer.") +(defvar-local track-changes--clean-trackers () + "List of trackers that are clean. +Those are the trackers that get signaled when a change is made.") + +(defvar-local track-changes--disjoint-trackers () + "List of trackers that want to react to disjoint changes. +These trackers are signaled every time track-changes notices +that some upcoming changes touch another \"distant\" part of the buffer.") + +(defvar-local track-changes--state nil) + +;; `track-changes--before-*' keep track of the content of the +;; buffer when `track-changes--state' was cleaned. +(defvar-local track-changes--before-beg 0 + "Beginning position of the remembered \"before string\".") +(defvar-local track-changes--before-end 0 + "End position of the text replacing the \"before string\".") +(defvar-local track-changes--before-string "" + "String holding some contents of the buffer before the current change. +This string is supposed to cover all the already modified areas plus +the upcoming modifications announced via `before-change-functions'. +If all trackers are `nobefore', then this holds the `buffer-size' before +the current change.") +(defvar-local track-changes--before-no t + "If non-nil, all the trackers are `nobefore'. +Should be equal to (memq #\\='track-changes--before before-change-functions).") + +(defvar-local track-changes--before-clean 'unset + "Status of `track-changes--before-*' vars. +More specifically it indicates which \"before\" they hold. +- nil: The vars hold the \"before\" info of the current state. +- `unset': The vars hold the \"before\" info of some older state. + This is what it is set to right after creating a fresh new state. +- `set': Like nil but the state is still clean because the buffer has not + been modified yet. This is what it is set to after the first + `before-change-functions' but before an `after-change-functions'.") + +(defvar-local track-changes--buffer-size nil + "Current size of the buffer, as far as this library knows. +This is used to try and detect cases where buffer modifications are \"lost\".") + +;;;; Exposed API. + +(cl-defun track-changes-register ( signal &key nobefore disjoint immediate) + "Register a new tracker whose change-tracking function is SIGNAL. +Return the ID of the new tracker. + +SIGNAL is a function that will be called with one argument (the tracker ID) +after the current buffer is modified, so that it can react to the change. +Once called, SIGNAL is not called again until `track-changes-fetch' +is called with the corresponding tracker ID. + +If optional argument NOBEFORE is non-nil, it means that this tracker does +not need the BEFORE strings (it will receive their size instead). + +If optional argument DISJOINT is non-nil, SIGNAL is called every time just +before combining changes from \"distant\" parts of the buffer. +This is needed when combining disjoint changes into one bigger change +is unacceptable, typically for performance reasons. +These calls are distinguished from normal calls by calling SIGNAL with +a second argument which is the distance between the upcoming change and +the previous changes. +BEWARE: In that case SIGNAL is called directly from `before-change-functions' +and should thus be extra careful: don't modify the buffer, don't call a function +that may block, ... +In order to prevent the upcoming change from being combined with the previous +changes, SIGNAL needs to call `track-changes-fetch' before it returns. + +By default SIGNAL is called after a change via a 0 seconds timer. +If optional argument IMMEDIATE is non-nil it means SIGNAL should be called +as soon as a change is detected, +BEWARE: In that case SIGNAL is called directly from `after-change-functions' +and should thus be extra careful: don't modify the buffer, don't call a function +that may block, do as little work as possible, ... +When IMMEDIATE is non-nil, the SIGNAL should probably not always call +`track-changes-fetch', since that would defeat the purpose of this library." + (when (and nobefore disjoint) + ;; FIXME: Without `before-change-functions', we can discover + ;; a disjoint change only after the fact, which is not good enough. + ;; But we could use a stripped down before-change-function, + (error "`disjoint' not supported for `nobefore' trackers")) + (track-changes--clean-state) + (unless nobefore + (setq track-changes--before-no nil) + (add-hook 'before-change-functions #'track-changes--before nil t)) + (add-hook 'after-change-functions #'track-changes--after nil t) + (let ((tracker (track-changes--tracker signal track-changes--state + nobefore immediate))) + (push tracker track-changes--trackers) + (push tracker track-changes--clean-trackers) + (when disjoint + (push tracker track-changes--disjoint-trackers)) + tracker)) + +(defun track-changes-unregister (id) + "Remove the tracker denoted by ID. +Trackers can consume resources (especially if `track-changes-fetch' is +not called), so it is good practice to unregister them when you don't +need them any more." + (unless (memq id track-changes--trackers) + (error "Unregistering a non-registered tracker: %S" id)) + (setq track-changes--trackers (delq id track-changes--trackers)) + (setq track-changes--clean-trackers (delq id track-changes--clean-trackers)) + (setq track-changes--disjoint-trackers + (delq id track-changes--disjoint-trackers)) + (when (cl-every #'track-changes--tracker-nobefore track-changes--trackers) + (setq track-changes--before-no t) + (remove-hook 'before-change-functions #'track-changes--before t)) + (when (null track-changes--trackers) + (mapc #'kill-local-variable + '(track-changes--before-beg + track-changes--before-end + track-changes--before-string + track-changes--buffer-size + track-changes--before-clean + track-changes--state)) + (remove-hook 'after-change-functions #'track-changes--after t))) + +(defun track-changes-fetch (id func) + "Fetch the pending changes for tracker ID pass them to FUNC. +ID is the tracker ID returned by a previous `track-changes-register'. +FUNC is a function. It is called with 3 arguments (BEGIN END BEFORE) +where BEGIN..END delimit the region that was changed since the last +time `track-changes-fetch' was called and BEFORE is a string containing +the previous content of that region (or just its length as an integer +if the tracker ID was registered with the `nobefore' option). +If track-changes detected that some changes were missed, then BEFORE will +be the symbol `error' to indicate that the buffer got out of sync. +This reflects a bug somewhere, so please report it when it happens. + +If no changes occurred since the last time, it doesn't call FUNC and +returns nil, otherwise it returns the value returned by FUNC +and re-enable the TRACKER corresponding to ID." + (cl-assert (memq id track-changes--trackers)) + (unless (equal track-changes--buffer-size (buffer-size)) + (track-changes--recover-from-error)) + (let ((beg nil) + (end nil) + (before t) + (lenbefore 0) + (states ())) + ;; Transfer the data from `track-changes--before-string' + ;; to the tracker's state object, if needed. + (track-changes--clean-state) + ;; We want to combine the states from most recent to oldest, + ;; so reverse them. + (let ((state (track-changes--tracker-state id))) + (while state + (push state states) + (setq state (track-changes--state-next state)))) + + (cond + ((eq (car states) track-changes--state) + (cl-assert (null (track-changes--state-before (car states)))) + (setq states (cdr states))) + (t + ;; The states are disconnected from the latest state because + ;; we got out of sync! + (cl-assert (eq (track-changes--state-before (car states)) 'error)) + (setq beg (point-min)) + (setq end (point-max)) + (setq before 'error) + (setq states nil))) + + (dolist (state states) + (let ((prevbeg (track-changes--state-beg state)) + (prevend (track-changes--state-end state)) + (prevbefore (track-changes--state-before state))) + (if (eq before t) + (progn + ;; This is the most recent change. Just initialize the vars. + (setq beg prevbeg) + (setq end prevend) + (setq lenbefore + (if (stringp prevbefore) (length prevbefore) prevbefore)) + (setq before + (unless (track-changes--tracker-nobefore id) prevbefore))) + (let ((endb (+ beg lenbefore))) + (when (< prevbeg beg) + (if (not before) + (setq lenbefore (+ (- beg prevbeg) lenbefore)) + (setq before + (concat (buffer-substring-no-properties + prevbeg beg) + before)) + (setq lenbefore (length before))) + (setq beg prevbeg) + (cl-assert (= endb (+ beg lenbefore)))) + (when (< endb prevend) + (let ((new-end (+ end (- prevend endb)))) + (if (not before) + (setq lenbefore (+ lenbefore (- new-end end))) + (setq before + (concat before + (buffer-substring-no-properties + end new-end))) + (setq lenbefore (length before))) + (setq end new-end) + (cl-assert (= prevend (+ beg lenbefore))) + (setq endb (+ beg lenbefore)))) + (cl-assert (<= beg prevbeg prevend endb)) + ;; The `prevbefore' is covered by the new one. + (if (not before) + (setq lenbefore + (+ (- prevbeg beg) + (if (stringp prevbefore) + (length prevbefore) prevbefore) + (- endb prevend))) + (setq before + (concat (substring before 0 (- prevbeg beg)) + prevbefore + (substring before (- (length before) + (- endb prevend))))) + (setq lenbefore (length before))))))) + (if (null beg) + (progn + (cl-assert (null states)) + (cl-assert (memq id track-changes--clean-trackers)) + (cl-assert (eq (track-changes--tracker-state id) + track-changes--state)) + ;; Nothing to do. + nil) + (cl-assert (not (memq id track-changes--clean-trackers))) + (cl-assert (<= (point-min) beg end (point-max))) + ;; Update the tracker's state *before* running `func' so we don't risk + ;; mistakenly replaying the changes in case `func' exits non-locally. + (setf (track-changes--tracker-state id) track-changes--state) + (unwind-protect (funcall func beg end (or before lenbefore)) + ;; Re-enable the tracker's signal only after running `func', so + ;; as to avoid recursive invocations. + (cl-pushnew id track-changes--clean-trackers))))) + +;;;; Auxiliary functions. + +(defun track-changes--clean-state () + (cond + ((null track-changes--state) + (cl-assert track-changes--before-clean) + (cl-assert (null track-changes--buffer-size)) + ;; No state has been created yet. Do it now. + (setq track-changes--buffer-size (buffer-size)) + (when track-changes--before-no + (setq track-changes--before-string (buffer-size))) + (setq track-changes--state (track-changes--state))) + (track-changes--before-clean + ;; If the state is already clean, there's nothing to do. + nil) + (t + (cl-assert (<= (track-changes--state-beg track-changes--state) + (track-changes--state-end track-changes--state))) + (let ((actual-beg (track-changes--state-beg track-changes--state)) + (actual-end (track-changes--state-end track-changes--state))) + (if track-changes--before-no + (progn + (cl-assert (integerp track-changes--before-string)) + (setf (track-changes--state-before track-changes--state) + (- track-changes--before-string + (- (buffer-size) (- actual-end actual-beg)))) + (setq track-changes--before-string (buffer-size))) + (cl-assert (<= track-changes--before-beg + actual-beg actual-end + track-changes--before-end)) + (cl-assert (null (track-changes--state-before track-changes--state))) + ;; The `track-changes--before-*' vars can cover more text than the + ;; actually modified area, so trim it down now to the relevant part. + (unless (= (- track-changes--before-end track-changes--before-beg) + (- actual-end actual-beg)) + (setq track-changes--before-string + (substring track-changes--before-string + (- actual-beg track-changes--before-beg) + (- (length track-changes--before-string) + (- track-changes--before-end actual-end)))) + (setq track-changes--before-beg actual-beg) + (setq track-changes--before-end actual-end)) + (setf (track-changes--state-before track-changes--state) + track-changes--before-string))) + ;; Note: We preserve `track-changes--before-*' because they may still + ;; be needed, in case `after-change-functions' are run before the next + ;; `before-change-functions'. + ;; Instead, we set `track-changes--before-clean' to `unset' to mean that + ;; `track-changes--before-*' can be reset at the next + ;; `before-change-functions'. + (setq track-changes--before-clean 'unset) + (let ((new (track-changes--state))) + (setf (track-changes--state-next track-changes--state) new) + (setq track-changes--state new))))) + +(defvar track-changes--disjoint-threshold 100 + "Number of chars below which changes are not considered disjoint.") + +(defvar track-changes--error-log () + "List of errors encountered. +Each element is a triplet (BUFFER-NAME BACKTRACE RECENT-KEYS).") + +(defun track-changes--recover-from-error () + ;; We somehow got out of sync. This is usually the result of a bug + ;; elsewhere that causes the before-c-f and after-c-f to be improperly + ;; paired, or to be skipped altogether. + ;; Not much we can do, other than force a full re-synchronization. + (warn "Missing/incorrect calls to `before/after-change-functions'!! +Details logged to `track-changes--error-log'") + (push (list (buffer-name) + (backtrace-frames 'track-changes--recover-from-error) + (recent-keys 'include-cmds)) + track-changes--error-log) + (setq track-changes--before-clean 'unset) + (setq track-changes--buffer-size (buffer-size)) + ;; Create a new state disconnected from the previous ones! + ;; Mark the previous one as junk, just to be clear. + (setf (track-changes--state-before track-changes--state) 'error) + (setq track-changes--state (track-changes--state))) + +(defun track-changes--before (beg end) + (cl-assert track-changes--state) + (cl-assert (<= beg end)) + (let* ((size (- end beg)) + (reset (lambda () + (cl-assert track-changes--before-clean) + (setq track-changes--before-clean 'set) + (setf track-changes--before-string + (buffer-substring-no-properties beg end)) + (setf track-changes--before-beg beg) + (setf track-changes--before-end end))) + + (signal-if-disjoint + (lambda (pos1 pos2) + (let ((distance (- pos2 pos1))) + (when (> distance + (max track-changes--disjoint-threshold + ;; If the distance is smaller than the size of the + ;; current change, then we may as well consider it + ;; as "near". + (length track-changes--before-string) + size + (- track-changes--before-end + track-changes--before-beg))) + (dolist (tracker track-changes--disjoint-trackers) + (funcall (track-changes--tracker-signal tracker) + tracker distance)) + ;; Return non-nil if the state was cleaned along the way. + track-changes--before-clean))))) + + (if track-changes--before-clean + (progn + ;; Detect disjointness with previous changes here as well, + ;; so that if a client calls `track-changes-fetch' all the time, + ;; it doesn't prevent others from getting a disjointness signal. + (when (and track-changes--before-beg + (let ((found nil)) + (dolist (tracker track-changes--disjoint-trackers) + (unless (memq tracker track-changes--clean-trackers) + (setq found t))) + found)) + ;; There's at least one `tracker' that wants to know about disjoint + ;; changes *and* it has unseen pending changes. + ;; FIXME: This can occasionally signal a tracker that's clean. + (if (< beg track-changes--before-beg) + (funcall signal-if-disjoint end track-changes--before-beg) + (funcall signal-if-disjoint track-changes--before-end beg))) + (funcall reset)) + (cl-assert (save-restriction + (widen) + (<= (point-min) + track-changes--before-beg + track-changes--before-end + (point-max)))) + (when (< beg track-changes--before-beg) + (if (and track-changes--disjoint-trackers + (funcall signal-if-disjoint end track-changes--before-beg)) + (funcall reset) + (let* ((old-bbeg track-changes--before-beg) + ;; To avoid O(N²) behavior when faced with many small changes, + ;; we copy more than needed. + (new-bbeg (min (max (point-min) + (- old-bbeg + (length track-changes--before-string))) + beg))) + (setf track-changes--before-beg new-bbeg) + (cl-callf (lambda (old new) (concat new old)) + track-changes--before-string + (buffer-substring-no-properties new-bbeg old-bbeg))))) + + (when (< track-changes--before-end end) + (if (and track-changes--disjoint-trackers + (funcall signal-if-disjoint track-changes--before-end beg)) + (funcall reset) + (let* ((old-bend track-changes--before-end) + ;; To avoid O(N²) behavior when faced with many small changes, + ;; we copy more than needed. + (new-bend (max (min (point-max) + (+ old-bend + (length track-changes--before-string))) + end))) + (setf track-changes--before-end new-bend) + (cl-callf concat track-changes--before-string + (buffer-substring-no-properties old-bend new-bend)))))))) + +(defun track-changes--after (beg end len) + (cl-assert track-changes--state) + (and (eq track-changes--before-clean 'unset) + (not track-changes--before-no) + ;; This can be a sign that a `before-change-functions' went missing, + ;; or that we called `track-changes--clean-state' between + ;; a `before-change-functions' and `after-change-functions'. + (track-changes--before beg end)) + (setq track-changes--before-clean nil) + (let ((offset (- (- end beg) len))) + (cl-incf track-changes--before-end offset) + (cl-incf track-changes--buffer-size offset) + (if (not (or track-changes--before-no + (save-restriction + (widen) + (<= (point-min) + track-changes--before-beg + beg end + track-changes--before-end + (point-max))))) + ;; BEG..END is not covered by previous `before-change-functions'!! + (track-changes--recover-from-error) + ;; Note the new changes. + (when (< beg (track-changes--state-beg track-changes--state)) + (setf (track-changes--state-beg track-changes--state) beg)) + (cl-callf (lambda (old-end) (max end (+ old-end offset))) + (track-changes--state-end track-changes--state)) + (cl-assert (or track-changes--before-no + (<= track-changes--before-beg + (track-changes--state-beg track-changes--state) + beg end + (track-changes--state-end track-changes--state) + track-changes--before-end))))) + (while track-changes--clean-trackers + (let ((tracker (pop track-changes--clean-trackers))) + (if (track-changes--tracker-immediate tracker) + (funcall (track-changes--tracker-signal tracker) tracker) + (run-with-timer 0 nil #'track-changes--call-signal + (current-buffer) tracker))))) + +(defun track-changes--call-signal (buf tracker) + (when (buffer-live-p buf) + (with-current-buffer buf + ;; Silence ourselves if `track-changes-fetch' was called in the mean time. + (unless (memq tracker track-changes--clean-trackers) + (funcall (track-changes--tracker-signal tracker) tracker))))) + +;;;; Extra candidates for the API. + +;; The functions below came up during the design of this library, but +;; I'm not sure if they're worth the trouble or not, so for now I keep +;; them here (with a "--" in the name) for documentation. --Stef + +;; This could be a good alternative to using a temp-buffer like in +;; `eglot--virtual-pos-to-lsp-position': since presumably we've just +;; been changing this very area of the buffer, the gap should be +;; ready nearby, so the operation should be fairly cheap, while +;; giving you the comfort of having access to the *full* buffer text. +;; +;; It may seem silly to go back to the previous state, since we could have +;; used `before-change-functions' to run FUNC right then when we were in +;; that state. The advantage is that with track-changes we get to decide +;; retroactively which state is the one for which we want to call FUNC and +;; which BEG..END to use: when that state was current we may have known +;; then that it would be "the one" but we didn't know what BEG and END +;; should be because those depend on the changes that came afterwards. +(defun track-changes--in-revert (beg end before func) + "Call FUNC with the buffer contents temporarily reverted to BEFORE. +FUNC is called with no arguments and with point right after BEFORE. +FUNC is not allowed to modify the buffer and it should refrain from using +operations that use a cache populated from the buffer's content, +such as `syntax-ppss'." + (catch 'track-changes--exit + (with-silent-modifications ;; This has to be outside `atomic-change-group'. + (atomic-change-group + (goto-char end) + (insert-before-markers before) + (delete-region beg end) + (throw 'track-changes--exit + (let ((inhibit-read-only nil) + (buffer-read-only t)) + (funcall func))))))) + +;; This one is a cheaper version of (track-changes-fetch id #'ignore), +;; e.g. for clients that don't want to see their own changes. +(defun track-changes--reset (id) + "Mark all past changes as handled for tracker ID. +Re-arms ID's signal." + (track-changes--clean-state) + (setf (track-changes--tracker-state id) track-changes--state) + (cl-pushnew id track-changes--clean-trackers) + (cl-assert (not (track-changes--pending-p id)))) + +(defun track-changes--pending-p (id) + "Return non-nil if there are pending changes for tracker ID." + (or (not track-changes--before-clean) + (track-changes--state-next id))) + +(defmacro with--track-changes (id vars &rest body) + (declare (indent 2) (debug (form sexp body))) + `(track-changes-fetch ,id (lambda ,vars ,@body))) + +(provide 'track-changes) +;;; track-changes.el end here. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 7f4284bf09d..478e7687bb3 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -110,6 +110,7 @@ (require 'text-property-search nil t) (require 'diff-mode) (require 'diff) +(require 'track-changes nil t) ;; These dependencies are also GNU ELPA core packages. Because of ;; bug#62576, since there is a risk that M-x package-install, despite @@ -1732,6 +1733,9 @@ return value is fed through the corresponding inverse function "Calculate number of UTF-16 code units from position given by LBP. LBP defaults to `eglot--bol'." (/ (- (length (encode-coding-region (or lbp (eglot--bol)) + ;; FIXME: How could `point' ever be + ;; larger than `point-max' (sounds like + ;; a bug in Emacs). ;; Fix github#860 (min (point) (point-max)) 'utf-16 t)) 2) @@ -1749,6 +1753,24 @@ LBP defaults to `eglot--bol'." :character (progn (when pos (goto-char pos)) (funcall eglot-current-linepos-function))))) +(defun eglot--virtual-pos-to-lsp-position (pos string) + "Return the LSP position at the end of STRING if it were inserted at POS." + (eglot--widening + (goto-char pos) + (forward-line 0) + ;; LSP line is zero-origin; Emacs is one-origin. + (let ((posline (1- (line-number-at-pos nil t))) + (linebeg (buffer-substring (point) pos)) + (colfun eglot-current-linepos-function)) + ;; Use a temp buffer because: + ;; - I don't know of a fast way to count newlines in a string. + ;; - We currently don't have `eglot-current-linepos-function' for strings. + (with-temp-buffer + (insert linebeg string) + (goto-char (point-max)) + (list :line (+ posline (1- (line-number-at-pos nil t))) + :character (funcall colfun)))))) + (defvar eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos "Function to move to a position within a line reported by the LSP server. @@ -1946,6 +1968,8 @@ For example, to keep your Company customization, add the symbol "A hook run by Eglot after it started/stopped managing a buffer. Use `eglot-managed-p' to determine if current buffer is managed.") +(defvar-local eglot--track-changes nil) + (define-minor-mode eglot--managed-mode "Mode for source buffers managed by some Eglot project." :init-value nil :lighter nil :keymap eglot-mode-map @@ -1959,8 +1983,13 @@ Use `eglot-managed-p' to determine if current buffer is managed.") ("utf-8" (eglot--setq-saving eglot-current-linepos-function #'eglot-utf-8-linepos) (eglot--setq-saving eglot-move-to-linepos-function #'eglot-move-to-utf-8-linepos))) - (add-hook 'after-change-functions #'eglot--after-change nil t) - (add-hook 'before-change-functions #'eglot--before-change nil t) + (if (fboundp 'track-changes-register) + (unless eglot--track-changes + (setq eglot--track-changes + (track-changes-register + #'eglot--track-changes-signal :disjoint t))) + (add-hook 'after-change-functions #'eglot--after-change nil t) + (add-hook 'before-change-functions #'eglot--before-change nil t)) (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t) ;; Prepend "didClose" to the hook after the "nonoff", so it will run first (add-hook 'kill-buffer-hook #'eglot--signal-textDocument/didClose nil t) @@ -1998,6 +2027,9 @@ Use `eglot-managed-p' to determine if current buffer is managed.") buffer (eglot--managed-buffers (eglot-current-server))))) (t + (when eglot--track-changes + (track-changes-unregister eglot--track-changes) + (setq eglot--track-changes nil)) (remove-hook 'after-change-functions #'eglot--after-change t) (remove-hook 'before-change-functions #'eglot--before-change t) (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t) @@ -2588,7 +2620,6 @@ buffer." (defun eglot--after-change (beg end pre-change-length) "Hook onto `after-change-functions'. Records BEG, END and PRE-CHANGE-LENGTH locally." - (cl-incf eglot--versioned-identifier) (pcase (car-safe eglot--recent-changes) (`(,lsp-beg ,lsp-end (,b-beg . ,b-beg-marker) @@ -2616,6 +2647,29 @@ Records BEG, END and PRE-CHANGE-LENGTH locally." `(,lsp-beg ,lsp-end ,pre-change-length ,(buffer-substring-no-properties beg end))))) (_ (setf eglot--recent-changes :emacs-messup))) + (eglot--track-changes-signal nil)) + +(defun eglot--track-changes-fetch (id) + (if (eq eglot--recent-changes :pending) (setq eglot--recent-changes nil)) + (track-changes-fetch + id (lambda (beg end before) + (cond + ((eq eglot--recent-changes :emacs-messup) nil) + ((eq before 'error) (setf eglot--recent-changes :emacs-messup)) + (t (push `(,(eglot--pos-to-lsp-position beg) + ,(eglot--virtual-pos-to-lsp-position beg before) + ,(length before) + ,(buffer-substring-no-properties beg end)) + eglot--recent-changes)))))) + +(defun eglot--track-changes-signal (id &optional distance) + (cl-incf eglot--versioned-identifier) + (cond + (distance (eglot--track-changes-fetch id)) + (eglot--recent-changes nil) + ;; Note that there are pending changes, for the benefit of those + ;; who check it as a boolean. + (t (setq eglot--recent-changes :pending))) (when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer)) (let ((buf (current-buffer))) (setq eglot--change-idle-timer @@ -2729,6 +2783,8 @@ When called interactively, use the currently active server" (defun eglot--signal-textDocument/didChange () "Send textDocument/didChange to server." (when eglot--recent-changes + (when eglot--track-changes + (eglot--track-changes-fetch eglot--track-changes)) (let* ((server (eglot--current-server-or-lose)) (sync-capability (eglot-server-capable :textDocumentSync)) (sync-kind (if (numberp sync-capability) sync-capability @@ -2750,7 +2806,7 @@ When called interactively, use the currently active server" ;; empty entries in `eglot--before-change' calls ;; without an `eglot--after-change' reciprocal. ;; Weed them out here. - when (numberp len) + when (numberp len) ;FIXME: Not needed with `track-changes'. vconcat `[,(list :range `(:start ,beg :end ,end) :rangeLength len :text text)])))) (setq eglot--recent-changes nil) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 66043059d14..e1837eab12a 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -53,9 +53,10 @@ ;; - Handle `diff -b' output in context->unified. ;;; Code: +(require 'easy-mmode) +(require 'track-changes) (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'subr-x)) -(require 'easy-mmode) (autoload 'vc-find-revision "vc") (autoload 'vc-find-revision-no-save "vc") @@ -1431,38 +1432,23 @@ else cover the whole buffer." (if (buffer-modified-p) (diff-fixup-modifs (point-min) (point-max))) nil) -;; It turns out that making changes in the buffer from within an -;; *-change-function is asking for trouble, whereas making them -;; from a post-command-hook doesn't pose much problems -(defvar diff-unhandled-changes nil) -(defun diff-after-change-function (beg end _len) - "Remember to fixup the hunk header. -See `after-change-functions' for the meaning of BEG, END and LEN." - ;; Ignoring changes when inhibit-read-only is set is strictly speaking - ;; incorrect, but it turns out that inhibit-read-only is normally not set - ;; inside editing commands, while it tends to be set when the buffer gets - ;; updated by an async process or by a conversion function, both of which - ;; would rather not be uselessly slowed down by this hook. - (when (and (not undo-in-progress) (not inhibit-read-only)) - (if diff-unhandled-changes - (setq diff-unhandled-changes - (cons (min beg (car diff-unhandled-changes)) - (max end (cdr diff-unhandled-changes)))) - (setq diff-unhandled-changes (cons beg end))))) - -(defun diff-post-command-hook () - "Fixup hunk headers if necessary." - (when (consp diff-unhandled-changes) - (ignore-errors - (save-excursion - (goto-char (car diff-unhandled-changes)) - ;; Maybe we've cut the end of the hunk before point. - (if (and (bolp) (not (bobp))) (backward-char 1)) - ;; We used to fixup modifs on all the changes, but it turns out that - ;; it's safer not to do it on big changes, e.g. when yanking a big - ;; diff, or when the user edits the header, since we might then - ;; screw up perfectly correct values. --Stef - (diff-beginning-of-hunk t) +(defvar-local diff--track-changes nil) + +(defun diff--track-changes-signal (tracker) + (cl-assert (eq tracker diff--track-changes)) + (track-changes-fetch tracker #'diff--track-changes-function)) + +(defun diff--track-changes-function (beg end _before) + (with-demoted-errors "%S" + (save-excursion + (goto-char beg) + ;; Maybe we've cut the end of the hunk before point. + (if (and (bolp) (not (bobp))) (backward-char 1)) + ;; We used to fixup modifs on all the changes, but it turns out that + ;; it's safer not to do it on big changes, e.g. when yanking a big + ;; diff, or when the user edits the header, since we might then + ;; screw up perfectly correct values. --Stef + (when (ignore-errors (diff-beginning-of-hunk t)) (let* ((style (if (looking-at "\\*\\*\\*") 'context)) (start (line-beginning-position (if (eq style 'context) 3 2))) (mid (if (eq style 'context) @@ -1470,17 +1456,20 @@ See `after-change-functions' for the meaning of BEG, END and LEN." (re-search-forward diff-context-mid-hunk-header-re nil t))))) (when (and ;; Don't try to fixup changes in the hunk header. - (>= (car diff-unhandled-changes) start) + (>= beg start) ;; Don't try to fixup changes in the mid-hunk header either. (or (not mid) - (< (cdr diff-unhandled-changes) (match-beginning 0)) - (> (car diff-unhandled-changes) (match-end 0))) + (< end (match-beginning 0)) + (> beg (match-end 0))) (save-excursion - (diff-end-of-hunk nil 'donttrustheader) + (diff-end-of-hunk nil 'donttrustheader) ;; Don't try to fixup changes past the end of the hunk. - (>= (point) (cdr diff-unhandled-changes)))) - (diff-fixup-modifs (point) (cdr diff-unhandled-changes))))) - (setq diff-unhandled-changes nil)))) + (>= (point) end))) + (diff-fixup-modifs (point) end) + ;; Ignore the changes we just made ourselves. + ;; This is not indispensable since the above `when' skips + ;; changes like the ones we make anyway, but it's good practice. + (track-changes-fetch diff--track-changes #'ignore))))))) (defun diff-next-error (arg reset) ;; Select a window that displays the current buffer so that point @@ -1560,9 +1549,8 @@ a diff with \\[diff-reverse-direction]. ;; setup change hooks (if (not diff-update-on-the-fly) (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t) - (make-local-variable 'diff-unhandled-changes) - (add-hook 'after-change-functions #'diff-after-change-function nil t) - (add-hook 'post-command-hook #'diff-post-command-hook nil t)) + (setq diff--track-changes + (track-changes-register #'diff--track-changes-signal :nobefore t))) ;; add-log support (setq-local add-log-current-defun-function #'diff-current-defun) @@ -1581,12 +1569,15 @@ a diff with \\[diff-reverse-direction]. \\{diff-minor-mode-map}" :group 'diff-mode :lighter " Diff" ;; FIXME: setup font-lock - ;; setup change hooks - (if (not diff-update-on-the-fly) - (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t) - (make-local-variable 'diff-unhandled-changes) - (add-hook 'after-change-functions #'diff-after-change-function nil t) - (add-hook 'post-command-hook #'diff-post-command-hook nil t))) + (when diff--track-changes (track-changes-unregister diff--track-changes)) + (remove-hook 'write-contents-functions #'diff-write-contents-hooks t) + (when diff-minor-mode + (if (not diff-update-on-the-fly) + (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t) + (unless diff--track-changes + (setq diff--track-changes + (track-changes-register #'diff--track-changes-signal + :nobefore t)))))) ;;; Handy hook functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/test/lisp/emacs-lisp/track-changes-tests.el b/test/lisp/emacs-lisp/track-changes-tests.el new file mode 100644 index 00000000000..ed35477cafd --- /dev/null +++ b/test/lisp/emacs-lisp/track-changes-tests.el @@ -0,0 +1,156 @@ +;;; track-changes-tests.el --- tests for emacs-lisp/track-changes.el -*- lexical-binding:t -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'track-changes) +(require 'cl-lib) +(require 'ert) + +(defun track-changes-tests--random-word () + (let ((chars ())) + (dotimes (_ (1+ (random 12))) + (push (+ ?A (random (1+ (- ?z ?A)))) chars)) + (apply #'string chars))) + +(defvar track-changes-tests--random-verbose nil) + +(defun track-changes-tests--message (&rest args) + (when track-changes-tests--random-verbose (apply #'message args))) + +(defvar track-changes-tests--random-seed + (let ((seed (number-to-string (random (expt 2 24))))) + (message "Random seed = %S" seed) + seed)) + +(ert-deftest track-changes-tests--random () + ;; Keep 2 buffers in sync with a third one as we make random + ;; changes to that 3rd one. + ;; We have 3 trackers: a "normal" one which we sync + ;; at random intervals, one which syncs via the "disjoint" signal, + ;; plus a third one which verifies that "nobefore" gets + ;; information consistent with the "normal" tracker. + (with-temp-buffer + (random track-changes-tests--random-seed) + (dotimes (_ 100) + (insert (track-changes-tests--random-word) "\n")) + (let* ((buf1 (generate-new-buffer " *tc1*")) + (buf2 (generate-new-buffer " *tc2*")) + (char-counts (make-vector 2 0)) + (sync-counts (make-vector 2 0)) + (print-escape-newlines t) + (file (make-temp-file "tc")) + (id1 (track-changes-register #'ignore)) + (id3 (track-changes-register #'ignore :nobefore t)) + (sync + (lambda (id buf n) + (track-changes-tests--message "!! SYNC %d !!" n) + (track-changes-fetch + id (lambda (beg end before) + (when (eq n 1) + (track-changes-fetch + id3 (lambda (beg3 end3 before3) + (should (eq beg3 beg)) + (should (eq end3 end)) + (should (eq before3 + (if (symbolp before) + before (length before))))))) + (cl-incf (aref sync-counts (1- n))) + (cl-incf (aref char-counts (1- n)) (- end beg)) + (let ((after (buffer-substring beg end))) + (track-changes-tests--message + "Sync:\n %S\n=> %S\nat %d .. %d" + before after beg end) + (with-current-buffer buf + (if (eq before 'error) + (erase-buffer) + (should (equal before + (buffer-substring + beg (+ beg (length before))))) + (delete-region beg (+ beg (length before)))) + (goto-char beg) + (insert after))) + (should (equal (buffer-string) + (with-current-buffer buf + (buffer-string)))))))) + (id2 (track-changes-register + (lambda (id2 &optional distance) + (when distance + (track-changes-tests--message "Disjoint distance: %d" + distance) + (funcall sync id2 buf2 2))) + :disjoint t))) + (write-region (point-min) (point-max) file) + (insert-into-buffer buf1) + (insert-into-buffer buf2) + (should (equal (buffer-hash) (buffer-hash buf1))) + (should (equal (buffer-hash) (buffer-hash buf2))) + (message "seeding with: %S" track-changes-tests--random-seed) + (dotimes (_ 1000) + (pcase (random 15) + (0 + (track-changes-tests--message "Manual sync1") + (funcall sync id1 buf1 1)) + (1 + (track-changes-tests--message "Manual sync2") + (funcall sync id2 buf2 2)) + ((pred (< _ 5)) + (let* ((beg (+ (point-min) (random (1+ (buffer-size))))) + (end (min (+ beg (1+ (random 100))) (point-max)))) + (track-changes-tests--message "Fill %d .. %d" beg end) + (fill-region-as-paragraph beg end))) + ((pred (< _ 8)) + (let* ((beg (+ (point-min) (random (1+ (buffer-size))))) + (end (min (+ beg (1+ (random 12))) (point-max)))) + (track-changes-tests--message "Delete %S at %d .. %d" + (buffer-substring beg end) beg end) + (delete-region beg end))) + ((and 8 (guard (= (random 50) 0))) + (track-changes-tests--message "Silent insertion") + (let ((inhibit-modification-hooks t)) + (insert "a"))) + ((and 8 (guard (= (random 10) 0))) + (track-changes-tests--message "Revert") + (insert-file-contents file nil nil nil 'replace)) + ((and 8 (guard (= (random 3) 0))) + (let* ((beg (+ (point-min) (random (1+ (buffer-size))))) + (end (min (+ beg (1+ (random 12))) (point-max))) + (after (eq (random 2) 0))) + (track-changes-tests--message "Bogus %S %d .. %d" + (if after 'after 'before) beg end) + (if after + (run-hook-with-args 'after-change-functions + beg end (- end beg)) + (run-hook-with-args 'before-change-functions beg end)))) + (_ + (goto-char (+ (point-min) (random (1+ (buffer-size))))) + (let ((word (track-changes-tests--random-word))) + (track-changes-tests--message "insert %S at %d" word (point)) + (insert word "\n"))))) + (message "SCOREs: default: %d/%d=%d disjoint: %d/%d=%d" + (aref char-counts 0) (aref sync-counts 0) + (/ (aref char-counts 0) (aref sync-counts 0)) + (aref char-counts 1) (aref sync-counts 1) + (/ (aref char-counts 1) (aref sync-counts 1)))))) + + + +;;; track-changes-tests.el ends here commit f950621e6a177fc3110f3dec7c92b7d499fd25d6 Author: Phil Sainty Date: Sun Apr 14 00:49:56 2024 +1200 ; Additional fixup for truncation of long lines in compilation buffers * lisp/progmodes/compile.el (compilation--insert-abbreviated-line): Handle long lines that end in a newline. (Bug#70236) The fix in commit 8f93cba324e4d4022a9422b8c56186213ba2de8d resulted in the previous "Don't hide the final newline" code causing an off-by-one error. With the new code the value of point is what is wanted in both cases. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index d7690b7fa74..b18eb81fee1 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2661,10 +2661,7 @@ and runs `compilation-filter-hook'." (line-end-position)) (text-properties-at start))))) (put-text-property - start (if ends-in-nl - ;; Don't hide the final newline. - (1- (point)) - (point)) + start (point) 'display (if (char-displayable-p ?…) "[…]" "[...]")))) (if ends-in-nl (forward-char))))) commit 66c44c3cd7b37712d5a923966f71a06bbf1fcdb8 Author: Po Lu Date: Sat Apr 13 20:07:17 2024 +0800 ; Fix coding style of last change to xdisp.c * src/xdisp.c (note_fringe_highlight): Stylistic edits. diff --git a/src/xdisp.c b/src/xdisp.c index 2bc943c88cd..452adee1d31 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35759,21 +35759,22 @@ note_fringe_highlight (Lisp_Object window, int x, int y, /* Get to the first glyph of a text row based on the vertical position of the fringe. */ - struct glyph *glyph = MATRIX_ROW_GLYPH_START(w->current_matrix, vpos); - int glyph_num = MATRIX_ROW_USED(w->current_matrix, vpos); + struct glyph *glyph = MATRIX_ROW_GLYPH_START (w->current_matrix, vpos); + int glyph_num = MATRIX_ROW_USED (w->current_matrix, vpos); /* Check all glyphs while looking for fringe tooltips. */ /* NOTE: iterating over glyphs can only find text properties coming from visible text. This means that zero-length overlays and invisibile text are NOT inspected. */ - for (;glyph_num; glyph_num--, glyph++) + for (; glyph_num; glyph_num--, glyph++) { - Lisp_Object pos = make_fixnum(glyph->charpos); + Lisp_Object pos = make_fixnum (glyph->charpos); Lisp_Object help_echo = Qnil; - if (STRINGP(glyph->object) || BUFFERP(glyph->object)) - help_echo = get_char_property_and_overlay (pos, sym, glyph->object, NULL); + if (STRINGP (glyph->object) || BUFFERP (glyph->object)) + help_echo = get_char_property_and_overlay (pos, sym, + glyph->object, NULL); if (STRINGP (help_echo)) { commit 24957ea566bd5d0306c4e99dbb37d88e1f214b50 Merge: 199351125a4 9fc698479fe Author: Eli Zaretskii Date: Sat Apr 13 14:45:59 2024 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 199351125a4b17081c5ae8056e61aeb3c33650d2 Author: Eli Zaretskii Date: Sat Apr 13 14:45:15 2024 +0300 ; * src/window.c (shrink_mini_window): Revert inadvertent change. diff --git a/src/window.c b/src/window.c index 0945b244319..fe26311fbb2 100644 --- a/src/window.c +++ b/src/window.c @@ -5407,13 +5407,13 @@ shrink_mini_window (struct window *w) eassert (MINI_WINDOW_P (w)); - FRAME_WINDOWS_FROZEN (f) = false; if (delta > 0) { Lisp_Object root = FRAME_ROOT_WINDOW (f); struct window *r = XWINDOW (root); Lisp_Object grow; + FRAME_WINDOWS_FROZEN (f) = false; grow = call3 (Qwindow__resize_root_window_vertically, root, make_fixnum (delta), Qt); commit 9fc698479feef6fa660ff13e21619ea50bd404df Author: Po Lu Date: Sat Apr 13 19:43:40 2024 +0800 Fix crash upon call to Fset_fontset_font after X server disconnect * src/image.c (free_image): * src/xfaces.c (free_realized_face): Handle scenarios where free_frame_faces is called with the display connection cut. * src/xterm.c (x_free_frame_resources): Call free_frame_faces unconditionally, lest fontsets for this dead frame contaminate Vfontset_list and produce crashes afterwards. (bug#66151) diff --git a/src/image.c b/src/image.c index 216bdc1ee66..3968145728f 100644 --- a/src/image.c +++ b/src/image.c @@ -1699,14 +1699,26 @@ free_image (struct frame *f, struct image *img) c->images[img->id] = NULL; #if !defined USE_CAIRO && defined HAVE_XRENDER - if (img->picture) - XRenderFreePicture (FRAME_X_DISPLAY (f), img->picture); - if (img->mask_picture) - XRenderFreePicture (FRAME_X_DISPLAY (f), img->mask_picture); -#endif + /* FRAME_X_DISPLAY (f) could be NULL if this is being called from + the display IO error handler.*/ + + if (FRAME_X_DISPLAY (f)) + { + if (img->picture) + XRenderFreePicture (FRAME_X_DISPLAY (f), + img->picture); + if (img->mask_picture) + XRenderFreePicture (FRAME_X_DISPLAY (f), + img->mask_picture); + } +#endif /* !USE_CAIRO && HAVE_XRENDER */ + +#ifdef HAVE_X_WINDOWS + if (FRAME_X_DISPLAY (f)) +#endif /* HAVE_X_WINDOWS */ + /* Free resources, then free IMG. */ + img->type->free_img (f, img); - /* Free resources, then free IMG. */ - img->type->free_img (f, img); xfree (img->face_font_family); xfree (img); } diff --git a/src/xfaces.c b/src/xfaces.c index a558e7328c0..d4583e1a78f 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -4569,6 +4569,15 @@ free_realized_face (struct frame *f, struct face *face) /* Free fontset of FACE if it is ASCII face. */ if (face->fontset >= 0 && face == face->ascii_face) free_face_fontset (f, face); + +#ifdef HAVE_X_WINDOWS + /* This function might be called with the frame's display + connection deleted, in which event the callbacks below + should not be executed, as they generate X requests. */ + if (FRAME_X_DISPLAY (f)) + return; +#endif /* HAVE_X_WINDOWS */ + if (face->gc) { block_input (); diff --git a/src/xterm.c b/src/xterm.c index 5e5eb6269e4..e08ffd15b18 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -29428,6 +29428,17 @@ x_free_frame_resources (struct frame *f) xi_unlink_touch_points (f); #endif + /* We must free faces before destroying windows because some + font-driver (e.g. xft) access a window while finishing a face. + + This function must be called to remove this frame's fontsets from + Vfontset_list, and is itself responsible for not issuing X requests + if the connection has already been terminated. Otherwise, a future + call to a function that iterates over all existing fontsets might + crash, as they are not prepared to receive dead frames. + (bug#66151) */ + free_frame_faces (f); + /* If a display connection is dead, don't try sending more commands to the X server. */ if (dpyinfo->display) @@ -29437,10 +29448,6 @@ x_free_frame_resources (struct frame *f) if (f->pointer_invisible) XTtoggle_invisible_pointer (f, 0); - /* We must free faces before destroying windows because some - font-driver (e.g. xft) access a window while finishing a - face. */ - free_frame_faces (f); tear_down_x_back_buffer (f); if (f->output_data.x->icon_desc) commit adbcf268bc81c439f90b1016700d8a0a234e12b7 Merge: 952f20fabe7 f0300fb0597 Author: Eli Zaretskii Date: Sat Apr 13 07:37:13 2024 -0400 Merge from origin/emacs-29 f0300fb0597 ; Tweak "(emacs)Bug Reference" formatting/wording. ea62a14ea3b Fix display of vscrolled windows 4cefa3c0b1f ; * doc/emacs/files.texi (Backup): Clarify "saving" (bug#... db7b571aaaf ; Improve documentation of 'world-clock' 6a0bb7beae3 * doc/emacs/misc.texi (emacsclient Options): Suggest forw... 859b4227e3d Update go-ts-mode to support latest tree-sitter-go grammar 407e85ce139 Fix c++-ts-mode defun navigation (bug#65885) aca5064f128 ; Fix last change. 55aab2d4710 ; * etc/PROBLEMS: An entry about focus issues with XFCE (... 19cee16576e ; * doc/emacs/misc.texi (emacsclient Options): Fix typo. ... 2a41b6ba514 ; * src/filelock.c (Flock_file): Doc fix (bug#70216). commit 952f20fabe76c087aa96645389cfd4786fc95380 Author: Eli Zaretskii Date: Sat Apr 13 14:20:16 2024 +0300 ; Fix documentation of last change. * etc/NEWS: * doc/lispref/display.texi (Other Display Specs): * doc/lispref/text.texi (Special Properties): Fix last changes. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index fd083083fd2..fba15578f4f 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5502,7 +5502,7 @@ colors are to be used for the bitmap display. @xref{Fringe Bitmaps}, for the details. It also possible to add context help for fringe bitmaps through the -@code{show-help-function} mechanism by using @code{left-fringe-help} or +@code{show-help-function} mechanism by using @code{left-fringe-help} and @code{right-fringe-help} text properties (@pxref{Special Properties}). @item (space-width @var{factor}) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 3db82df49b3..0d247cd9a07 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -3666,11 +3666,12 @@ through @code{substitute-command-keys}. @item left-fringe-help @itemx right-fringe-help @cindex help-echo text on fringes -If any visible text of a buffer line has @code{left-fringe-help} or -@code{right-fringe-help} string text property defined on it, then the -string will be displayed for a corresponding line's fringe through -@code{show-help-function} (@pxref{Help display}). This is useful when -used together with fringe cursors and bitmaps (@pxref{Fringes}). +If any visible text of a screen line has the @code{left-fringe-help} or +@code{right-fringe-help} text property whose value is a string, then +that string will be displayed when the mouse pointer hovers over the +corresponding line's fringe through @code{show-help-function} +(@pxref{Help display}). This is useful when used together with fringe +cursors and bitmaps (@pxref{Fringes}). @item keymap @cindex keymap of character diff --git a/etc/NEWS b/etc/NEWS index 97cac373750..51ecd886593 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1850,8 +1850,9 @@ the Info node "(elisp) Handling Errors". +++ ** Tooltips on fringes. It is now possible to provide tooltips on fringes by adding special text -properties. See the "Special Properties" Info node in the Emacs Lisp -Reference Manual. +properties 'left-fringe-help' and 'right-fringe-help'. See the "Special +Properties" Info node in the Emacs Lisp Reference Manual for more +details. +++ ** New 'pop-up-frames' action alist entry for 'display-buffer'. diff --git a/src/window.c b/src/window.c index fe26311fbb2..0945b244319 100644 --- a/src/window.c +++ b/src/window.c @@ -5407,13 +5407,13 @@ shrink_mini_window (struct window *w) eassert (MINI_WINDOW_P (w)); + FRAME_WINDOWS_FROZEN (f) = false; if (delta > 0) { Lisp_Object root = FRAME_ROOT_WINDOW (f); struct window *r = XWINDOW (root); Lisp_Object grow; - FRAME_WINDOWS_FROZEN (f) = false; grow = call3 (Qwindow__resize_root_window_vertically, root, make_fixnum (delta), Qt); commit 5734047b812639c06c90eb3baf82ff502db59fb5 Author: Vladimir Kazanov Date: Sun Dec 24 11:13:10 2023 +0000 Support tooltips for fringe indicators * src/xdisp.c (note_fringe_highlight): New function. (note_mouse_highlight): Call it when the mouse is on the fringes. * src/frame.c (syms_of_frame) : DEFSYM them. * etc/NEWS: * doc/lispref/text.texi (Special Properties): * doc/lispref/display.texi (Other Display Specs): Document the new properties. * etc/TODO: Remove the todo item about this. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index f82c2fad14d..fd083083fd2 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5501,6 +5501,10 @@ specification. The optional @var{face} specifies the face whose colors are to be used for the bitmap display. @xref{Fringe Bitmaps}, for the details. +It also possible to add context help for fringe bitmaps through the +@code{show-help-function} mechanism by using @code{left-fringe-help} or +@code{right-fringe-help} text properties (@pxref{Special Properties}). + @item (space-width @var{factor}) This display specification affects all the space characters within the text that has the specification. It displays all of these spaces diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 18f0ee88fe5..3db82df49b3 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -3663,6 +3663,15 @@ non-@code{nil} @code{help-echo-inhibit-substitution} property, then it is displayed as-is by @code{show-help-function}, without being passed through @code{substitute-command-keys}. +@item left-fringe-help +@itemx right-fringe-help +@cindex help-echo text on fringes +If any visible text of a buffer line has @code{left-fringe-help} or +@code{right-fringe-help} string text property defined on it, then the +string will be displayed for a corresponding line's fringe through +@code{show-help-function} (@pxref{Help display}). This is useful when +used together with fringe cursors and bitmaps (@pxref{Fringes}). + @item keymap @cindex keymap of character @kindex keymap @r{(text property)} diff --git a/etc/NEWS b/etc/NEWS index e90c439d26c..97cac373750 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1847,6 +1847,12 @@ the handler code without unwinding the stack, such that we can record the backtrace and other dynamic state at the point of the error. See the Info node "(elisp) Handling Errors". ++++ +** Tooltips on fringes. +It is now possible to provide tooltips on fringes by adding special text +properties. See the "Special Properties" Info node in the Emacs Lisp +Reference Manual. + +++ ** New 'pop-up-frames' action alist entry for 'display-buffer'. This has the same effect as the variable of the same name and takes diff --git a/etc/TODO b/etc/TODO index 52c77ccc28d..21b504ad18b 100644 --- a/etc/TODO +++ b/etc/TODO @@ -172,10 +172,6 @@ Change them to use report-emacs-bug. **** lm-report-bug **** tramp-bug **** c-submit-bug-report - -** Allow fringe indicators to display a tooltip -Provide a help-echo property? - ** Add a defcustom that supplies a function to name numeric backup files Like 'make-backup-file-name-function' for non-numeric backup files. diff --git a/src/frame.c b/src/frame.c index abd6ef00901..ff99b0353af 100644 --- a/src/frame.c +++ b/src/frame.c @@ -6383,6 +6383,7 @@ syms_of_frame (void) DEFSYM (Qchild_frame_border_width, "child-frame-border-width"); DEFSYM (Qinternal_border_width, "internal-border-width"); DEFSYM (Qleft_fringe, "left-fringe"); + DEFSYM (Qleft_fringe_help, "left-fringe-help"); DEFSYM (Qline_spacing, "line-spacing"); DEFSYM (Qmenu_bar_lines, "menu-bar-lines"); DEFSYM (Qtab_bar_lines, "tab-bar-lines"); @@ -6390,6 +6391,7 @@ syms_of_frame (void) DEFSYM (Qname, "name"); DEFSYM (Qright_divider_width, "right-divider-width"); DEFSYM (Qright_fringe, "right-fringe"); + DEFSYM (Qright_fringe_help, "right-fringe-help"); DEFSYM (Qscreen_gamma, "screen-gamma"); DEFSYM (Qscroll_bar_background, "scroll-bar-background"); DEFSYM (Qscroll_bar_foreground, "scroll-bar-foreground"); diff --git a/src/xdisp.c b/src/xdisp.c index 140d71129f3..b4d57b5b6f2 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35730,6 +35730,59 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, } +/* Take proper action when mouse has moved to the window WINDOW, with + window-local x-position X and y-position Y. This is only used for + displaying user-defined fringe indicator help-echo messages. */ + +static void +note_fringe_highlight (Lisp_Object window, int x, int y, + enum window_part part) +{ + if (!NILP (help_echo_string)) + return; + + /* Find a message to display through the help-echo mechanism whenever + the mouse hovers over a fringe indicator. Both text properties and + overlays have to be checked. */ + + /* Check the text property symbol to use. */ + Lisp_Object sym; + if (part == ON_LEFT_FRINGE) + sym = Qleft_fringe_help; + else + sym = Qright_fringe_help; + + /* Translate windows coordinates into a vertical window position. */ + int hpos, vpos, area; + struct window *w = XWINDOW (window); + x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, 0, 0, &area); + + /* Get to the first glyph of a text row based on the vertical position + of the fringe. */ + struct glyph *glyph = MATRIX_ROW_GLYPH_START(w->current_matrix, vpos); + int glyph_num = MATRIX_ROW_USED(w->current_matrix, vpos); + + /* Check all glyphs while looking for fringe tooltips. */ + + /* NOTE: iterating over glyphs can only find text properties coming + from visible text. This means that zero-length overlays and + invisibile text are NOT inspected. */ + for (;glyph_num; glyph_num--, glyph++) + { + Lisp_Object pos = make_fixnum(glyph->charpos); + Lisp_Object help_echo = Qnil; + + if (STRINGP(glyph->object) || BUFFERP(glyph->object)) + help_echo = get_char_property_and_overlay (pos, sym, glyph->object, NULL); + + if (STRINGP (help_echo)) + { + help_echo_string = help_echo; + break; + } + } +} + /* EXPORT: Take proper action when the mouse has moved to position X, Y on frame F with regards to highlighting portions of display that have @@ -35957,8 +36010,12 @@ note_mouse_highlight (struct frame *f, int x, int y) } else cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor; - else if (part == ON_LEFT_FRINGE || part == ON_RIGHT_FRINGE - || part == ON_VERTICAL_SCROLL_BAR + else if (part == ON_LEFT_FRINGE || part == ON_RIGHT_FRINGE) + { + cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor; + note_fringe_highlight (window, x, y, part); + } + else if (part == ON_VERTICAL_SCROLL_BAR || part == ON_HORIZONTAL_SCROLL_BAR) cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor; else commit 8b210a636fe426f47bccdb111af61d6310755dde Author: Eli Zaretskii Date: Sat Apr 13 11:52:57 2024 +0300 ; Improve documentation of tree-sitter "things" * doc/lispref/parsing.texi (User-defined Things): Fix text, punctuation, and markup. (Tree-sitter Major Modes): Add the missing "things" reference. * etc/NEWS: Fix "thing"-related entries. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 49db6585e88..55ba10bb41b 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1522,43 +1522,46 @@ pattern-matching, which can be found at @node User-defined Things @section User-defined ``Things'' and Navigation -It's often useful to be able to identify and find certain ``things'' in +@cindex user-defined things, with tree-sitter parsing + +It's often useful to be able to identify and find certain @dfn{things} in a buffer, like function and class definitions, statements, code blocks, strings, comments, etc. Emacs allows users to define what kind of -tree-sitter node are what ``thing''. This enables handy features like -jumping to the next function, marking the code block at point, or -transposing two function arguments. +tree-sitter node corresponds to a ``thing''. This enables handy +features like jumping to the next function, marking the code block at +point, or transposing two function arguments. The ``things'' feature in Emacs is independent of the pattern matching -feature of tree-sitter, comparatively less powerful, but more suitable -for navigation and traversing the parse tree. +feature of tree-sitter, and comparatively less powerful, but more +suitable for navigation and traversing the parse tree. -Users can define things with @var{treesit-thing-settings}. +You can define things with @var{treesit-thing-settings}. @defvar treesit-thing-settings This is an alist of thing definitions for each language. The key of each entry is a language symbol, and the value is a list of thing -definitions of the form @w{@code{(@var{thing} @var{pred})}}. - +definitions of the form @w{@code{(@var{thing} @var{pred})}}, where @var{thing} is a symbol representing the thing, like @code{defun}, -@code{sexp}, or @code{sentence}; @var{pred} specifies what kind of -tree-sitter node is the @var{thing}. +@code{sexp}, or @code{sentence}; and @var{pred} specifies what kind of +tree-sitter node is this @var{thing}. @var{pred} can be a regexp string that matches the type of the node; it can be a function that takes a node as the argument and returns a -boolean that indicates whether the node qualifies as the thing; it can +boolean that indicates whether the node qualifies as the thing; or it can be a cons @w{@code{(@var{regexp} . @var{fn})}}, which is a combination -of a regexp and a function---the node has to match both to qualify as the -thing. +of a regular expression @var{regexp} and a function @var{fn}---the node +has to match both the @var{regexp} and to satisfy @var{fn} to qualify as +the thing. @var{pred} can also be recursively defined. It can be @w{@code{(or -@var{pred}...)}}, meaning satisfying any one of the @var{pred}s +@var{pred}@dots{})}}, meaning that satisfying any one of the @var{pred}s qualifies the node as the thing. It can be @w{@code{(not @var{pred})}}, -meaning not satisfying @var{pred} qualifies the node. +meaning that not satisfying @var{pred} qualifies the node. Finally, @var{pred} can refer to other @var{thing}s defined in this list. For example, @w{@code{(or sexp sentence)}} defines something -that's either a @code{sexp} or a @code{sentence}. +that's either a @code{sexp} thing or a @code{sentence} thing, as defined +by some other rule in the alist. Here's an example @var{treesit-thing-settings} for C and C++: @@ -1577,73 +1580,74 @@ Here's an example @var{treesit-thing-settings} for C and C++: @end group @end example -Note that this example is modified for demonstration and isn't exactly -how C and C++ mode define things. +@noindent +Note that this example is modified for didactical purposes, and isn't +exactly how C and C@t{++} modes define things. @end defvar -The next section lists a few functions that take advantage of the thing -definitions. Besides these functions, some other functions listed -elsewhere also utilizes the thing feature, e.g., tree-traversing -functions like @code{treesit-search-forward}, -@code{treesit-induce-sparse-tree}, etc. +The rest of this section lists a few functions that take advantage of +the thing definitions. Besides the functions below, some other +functions listed elsewhere also utilize the thing feature, e.g., +tree-traversing functions like @code{treesit-search-forward}, +@code{treesit-induce-sparse-tree}, etc. @xref{Retrieving Nodes}. -@defun treesit-thing-prev pos thing -This function returns the first node before @var{pos} that's a -@var{thing}. If no such node exists, it returns @code{nil}. It's -guaranteed that, if a node is returned, the node's end position is less -or equal to @var{pos}. In other words, this function never return a -node that encloses @var{pos}. +@defun treesit-thing-prev position thing +This function returns the first node before @var{position} that is the +specified @var{thing}. If no such node exists, it returns @code{nil}. +It's guaranteed that, if a node is returned, the node's end position is +less or equal to @var{position}. In other words, this function never +returns a node that encloses @var{position}. @var{thing} can be either a thing symbol like @code{defun}, or simply a thing definition like @code{"function_definition"}. @end defun -@defun treesit-thing-next pos thing -This function is similar to @code{treesit-thing-prev}, only that it -returns the first node @emph{after} @var{pos} that's a @var{thing}. And -it guarantees that if a node is returned, the node's start position is -be greater or equal to @var{pos}. +@defun treesit-thing-next position thing +This function is similar to @code{treesit-thing-prev}, only it returns +the first node @emph{after} @var{position} that's the @var{thing}. It +also guarantees that if a node is returned, the node's start position is +greater or equal to @var{position}. @end defun -@defun treesit-navigate-thing pos arg side thing &optional tactic +@defun treesit-navigate-thing position arg side thing &optional tactic This function builds upon @code{treesit-thing-prev} and @code{treesit-thing-next} and provides functionality that a navigation -command would find useful. +command would find useful. It returns the position after moving across +@var{arg} instances of @var{thing} from @var{position}. If +there aren't enough things to navigate across, it returns nil. The +function doesn't move point. -It returns the position after navigating @var{arg} steps from @var{pos}, -without actually moving point. If there aren't enough things to -navigate across, it returns nil. - -A positive @var{arg} means moving forward that many steps; negative -means moving backward. If @var{side} is @code{beg}, this function stops -at the beginning of the thing; if @code{end}, stop at the end. +A positive @var{arg} means moving forward that many instances of +@var{thing}; negative @var{arg} means moving backward. If @var{side} is +@code{beg}, this function stops at the beginning of @var{thing}; if +@code{end}, stop at the end of @var{thing}. Like in @code{treesit-thing-prev}, @var{thing} can be a thing symbol defined in @var{treesit-thing-settings}, or a thing definition. -@var{tactic} determines how does this function move between things. -@var{tactic} can be @code{nested}, @code{top-level}, @code{restricted}, -or @code{nil}. @code{nested} or @code{nil} means normal nested -navigation: first try to move across siblings; if there aren't any -siblings left in the current level, move to the parent, then it's -siblings, and so on. @code{top-level} means only navigate across -top-level things and ignore nested things. @code{restricted} means -movement is restricted within the thing that encloses @var{pos}, if -there is one such thing. This tactic is useful for the commands that -want to stop at the current nest level and not move up. +@var{tactic} determines how this function moves between things. It can +be @code{nested}, @code{top-level}, @code{restricted}, or @code{nil}. +@code{nested} or @code{nil} means normal nested navigation: first try to +move across siblings; if there aren't any siblings left in the current +level, move to the parent, then its siblings, and so on. +@code{top-level} means only navigate across top-level things and ignore +nested things. @code{restricted} means movement is restricted within +the thing that encloses @var{position}, if there is such a thing. This +tactic is useful for commands that want to stop at the current nesting +level and not move up. @end defun -@defun treesit-thing-at pos thing &optional strict -This function returns the smallest node that's a @var{thing} and -encloses @var{pos}; if there's no such node, return nil. +@defun treesit-thing-at position thing &optional strict +This function returns the smallest node that's the @var{thing} and +encloses @var{position}; if there's no such node, it returns @code{nil}. -The returned node must enclose @var{pos}, i.e., its start position is -less or equal to @var{pos}, and it's end position is greater or equal to -@var{pos}. +The returned node must enclose @var{position}, i.e., its start position is +less or equal to @var{position}, and it's end position is greater or equal to +@var{position}. If @var{strict} is non-@code{nil}, this function uses strict comparison, -i.e., start position must be strictly greater than @var{pos}, and end -position must be strictly less than @var{pos}. +i.e., start position must be strictly greater than @var{position}, and end +position must be strictly less than @var{position}. @var{thing} can be either a thing symbol defined in @var{treesit-thing-settings}, or a thing definition. @@ -1654,14 +1658,15 @@ position must be strictly less than @var{pos}. @findex treesit-thing-at-point There are also some convenient wrapper functions. @code{treesit-beginning-of-thing} moves point to the beginning of a -thing, @code{treesit-beginning-of-thing} to the end of a thing. +thing, @code{treesit-end-of-thing} moves to the end of a thing, and @code{treesit-thing-at-point} returns the thing at point. -There are defun commands that specifically use the @code{defun} +There are also defun commands that specifically use the @code{defun} definition, like @code{treesit-beginning-of-defun}, @code{treesit-end-of-defun}, and @code{treesit-defun-at-point}. In addition, these functions use @var{treesit-defun-tactic} as the -navigation tactic. They are described in more detail in other sections. +navigation tactic. They are described in more detail in other sections +(@pxref{Tree-sitter Major Modes}). @node Multiple Languages @section Parsing Text in Multiple Languages @@ -2056,6 +2061,13 @@ non-@code{nil}, it sets up Imenu. @item If @code{treesit-outline-predicate} (@pxref{Outline Minor Mode}) is non-@code{nil}, it sets up Outline minor mode. + +@item +If @code{sexp} and/or @code{sentence} are defined in +@code{treesit-thing-settings} (@pxref{User-defined Things}), it enables +navigation commands that move, respectively, by sexps and sentences by +defining variables such as @code{forward-sexp-function} and +@code{forward-sentence-function}. @end itemize @c TODO: Add treesit-thing-settings stuff once we finalize it. diff --git a/etc/NEWS b/etc/NEWS index da809096d94..e90c439d26c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2411,34 +2411,38 @@ correctly UTF-8 encoded. *** The parser and encoder now accept arbitrarily large integers. Previously, they were limited to the range of signed 64-bit integers. -** New tree-sitter functions and variables for defining and using "things" +** New tree-sitter functions and variables for defining and using "things". +++ *** New variable 'treesit-thing-settings'. - -New variable that allows users to define "things" like 'defun', 'text', -'sexp', for navigation commands and tree-traversal functions. +It allows modes to define "things" like 'defun', 'text', 'sexp', and +'sentence' for navigation commands and tree-traversal functions. +++ -*** New navigation functions 'treesit-thing-prev', 'treesit-thing-next', 'treesit-navigate-thing', 'treesit-beginning-of-thing', 'treesit-end-of-thing'. +*** New functions for navigating "things". +There are new navigation functions 'treesit-thing-prev', +'treesit-thing-next', 'treesit-navigate-thing', +'treesit-beginning-of-thing', and 'treesit-end-of-thing'. +++ *** New functions 'treesit-thing-at', 'treesit-thing-at-point'. +++ -*** Tree-tarversing functions 'treesit-search-subtree', 'treesit-search-forward', 'treesit-search-forward-goto', 'treesit-induce-sparse-tree' now accepts more kinds of predicates. - -Now users can use thing symbols (defined in 'treesit-thing-settings'), -and any thing definitions for the predicate argument. +*** Tree-traversing functions. +The functions 'treesit-search-subtree', 'treesit-search-forward', +'treesit-search-forward-goto', and 'treesit-induce-sparse-tree' now +accept more kinds of predicates. Lisp programs can now use thing +symbols (defined in 'treesit-thing-settings') and any thing definitions +for the predicate argument. -** Other tree-sitter function and variable changes +** Other tree-sitter function and variable changes. +++ -*** 'treesit-parser-list' now takes additional optional arguments, LANGUAGE and TAG. - -If LANGUAGE is given, only return parsers for that language. If TAG is -given, only return parsers with that tag. Note that passing nil as tag -doesn't mean return all parsers, but rather "all parsers with no tags". +*** 'treesit-parser-list' now takes additional optional arguments. +The additional arguments are LANGUAGE and TAG. If LANGUAGE is given, +only return parsers for that language. If TAG is given, only return +parsers with that tag. Note that passing nil as tag doesn't mean return +all parsers, but rather "all parsers with no tags". * Changes in Emacs 30.1 on Non-Free Operating Systems commit f0300fb0597225762ac6e62eeec4e223a7ad1df9 Author: Basil L. Contovounesios Date: Sat Apr 13 10:36:50 2024 +0200 ; Tweak "(emacs)Bug Reference" formatting/wording. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 14bdbc57f14..b22aa018292 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -3333,29 +3333,30 @@ merge requests resulting in different URLs. @vindex bug-reference-auto-setup-functions If @code{bug-reference-mode} is activated, -@code{bug-reference-mode-hook} has been run and still -@code{bug-reference-bug-regexp}, and @code{bug-reference-url-format} -aren't both set, it'll try to setup suitable values for these two -variables itself by calling the functions in -@code{bug-reference-auto-setup-functions} one after the other until -one is able to set the variables. +@code{bug-reference-mode-hook} has been run, and either +@code{bug-reference-bug-regexp} or @code{bug-reference-url-format} is +still @code{nil}, the mode will try to automatically find a suitable +value for these two variables by calling the functions in +@code{bug-reference-auto-setup-functions} one by one until one +succeeds. @vindex bug-reference-setup-from-vc-alist @vindex bug-reference-forge-alist @vindex bug-reference-setup-from-mail-alist @vindex bug-reference-setup-from-irc-alist - Right now, there are three types of setup functions. +Right now, there are three types of setup functions. + @enumerate @item Setup for version-controlled files configurable by the variables @code{bug-reference-forge-alist}, and @code{bug-reference-setup-from-vc-alist}. The defaults are able to -setup GNU projects where @url{https://debbugs.gnu.org} is used as +set up GNU projects where @url{https://debbugs.gnu.org} is used as issue tracker and issues are usually referenced as @code{bug#13} (but -many different notations are considered, too), and several kinds of -modern software forges such as GitLab, Gitea, SourceHut, or GitHub. -If you deploy a self-hosted instance of such a forge, the easiest way -to tell bug-reference about it is through +many different notations are considered, too), as well as several +other kinds of software forges such as GitLab, Gitea, SourceHut, and +GitHub. If you deploy a self-hosted instance of such a forge, the +easiest way to tell bug-reference about it is through @code{bug-reference-forge-alist}. @item @@ -3372,7 +3373,7 @@ Rcirc, @xref{Top, Rcirc,, rcirc, The Rcirc Manual}, and ERC, @end enumerate For almost all of those modes, it's enough to simply enable -@code{bug-reference-mode}, only Rmail requires a slightly different +@code{bug-reference-mode}; only Rmail requires a slightly different setup. @smallexample @@ -3403,33 +3404,35 @@ to be performed whenever another messages is displayed. @heading Adding support for third-party packages @vindex bug-reference-auto-setup-functions -Adding support for bug-reference' auto-setup is usually quite -straight-forward: write a setup function of zero arguments which +Adding support for bug-reference auto-setup is usually quite +straightforward: write a setup function of zero arguments which gathers the required information (e.g., List-Id/To/From/Cc mail header values in the case of a MUA), and then calls one of the following helper functions: + @itemize @bullet @item -@code{bug-reference-maybe-setup-from-vc} which does the setup -according to @code{bug-reference-setup-from-vc-alist}, +@code{bug-reference-maybe-setup-from-vc}, which does the setup +according to @code{bug-reference-setup-from-vc-alist}; @item -@code{bug-reference-maybe-setup-from-mail} which does the setup -according to @code{bug-reference-setup-from-mail-alist}, +@code{bug-reference-maybe-setup-from-mail}, which does the setup +according to @code{bug-reference-setup-from-mail-alist}; and @item -and @code{bug-reference-maybe-setup-from-irc} which does the setup +@code{bug-reference-maybe-setup-from-irc}, which does the setup according to @code{bug-reference-setup-from-irc-alist}. @end itemize -A setup function should return non-@code{nil} if it could setup bug-reference -mode which is the case if the last thing the function does is calling -one of the helper functions above. + +A setup function should return non-@code{nil} if it could set up +bug-reference mode, which is the case if the last thing the function +does is call one of the helper functions above. Finally, the setup function has to be added to @code{bug-reference-auto-setup-functions}. Note that these auto-setup functions should check as a first step if -they are applicable, e.g., by checking the @code{major-mode} value. +they are applicable, e.g., by checking the value of @code{major-mode}. @heading Integration with the debbugs package commit 6c721af9c8ee2229af57491cc2833f6743c8ddab Author: Philip Kaludercic Date: Thu Apr 11 09:00:50 2024 +0200 Allow 'help-quick' to use a non-global keymap * lisp/help.el (help-quick-sections): Mention 'help-quick-use-map' in docstring. (help-quick-use-map): Add new variable, defaulting to the global-map. (help-quick): Use new variable. diff --git a/lisp/help.el b/lisp/help.el index e23dd8ce0ae..d4e39f04e53 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -171,9 +171,15 @@ Value should be a list of elements, each element should of the form (GROUP-NAME (COMMAND . DESCRIPTION) (COMMAND . DESCRIPTION)...) -where GROUP-NAME is the name of the group of the commands, -COMMAND is the symbol of a command and DESCRIPTION is its short -description, 10 to 15 characters at most.") +where GROUP-NAME is the name of the group of the commands, COMMAND is +the symbol of a command and DESCRIPTION is its short description, 10 to +15 characters at most. The bindings for COMMAND are looked up from the +keymap specified in `help-quick-use-map'.") + +(defvar help-quick-use-map global-map + "Keymap that `help-quick' should use to lookup bindings. +Avoid changing the global value of this variable. Instead bind a +different map dynamically.") (declare-function prop-match-value "text-property-search" (match)) @@ -193,7 +199,7 @@ the documentation of the command bound to that key sequence." (let ((max-key-len 0) (max-cmd-len 0) keys) (dolist (ent (reverse (cdr section))) (catch 'skip - (let* ((bind (where-is-internal (car ent) nil t)) + (let* ((bind (where-is-internal (car ent) help-quick-use-map t)) (key (if bind (propertize (key-description bind) commit 5f6834ab9765943be07dfab6454c37375729f778 Author: Philip Kaludercic Date: Thu Apr 11 08:44:46 2024 +0200 ; Fix typo in 'help-quick-sections' docstring diff --git a/lisp/help.el b/lisp/help.el index 1ef46e394f3..e23dd8ce0ae 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -173,7 +173,7 @@ Value should be a list of elements, each element should of the form where GROUP-NAME is the name of the group of the commands, COMMAND is the symbol of a command and DESCRIPTION is its short -description, 10 to 15 char5acters at most.") +description, 10 to 15 characters at most.") (declare-function prop-match-value "text-property-search" (match)) commit 02e795738b8877f6cf07f5ad2105449d7eb41000 Author: Eli Zaretskii Date: Sat Apr 13 11:15:18 2024 +0300 ; * src/alloc.c (process_mark_stack): Fix commentary. diff --git a/src/alloc.c b/src/alloc.c index 2ffd2415447..6779d0ca9ce 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7421,7 +7421,9 @@ process_mark_stack (ptrdiff_t base_sp) /* If the value is forwarded to a buffer or keyboard field, these are marked when we see the corresponding object. And if it's forwarded to a C variable, either it's not - a Lisp_Object var, or it's staticpro'd already. */ + a Lisp_Object var, or it's staticpro'd already, or it's + reachable from font_style_table which is also + staticpro'd. */ break; default: emacs_abort (); } commit d5d61618c89899bd082cd29fd81dfb7cd88ea8b8 Author: john muhl Date: Wed Mar 13 08:35:08 2024 -0500 Mark Flymake regions more accurately in 'lua-ts-mode' * lisp/progmodes/lua-ts-mode.el (lua-ts-flymake-luacheck): Use the end position provided by Luacheck rather than relying on 'thing-at-point' to guess where the end should be. (Bug#70167) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 407ef230c32..45ea8ec9a81 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -35,7 +35,6 @@ (require 'treesit) (eval-when-compile - (require 'cl-lib) (require 'rx)) (declare-function treesit-induce-sparse-tree "treesit.c") @@ -544,32 +543,32 @@ Calls REPORT-FN directly." (eq proc lua-ts--flymake-process)) (with-current-buffer (process-buffer proc) (goto-char (point-min)) - (cl-loop - while (search-forward-regexp - (rx (seq bol - (0+ alnum) ":" - (group (1+ digit)) ":" - (group (1+ digit)) "-" - (group (1+ digit)) ": " - (group (0+ nonl)) - eol)) - nil t) - for (beg . end) = (flymake-diag-region - source - (string-to-number (match-string 1)) - (string-to-number (match-string 2))) - for msg = (match-string 4) - for type = (if (string-match "^(W" msg) - :warning - :error) - when (and beg end) - collect (flymake-make-diagnostic source - beg - end - type - msg) - into diags - finally (funcall report-fn diags))) + (let (diags) + (while (search-forward-regexp + (rx bol (0+ alnum) ":" + (group (1+ digit)) ":" + (group (1+ digit)) "-" + (group (1+ digit)) ": " + (group (0+ nonl)) eol) + nil t) + (let* ((beg + (car (flymake-diag-region + source + (string-to-number (match-string 1)) + (string-to-number (match-string 2))))) + (end + (cdr (flymake-diag-region + source + (string-to-number (match-string 1)) + (string-to-number (match-string 3))))) + (msg (match-string 4)) + (type (if (string-prefix-p "(W" msg) + :warning + :error))) + (push (flymake-make-diagnostic + source beg end type msg) + diags))) + (funcall report-fn diags))) (flymake-log :warning "Canceling obsolete check %s" proc)) (kill-buffer (process-buffer proc))))))) (process-send-region lua-ts--flymake-process (point-min) (point-max)) commit 71f8b2c3242b9b9455e9c6f25ad99ea900a1422f Author: Eli Zaretskii Date: Sat Apr 13 10:52:55 2024 +0300 Fix Icalendar export with ISO dates * lisp/calendar/icalendar.el (icalendar--datestring-to-isodate): Accept dashes in ISO-style numeric dates. Patch by Erwan Hingant . (Bug#69894) * test/lisp/calendar/icalendar-tests.el (icalendar--datestring-to-isodate): Add a test for dashes in ISO-style numeric dates. diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index d7e62e1baf3..95b04969075 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -895,8 +895,8 @@ it uses the current calendar date style." (save-match-data (cond ( ;; iso-style numeric date (string-match (concat "\\s-*" - "\\([0-9]\\{4\\}\\)[ \t/]\\s-*" - "0?\\([1-9][0-9]?\\)[ \t/]\\s-*" + "\\([0-9]\\{4\\}\\)[ \t/-]\\s-*" + "0?\\([1-9][0-9]?\\)[ \t/-]\\s-*" "0?\\([1-9][0-9]?\\)") datestring) (setq year (read (substring datestring (match-beginning 1) diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 39ad735a789..32c06cbc533 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -368,6 +368,9 @@ END:VTIMEZONE (icalendar--datestring-to-isodate "2008 05 31"))) (should (string= "20080602" (icalendar--datestring-to-isodate "2008 05 31" 2))) + ;; Bug#69894 + (should (string= "20240319" + (icalendar--datestring-to-isodate "2024-03-19"))) ;; numeric european (setq calendar-date-style 'european) commit 4fc37710788cdab9ebf4264636999ba999a59547 Author: Po Lu Date: Sat Apr 13 11:28:23 2024 +0800 Fix task-switching failures on Android 2.3 * java/org/gnu/emacs/EmacsWindowManager.java (registerWindow): Don't specify F_A_MULTIPLE_TASK on Android 4.4 and earlier. diff --git a/java/org/gnu/emacs/EmacsWindowManager.java b/java/org/gnu/emacs/EmacsWindowManager.java index e41b4e068a7..a193d49d0ec 100644 --- a/java/org/gnu/emacs/EmacsWindowManager.java +++ b/java/org/gnu/emacs/EmacsWindowManager.java @@ -176,14 +176,20 @@ && isWindowEligible (consumer, window)) intent = new Intent (EmacsService.SERVICE, EmacsMultitaskActivity.class); - intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK - | Intent.FLAG_ACTIVITY_MULTIPLE_TASK); + /* FLAG_ACTIVITY_MULTIPLE_TASK would appear appropriate, but that + is not so: on Android 2.3 and earlier, this flag combined with + FLAG_ACTIVITY_NEW_TASK prompts the task switcher to create a + new instance of EmacsMultitaskActivity, rather than return to + an existing instance, and is entirely redundant, inasmuch as + only one multitasking task can exist at any given moment. */ + intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK); /* Intent.FLAG_ACTIVITY_NEW_DOCUMENT is lamentably unavailable on older systems than Lolipop. */ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.LOLLIPOP) { - intent.addFlags (Intent.FLAG_ACTIVITY_NEW_DOCUMENT); + intent.addFlags (Intent.FLAG_ACTIVITY_NEW_DOCUMENT + | Intent.FLAG_ACTIVITY_MULTIPLE_TASK); /* Bind this window to the activity in advance, i.e., before its creation, so that its ID will be recorded in the RecentTasks commit e8adb8cf5a51ef172fb07786b71e3140b9358764 Author: Stefan Monnier Date: Fri Apr 12 21:54:53 2024 -0400 (elisp-tests-syntax-propertize): New test for bug#24542 * test/lisp/progmodes/elisp-mode-tests.el (elisp-tests-syntax-propertize): New test. diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 1d1ef9981e5..591c32a8271 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -1131,5 +1131,14 @@ evaluation of BODY." (emacs-lisp-mode) (indent-region (point-min) (point-max))))) +(ert-deftest elisp-tests-syntax-propertize () + (with-temp-buffer + (emacs-lisp-mode) + (insert "(a '@)") ;bug#24542 + (should (equal (scan-sexps (+ (point-min) 3) 1) (1- (point-max)))) + (erase-buffer) + (insert "(a ,@)") + (should-error (scan-sexps (+ (point-min) 3) 1)))) + (provide 'elisp-mode-tests) ;;; elisp-mode-tests.el ends here commit c26261c027ef7594427d477208b8126d6e4982bd Author: Paul Eggert Date: Fri Apr 12 13:14:29 2024 -0700 rcs2log now groks add-log-time-zone rule * lib-src/rcs2log (extractTZ): Adjust to renaming of change-log-time-zone-rule to add-log-time-zone rule, by allowing either spelling. diff --git a/lib-src/rcs2log b/lib-src/rcs2log index 61301e7246d..94234d01c98 100755 --- a/lib-src/rcs2log +++ b/lib-src/rcs2log @@ -261,10 +261,10 @@ case $rlogfile in if test -s "$changelog" then extractTZ=' - /^.*change-log-time-zone-rule['"$tab"' ]*:['"$tab"' ]*"\([^"]*\)".*/{ + /^.*-log-time-zone-rule['"$tab"' ]*:['"$tab"' ]*"\([^"]*\)".*/{ s//\1/; p; q } - /^.*change-log-time-zone-rule['"$tab"' ]*:['"$tab"' ]*t.*/{ + /^.*-log-time-zone-rule['"$tab"' ]*:['"$tab"' ]*t.*/{ s//UTC0/; p; q } ' commit 648b7bf7e22577c2f917e389694a76ce1f42dc0e Author: Stefan Monnier Date: Fri Apr 12 13:28:45 2024 -0400 (emacs-lisp-mode-syntax-table): Fix bug#24542 * lisp/progmodes/elisp-mode.el (emacs-lisp-mode-syntax-table): Remove `p` from the flags of `@`. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 3383841391d..84814c9eaac 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -40,9 +40,10 @@ It has `lisp-mode-abbrev-table' as its parent." (defvar emacs-lisp-mode-syntax-table (let ((table (make-syntax-table lisp-data-mode-syntax-table))) - ;; These are redundant, now. - ;;(modify-syntax-entry ?\[ "(] " table) - ;;(modify-syntax-entry ?\] ")[ " table) + ;; Remove the "p" flag from the entry of `@' because we use instead + ;; `syntax-propertize' to take care of `,@', which is more precise. + ;; FIXME: We should maybe do the same in other Lisp modes? (bug#24542) + (modify-syntax-entry ?@ "_" table) table) "Syntax table used in `emacs-lisp-mode'.") commit 5bd4d458676c458d6b534ea1c74cf6f0c1899ea6 Author: Juri Linkov Date: Fri Apr 12 19:39:49 2024 +0300 * lisp/buff-menu.el: Improve 'Buffer-menu-group-by-mode' (bug#70150). (Buffer-menu-group-by): Replace function-item with const better suitable for Customization UI. (Buffer-menu-group-by-mode): Use 'mouse-buffer-menu-mode-groups' to group buffers by mode. diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index ec5337e3fda..d59c5b6cf21 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -107,10 +107,10 @@ The default options can group by a mode, and by a root directory of a project or just `default-directory'. If this is nil, buffers are not divided into groups." :type '(choice (const :tag "No grouping" nil) - (function-item :tag "Group by mode" - Buffer-menu-group-by-mode) - (function-item :tag "Group by project root or directory" - Buffer-menu-group-by-root) + (const :tag "Group by mode" + Buffer-menu-group-by-mode) + (const :tag "Group by project root or directory" + Buffer-menu-group-by-root) (function :tag "Custom function")) :group 'Buffer-menu :version "30.1") @@ -798,7 +798,11 @@ See more at `Buffer-menu-filter-predicate'." (t ""))) (defun Buffer-menu-group-by-mode (entry) - (concat "* " (aref (cadr entry) 5))) + (let ((mode (aref (cadr entry) 5))) + (concat "* " (or (cdr (seq-find (lambda (group) + (string-match-p (car group) mode)) + mouse-buffer-menu-mode-groups)) + mode)))) (declare-function project-root "project" (project)) (defun Buffer-menu-group-by-root (entry) commit 414f8d02c1a361fa780e55fcf0f260fe00a9a62d Author: Juri Linkov Date: Fri Apr 12 19:35:55 2024 +0300 New user option 'tab-line-tabs-buffer-group-function' * lisp/tab-line.el (tab-line-tabs-buffer-group-function): Turn defvar into defcustom with the default value 'tab-line-tabs-buffer-group-by-mode'. (tab-line-tabs-buffer-group-by-mode): New function with body from 'tab-line-tabs-buffer-group-name'. (tab-line-tabs-buffer-group-by-project): New function. (tab-line-tabs-buffer-groups): Use fallback name "No group" instead of "All". diff --git a/etc/NEWS b/etc/NEWS index ed5db3a01a3..da809096d94 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -364,6 +364,11 @@ By default it contains a keybinding 'C-TAB' to switch tabs, but only when 'C-TAB' is not bound globally. You can unbind it if it conflicts with 'C-TAB' in other modes. +--- +*** New user option 'tab-line-tabs-buffer-group-function'. +It provides two choices to group tab buffers by major mode +and by project name. + +++ ** New optional argument for modifying directory-local variables. The commands 'add-dir-local-variable', 'delete-dir-local-variable' and diff --git a/lisp/tab-line.el b/lisp/tab-line.el index fd18e7b7909..54e9ee16243 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -342,8 +342,7 @@ returns a list of buffers associated with the selected window. When `tab-line-tabs-mode-buffers', return a list of buffers with the same major mode as the current buffer. When `tab-line-tabs-buffer-groups', return a list of buffers -grouped either by `tab-line-tabs-buffer-group-function', when set, -or by `tab-line-tabs-buffer-groups'." +grouped by `tab-line-tabs-buffer-group-function'." :type '(choice (const :tag "Window buffers" tab-line-tabs-window-buffers) (const :tag "Same mode buffers" @@ -377,10 +376,29 @@ Used only for `tab-line-tabs-mode-buffers' and `tab-line-tabs-buffer-groups'.") (derived-mode-p mode))) (funcall tab-line-tabs-buffer-list-function))))) -(defvar tab-line-tabs-buffer-group-function nil +(defcustom tab-line-tabs-buffer-group-function + #'tab-line-tabs-buffer-group-by-mode "Function to add a buffer to the appropriate group of tabs. Takes a buffer as arg and should return a group name as a string. -If the return value is nil, the buffer should be filtered out.") +If the return value is nil, the buffer has no group, so \"No group\" +is displayed instead of a group name and the buffer is not grouped +together with other buffers. +If the value is `tab-line-tabs-buffer-group-by-mode', +use mode-to-group mappings in `tab-line-tabs-buffer-groups' +to group by major mode. If the value is +`tab-line-tabs-buffer-group-by-project' use the project name +as a group name." + :type '(choice (const :tag "Group by mode" + tab-line-tabs-buffer-group-by-mode) + (const :tag "Group by project name" + tab-line-tabs-buffer-group-by-project) + (function :tag "Custom function")) + :initialize 'custom-initialize-default + :set (lambda (sym val) + (set-default sym val) + (force-mode-line-update)) + :group 'tab-line + :version "30.1") (defvar tab-line-tabs-buffer-group-sort-function nil "Function to sort buffers in a group.") @@ -395,16 +413,27 @@ If the major mode's name matches REGEXP, it belongs to GROUPNAME. The default is for each major mode to have a separate group named the same as the mode.") +(defun tab-line-tabs-buffer-group-by-mode (&optional buffer) + "Group tab buffers by major mode." + (let ((mode (if buffer (with-current-buffer buffer + (format-mode-line mode-name)) + (format-mode-line mode-name)))) + (or (cdr (seq-find (lambda (group) + (string-match-p (car group) mode)) + tab-line-tabs-buffer-groups)) + mode))) + +(declare-function project-name "project" (project)) +(defun tab-line-tabs-buffer-group-by-project (&optional buffer) + "Group tab buffers by project name." + (with-current-buffer buffer + (if-let ((project (project-current))) + (project-name project) + "No project"))) + (defun tab-line-tabs-buffer-group-name (&optional buffer) (if (functionp tab-line-tabs-buffer-group-function) - (funcall tab-line-tabs-buffer-group-function buffer) - (let ((mode (if buffer (with-current-buffer buffer - (format-mode-line mode-name)) - (format-mode-line mode-name)))) - (or (cdr (seq-find (lambda (group) - (string-match-p (car group) mode)) - tab-line-tabs-buffer-groups)) - mode)))) + (funcall tab-line-tabs-buffer-group-function buffer))) (defun tab-line-tabs-buffer-groups () "Return a list of tabs that should be displayed in the tab line. @@ -436,7 +465,7 @@ generate the group name." (let* ((window-parameter (window-parameter nil 'tab-line-group)) (group-name (tab-line-tabs-buffer-group-name (current-buffer))) - (group (prog1 (or window-parameter group-name "All") + (group (prog1 (or window-parameter group-name "No group") (when (equal window-parameter group-name) (set-window-parameter nil 'tab-line-group nil)))) (group-tab `(tab commit 2fc7e21f5e75ea6b00d6f7344335f44f5663d955 Author: Michael Albinus Date: Fri Apr 12 15:51:26 2024 +0200 ; * etc/NEWS: Fix typo. diff --git a/etc/NEWS b/etc/NEWS index 30b1cceb2cb..ed5db3a01a3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1777,7 +1777,7 @@ values. +++ ** Conversion of strings to and from byte-arrays works with multibyte strings. The functions 'dbus-string-to-byte-array' and -'dbus-byte-array-to-string}' now accept and return multibyte Lisp +'dbus-byte-array-to-string' now accept and return multibyte Lisp strings, encoding to UTF-8 and decoding from UTF-8 internally. This means that the argument to 'dbus-byte-array-to-string' must be a valid UTF-8 byte sequence, and the optional parameter MULTIBYTE of commit f93df59e8c9038a10992b71bfd6beeda70f806dd Author: Eli Zaretskii Date: Fri Apr 12 14:26:27 2024 +0300 ; Fix documentation of a recent change in dbus.el (bug#70301) * lisp/net/dbus.el (dbus-string-to-byte-array) (dbus-byte-array-to-string): * etc/NEWS: * doc/misc/dbus.texi (Type Conversion): Fix documentation of these two D-Bus functions. diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index c0a478d6ff6..e5d867acd40 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -1083,8 +1083,8 @@ elements of this array. Example: @defun dbus-string-to-byte-array string Sometimes, D-Bus methods require as input parameter an array of bytes, -instead of a string. If it is guaranteed, that @var{string} is a -UTF-8 string, this function performs the conversion. Example: +instead of a string. This function converts @var{string} into an array +of bytes of the UTF-8 encoding of @var{string}. Example: @lisp (dbus-string-to-byte-array "/etc/hosts") @@ -1156,8 +1156,9 @@ The signal @code{PropertyModified}, discussed as an example in @defun dbus-byte-array-to-string byte-array If a D-Bus method or signal returns an array of bytes, which are known -to represent a UTF-8 string, this function converts @var{byte-array} -to the corresponding UTF-8 string. Example: +to represent a UTF-8 string, this function converts @var{byte-array} to +the corresponding Lisp string. The contents of @var{byte-array} should +be the byte sequence of a UTF-8 encoded string. Example: @lisp (dbus-byte-array-to-string '(47 101 116 99 47 104 111 115 116 115)) diff --git a/etc/NEWS b/etc/NEWS index c2c510f2f93..30b1cceb2cb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1775,9 +1775,15 @@ Instead, use 'eshell-process-wait-time', which supports floating-point values. +++ -** 'dbus-{string-to-byte-array,byte-array-to-string}' are strict UTF-8 conform. -Both work over UTF-8 raw bytes only. The optional parameter MULTIBYTE -of 'dbus-byte-array-to-string' is obsolete now. +** Conversion of strings to and from byte-arrays works with multibyte strings. +The functions 'dbus-string-to-byte-array' and +'dbus-byte-array-to-string}' now accept and return multibyte Lisp +strings, encoding to UTF-8 and decoding from UTF-8 internally. This +means that the argument to 'dbus-byte-array-to-string' must be a valid +UTF-8 byte sequence, and the optional parameter MULTIBYTE of +'dbus-byte-array-to-string' is now obsolete and unused. The argument of +'dbus-string-to-byte-array' should be a regular Lisp string, not a +unibyte string. * Lisp Changes in Emacs 30.1 diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 31a5eae5182..dd5f0e88859 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -995,7 +995,7 @@ association to the service from D-Bus." (defun dbus-string-to-byte-array (string) "Transform STRING to list (:array :byte C1 :byte C2 ...). The resulting byte array contains the raw bytes of the UTF-8 encoded -STRING.." +STRING." (if (length= string 0) '(:array :signature "y") (cons :array @@ -1004,9 +1004,10 @@ STRING.." (encode-coding-string string 'utf-8 'nocopy)))))) (defun dbus-byte-array-to-string (byte-array &optional _multibyte) - "Transform BYTE-ARRAY into UTF-8 coded string. + "Transform BYTE-ARRAY with UTF-8 byte sequence into a string. BYTE-ARRAY must be a list of structure (c1 c2 ...), or a byte array as -produced by `dbus-string-to-byte-array'." +produced by `dbus-string-to-byte-array', and the individual bytes must +be a valid UTF-8 byte sequence." (declare (advertised-calling-convention (byte-array) "30.1")) (if-let ((bytes (seq-filter #'characterp byte-array)) (string (apply #'unibyte-string bytes))) commit 4ff852a5582be8d0ba16e598371ce359ba3d3cc6 Author: Eshel Yaron Date: Thu Apr 11 19:16:26 2024 +0200 ; Optimize 'completion-preview--try-table' * lisp/completion-preview.el (completion-preview-completion-styles): New variable. Default to only include the 'basic' completion style. (completion-preview--try-table): Let-bind 'completion-styles' when calling 'completion-all-completions'. With the default value of 'completion-preview-completion-styles', this yields a significant performance improvement (up to 4 times faster compared to the 'substring' style when tested with 'elisp-completion-at-point'). Suggested by Ergus diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 0bdc13bb8a5..4e52aa9b151 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -206,6 +206,15 @@ Completion Preview mode adds this function to #'completion-preview--window-selection-change t) (completion-preview-hide))) +(defvar completion-preview-completion-styles '(basic) + "List of completion styles that Completion Preview mode uses. + +Since Completion Preview mode shows prefix completion candidates, this +list should normally only include completion styles that perform prefix +completion, but other candidates are filtered out and cause no harm. + +See also `completion-styles'.") + (defun completion-preview--try-table (table beg end props) "Check TABLE for a completion matching the text between BEG and END. @@ -228,7 +237,11 @@ non-nil, return nil instead." (sort-fn (or (completion-metadata-get md 'cycle-sort-function) (completion-metadata-get md 'display-sort-function) completion-preview-sort-function)) - (all (let ((completion-lazy-hilit t)) + (all (let ((completion-lazy-hilit t) + ;; FIXME: This does not override styles prescribed + ;; by the completion category via + ;; e.g. `completion-category-defaults'. + (completion-styles completion-preview-completion-styles)) (completion-all-completions string table pred (- (point) beg) md))) (last (last all)) commit a69890eea946beb0858273a20d260a170485b79a Author: Michael Albinus Date: Fri Apr 12 10:09:45 2024 +0200 Improve D-Bus byte-array conversion * doc/misc/dbus.texi (Type Conversion): Adapt dbus-byte-array-to-string. * etc/NEWS: D-Bus byte array conversion works over raw UTF-8 bytes. Fix typos. * lisp/net/dbus.el (dbus-string-to-byte-array) (dbus-byte-array-to-string): BYTE-ARRAY must be an UTF-8 raw bytes sequence. Make optional argument MULTIBYTE obsolete. (Bug#70301) (dbus-call-method-handler, dbus-register-signal) (dbus-escape-as-identifier): Use `length=' and `length>'. * test/lisp/net/dbus-tests.el (dbus--test-method-handler) (dbus-test09-get-managed-objects): Use `length='. (dbus-test01-type-conversion): Extend test. * test/lisp/net/secrets-tests.el (secrets-test03-items): Extend test. diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 28ee64d6b89..c0a478d6ff6 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -1154,11 +1154,10 @@ The signal @code{PropertyModified}, discussed as an example in (@var{integer} ((@var{string} @var{bool} @var{bool}) (@var{string} @var{bool} @var{bool}) @dots{})) @end lisp -@defun dbus-byte-array-to-string byte-array &optional multibyte +@defun dbus-byte-array-to-string byte-array If a D-Bus method or signal returns an array of bytes, which are known to represent a UTF-8 string, this function converts @var{byte-array} -to the corresponding string. The string is unibyte encoded, unless -@var{multibyte} is non-@code{nil}. Example: +to the corresponding UTF-8 string. Example: @lisp (dbus-byte-array-to-string '(47 101 116 99 47 104 111 115 116 115)) diff --git a/etc/NEWS b/etc/NEWS index 62dd2da6b8c..c2c510f2f93 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -70,7 +70,7 @@ more details. ** Mouse wheel events should now always be 'wheel-up/down/left/right'. At those places where the old 'mouse-4/5/6/7' events could still occur -(i.e. X11 input in the absence of XInput2, and 'xterm-mouse-mode'), +(i.e., X11 input in the absence of XInput2, and 'xterm-mouse-mode'), we remap them to the corresponding 'wheel-up/down/left/right' event, according to the new variable 'mouse-wheel-buttons'. The old variables 'mouse-wheel-up-event', 'mouse-wheel-down-event', @@ -81,7 +81,7 @@ obsolete. In order to help the use of those Tree-Sitter modes, they are now declared to have the corresponding non-Tree-Sitter mode as an additional parent. -This way, things like `.dir-locals.el` settings, and YASnippet +This way, things like ".dir-locals.el" settings, and YASnippet collections of snippets automatically apply to the new Tree-Sitter modes. Note that those modes still do not inherit from the non-TS mode, so @@ -126,7 +126,7 @@ to your init: ** 'describe-function' now shows the type of the function object. The text used to say things like "car is is a built-in function" whereas it now says "car is a primitive-function" where "primitive-function" -is the symbol returned by `cl-type-of` and you can click on it to get +is the symbol returned by 'cl-type-of' and you can click on it to get information about that type. ** 'advice-remove' is now an interactive command. @@ -266,7 +266,7 @@ value when installing GNU coreutils using something like ports or Homebrew. +++ -** cl-print +** CL Print +++ *** You can expand the "..." truncation everywhere. @@ -499,7 +499,7 @@ By default this is disabled. --- *** Users in CJK locales can control width of some non-CJK characters. Some characters are considered by Unicode as "ambiguous" with respect -to their display width: either "full-width" (i.e. taking 2 columns on +to their display width: either "full-width" (i.e., taking 2 columns on display) or "narrow" (taking 1 column). The actual width depends on the fonts used for these characters by Emacs or (for text-mode frames) by the terminal emulator. Traditionally, font sets in CJK locales @@ -546,7 +546,7 @@ only to specify the 'mouse-4/5/6/7' events that might still happen to be generated by some old packages (or if 'mouse-wheel-buttons' has been set to nil). -** 'xterm-mouse-mode' +** Xterm Mouse mode This mode now emits 'wheel-up/down/right/left' events instead of 'mouse-4/5/6/7' events for the mouse wheel. It uses the new variable 'mouse-wheel-buttons' to decide which button @@ -568,7 +568,7 @@ This requires the 'lzip' program to be installed on your system. ** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. -** gdb-mi +** GDB MI --- *** Variable order and truncation can now be configured in 'gdb-many-windows'. @@ -1112,7 +1112,7 @@ would add a duplicate entry to the end of the history list each time. This made it impossible to navigate to the "end" of the history list. Now, navigating through history in EWW simply changes your position in the history list, allowing you to reach the end as expected. In -addition, when browsing to a new page from a "historical" one (i.e. a +addition, when browsing to a new page from a "historical" one (i.e., a page loaded by navigating back through history), EWW deletes the history entries newer than the current page. To change the behavior when browsing from "historical" pages, you can customize @@ -1136,7 +1136,7 @@ display only the readable parts by default. For more details, see When non-nil (the default), calling 'eww-readable' adds a new entry to the EWW page history. -** go-ts-mode +** Go-ts mode +++ *** New command 'go-ts-mode-docstring'. @@ -1265,12 +1265,11 @@ This allows the user to specify command line arguments to the non interactive Python interpreter specified by 'python-interpreter'. ** Scheme mode - -Scheme mode now handles regular expression literal #/regexp/ that is +Scheme mode now handles regular expression literal '#/regexp/' that is available in some Scheme implementations. Also, it should now handle nested sexp-comments. -** use-package +** Use package +++ *** New ':vc' keyword. @@ -1434,13 +1433,13 @@ without specifying a file, like this: ** Image +++ -*** Image :map property is now recomputed when image is transformed. +*** Image ':map' property is now recomputed when image is transformed. Now images with clickable maps work as expected after you run commands -such as `image-increase-size', `image-decrease-size', `image-rotate', -`image-flip-horizontally', and `image-flip-vertically'. +such as 'image-increase-size', 'image-decrease-size', 'image-rotate', +'image-flip-horizontally', and 'image-flip-vertically'. +++ -*** New user option 'image-recompute-map-p' +*** New user option 'image-recompute-map-p'. Set this option to nil to prevent Emacs from recomputing image maps. ** Image Dired @@ -1575,7 +1574,7 @@ buffer method is the default, which preserves previous behavior. *** New user option 'xwidget-webkit-disable-javascript'. This allows disabling JavaScript in xwidget Webkit sessions. -** ls-lisp +** Ls Lisp --- *** 'ls-lisp--insert-directory' supports more long options of 'ls'. @@ -1775,6 +1774,11 @@ Use a float value for the first argument instead. Instead, use 'eshell-process-wait-time', which supports floating-point values. ++++ +** 'dbus-{string-to-byte-array,byte-array-to-string}' are strict UTF-8 conform. +Both work over UTF-8 raw bytes only. The optional parameter MULTIBYTE +of 'dbus-byte-array-to-string' is obsolete now. + * Lisp Changes in Emacs 30.1 @@ -1789,18 +1793,18 @@ This function is like 'type-of' except that it sometimes returns a more precise type. For example, for nil and t it returns 'null' and 'boolean' respectively, instead of just 'symbol'. -** New functions `primitive-function-p` and `cl-functionp`. -`primitive-function-p` is like `subr-primitive-p` except that it returns +** New functions 'primitive-function-p' and 'cl-functionp'. +'primitive-function-p' is like 'subr-primitive-p' except that it returns t only if the argument is a function rather than a special-form, -and `cl-functionp` is like `functionp` except it return nil +and 'cl-functionp' is like 'functionp' except it returns nil for lists and symbols. ** Built-in types have now corresponding classes. -At the Lisp level, this means that things like (cl-find-class 'integer) +At the Lisp level, this means that things like '(cl-find-class 'integer)' will now return a class object, and at the UI level it means that things like 'C-h o integer RET' will show some information about that type. -** New var 'major-mode-remap-defaults' and function 'major-mode-remap'. +** New variable 'major-mode-remap-defaults' and function 'major-mode-remap'. The first is like Emacs-29's 'major-mode-remap-alist' but to be set by packages (instead of users). The second looks up those two variables. @@ -1934,7 +1938,7 @@ capabilities of the 'notifications-notify' function in a manner analogous to 'w32-notification-notify'. ** New variable 'haiku-pass-control-tab-to-system'. -This sets whether Emacs should pass C-TAB on to the system instead of +This sets whether Emacs should pass 'C-TAB' on to the system instead of handling it, fixing a problem where window switching would not activate if an Emacs frame had focus on the Haiku operation system. @@ -2011,7 +2015,6 @@ It returns the last position of a marker in its buffer even if that buffer has been killed. ('marker-position' would return nil in that case.) - ** Functions and variables to transpose sexps +++ @@ -2360,16 +2363,16 @@ is the value of the property to context menus shown when clicking on the text which as this property. --- -** Detecting the end of an iteration of a keyboard macro +** Detecting the end of an iteration of a keyboard macro. 'read-event', 'read-char', and 'read-char-exclusive' no longer return -1 -when called at the end of an iteration of a the execution of a keyboard +when called at the end of an iteration of the execution of a keyboard macro. Instead, they will transparently continue reading available input (e.g., from the keyboard). If you need to detect the end of a macro iteration, check the following condition before calling one of the aforementioned functions: (and (arrayp executing-kbd-macro) - (>= executing-kbd-macro-index (length executing-kbd-macro)))) + (>= executing-kbd-macro-index (length executing-kbd-macro))) +++ ** 'vtable-update-object' updates an existing object with just two arguments. @@ -2394,7 +2397,7 @@ It will now signal 'json-utf8-decode-error' for inputs that are not correctly UTF-8 encoded. --- -*** The parser and encoder now accept arbitarily large integers. +*** The parser and encoder now accept arbitrarily large integers. Previously, they were limited to the range of signed 64-bit integers. ** New tree-sitter functions and variables for defining and using "things" diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 46f85daba24..31a5eae5182 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -270,7 +270,7 @@ The result will be made available in `dbus-return-values-table'." (result (gethash key dbus-return-values-table))) (when (consp result) (setcar result :complete) - (setcdr result (if (= (length args) 1) (car args) args))))) + (setcdr result (if (length= args 1) (car args) args))))) (defun dbus-notice-synchronous-call-errors (ev er) "Detect errors resulting from pending synchronous calls." @@ -773,7 +773,7 @@ Example: ;; Signals are sent always with the unique name as sender. Note: ;; the unique name of `dbus-service-dbus' is that string itself. (if (and (stringp service) - (not (zerop (length service))) + (length> service 0) (not (string-equal service dbus-service-dbus)) (/= (string-to-char service) ?:)) (setq uname (dbus-get-name-owner bus service)) @@ -994,20 +994,25 @@ association to the service from D-Bus." (defun dbus-string-to-byte-array (string) "Transform STRING to list (:array :byte C1 :byte C2 ...). -STRING shall be UTF-8 coded." - (if (zerop (length string)) +The resulting byte array contains the raw bytes of the UTF-8 encoded +STRING.." + (if (length= string 0) '(:array :signature "y") - (cons :array (mapcan (lambda (c) (list :byte c)) string)))) + (cons :array + (mapcan (lambda (c) (list :byte c)) + (let (last-coding-system-used) + (encode-coding-string string 'utf-8 'nocopy)))))) -(defun dbus-byte-array-to-string (byte-array &optional multibyte) +(defun dbus-byte-array-to-string (byte-array &optional _multibyte) "Transform BYTE-ARRAY into UTF-8 coded string. -BYTE-ARRAY must be a list of structure (c1 c2 ...), or a byte -array as produced by `dbus-string-to-byte-array'. The resulting -string is unibyte encoded, unless MULTIBYTE is non-nil." - (apply - (if multibyte #'string #'unibyte-string) - (unless (equal byte-array '(:array :signature "y")) - (seq-filter #'characterp byte-array)))) +BYTE-ARRAY must be a list of structure (c1 c2 ...), or a byte array as +produced by `dbus-string-to-byte-array'." + (declare (advertised-calling-convention (byte-array) "30.1")) + (if-let ((bytes (seq-filter #'characterp byte-array)) + (string (apply #'unibyte-string bytes))) + (let (last-coding-system-used) + (decode-coding-string string 'utf-8 'nocopy)) + "")) (defun dbus-escape-as-identifier (string) "Escape an arbitrary STRING so it follows the rules for a C identifier. @@ -1026,7 +1031,7 @@ escaped to \"_\". Returns the escaped string. Algorithm taken from telepathy-glib's `tp_escape_as_identifier'." - (if (zerop (length string)) + (if (length= string 0) "_" (replace-regexp-in-string "\\`[0-9]\\|[^A-Za-z0-9]" diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index fec252e12dd..413901b0205 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -68,22 +68,35 @@ "Check type conversion functions." (skip-unless dbus--test-enabled-session-bus) - (let ((ustr "0123abc_xyz\x01\xff") - (mstr "Grüß Göttin")) + (let ((ustr (string-to-unibyte "0123abc_xyz\x01\xff")) + (mstr (string-to-multibyte "Grüß Göttin")) + (kstr (encode-coding-string "парола" 'koi8))) (should (string-equal (dbus-byte-array-to-string (dbus-string-to-byte-array "")) "")) (should (string-equal - (dbus-byte-array-to-string (dbus-string-to-byte-array ustr)) ustr)) + (dbus-byte-array-to-string (dbus-string-to-byte-array nil)) "")) (should (string-equal - (dbus-byte-array-to-string (dbus-string-to-byte-array mstr) 'multibyte) - mstr)) - ;; Should not work for multibyte strings. - (should-not + ;; The conversion could return a multibyte string, so we make it unibyte. + (string-to-unibyte + (dbus-byte-array-to-string (dbus-string-to-byte-array ustr))) + ustr)) + (should + (string-equal + ;; The conversion could return a multibyte string, so we make it unibyte. + (string-to-unibyte (dbus-byte-array-to-string (mapcar 'identity ustr))) + ustr)) + (should (string-equal (dbus-byte-array-to-string (dbus-string-to-byte-array mstr)) mstr)) + (should + (string-equal + ;; The conversion could return a multibyte string, so we make it unibyte. + (string-to-unibyte + (dbus-byte-array-to-string (dbus-string-to-byte-array kstr))) + kstr)) (should (string-equal @@ -565,10 +578,10 @@ This includes initialization and closing the bus." ((null args) :ignore) ;; One argument. - ((= 1 (length args)) + ((length= args 1) (car args)) ;; Two arguments. - ((= 2 (length args)) + ((length= args 2) `(:error ,dbus-error-invalid-args ,(format-message "Wrong arguments %s" args))) ;; More than two arguments. @@ -1952,7 +1965,7 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." (let ((result (dbus-get-all-managed-objects :session dbus--test-service dbus--test-path))) (should - (= 3 (length result))) + (length= result 3)) (dolist (interface interfaces) (pcase-let ((`(,iname ,objs) interface)) @@ -1970,7 +1983,7 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." :session dbus--test-service (concat dbus--test-path "/obj0")))) (should - (= 2 (length result))) + (length= result 2)) (dolist (interface interfaces) (pcase-let ((`(,iname ,objs) interface)) @@ -1989,7 +2002,7 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." :session dbus--test-service (concat dbus--test-path "/obj0/obj2")))) (should - (= 1 (length result))) + (length= result 1)) (dolist (interface interfaces) (pcase-let ((`(,iname ,objs) interface)) diff --git a/test/lisp/net/secrets-tests.el b/test/lisp/net/secrets-tests.el index 9feba514413..1d9c1446e26 100644 --- a/test/lisp/net/secrets-tests.el +++ b/test/lisp/net/secrets-tests.el @@ -173,6 +173,10 @@ (should (secrets-create-item "session" "foo" "geheim")) (should (equal (secrets-list-items "session") '("foo" "foo"))) + ;; Create another item with a non-latin password. (Bug#70301) + (should (secrets-create-item "session" "parola" "парола")) + (string-equal (secrets-get-secret "session" "parola") "парола") + ;; Create an item with attributes. (should (setq item-path commit ea62a14ea3b7f3f6feb0c7c803eeabe3c8499276 Author: Eli Zaretskii Date: Thu Apr 11 18:34:53 2024 +0300 Fix display of vscrolled windows * src/xdisp.c (redisplay_window): Fix condition for resetting the window's vscroll. (Bug#70038) diff --git a/src/xdisp.c b/src/xdisp.c index 2d85a991e77..a9eb47720d0 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -19811,7 +19811,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* The vscroll should be preserved in this case, since `pixel-scroll-precision-mode' must continue working normally when a mini-window is resized. (bug#55312) */ - if (!w->preserve_vscroll_p || !window_frozen_p (w)) + if (!w->preserve_vscroll_p && !window_frozen_p (w)) w->vscroll = 0; w->preserve_vscroll_p = false; commit 4cefa3c0b1f7270ca5317caa02101a0257595b9c Author: Eli Zaretskii Date: Wed Apr 10 22:31:57 2024 +0300 ; * doc/emacs/files.texi (Backup): Clarify "saving" (bug#70326). diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index d074a55b762..393c4728422 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -569,9 +569,10 @@ Emacs carefully copies the old contents to another file, called the @dfn{backup} file, before actually saving. Emacs makes a backup for a file only the first time the file is -saved from a buffer. No matter how many times you subsequently save -the file, its backup remains unchanged. However, if you kill the -buffer and then visit the file again, a new backup file will be made. +saved from the buffer that visits it. No matter how many times you +subsequently save the file, its backup remains unchanged. However, if +you kill the buffer and then visit the file again, a new backup file +will be made. For most files, the variable @code{make-backup-files} determines whether to make backup files. On most operating systems, its default commit db7b571aaaf4aa16fc6a88a53a8740c3a102ce60 Author: Eli Zaretskii Date: Wed Apr 10 16:52:21 2024 +0300 ; Improve documentation of 'world-clock' * lisp/time.el (zoneinfo-style-world-list) (legacy-style-world-list): Doc fixes. diff --git a/lisp/time.el b/lisp/time.el index 6d95ae326c6..29c7f53ac1f 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -452,7 +452,11 @@ Each element has the form (TIMEZONE LABEL). TIMEZONE should be a string of the form AREA/LOCATION, where AREA is the name of a region -- a continent or ocean, and LOCATION is the name of a specific location, e.g., a city, within that region. -LABEL is a string to display as the label of that TIMEZONE's time." +LABEL is a string to display as the label of that TIMEZONE's time. + +This option has effect only on systems that support Posix-style +zoneinfo files specified as CONTINENT/CITY. In particular, +MS-Windows doesn't support that; use `legacy-style-world-list' instead." :type '(repeat (list string string)) :version "23.1") @@ -471,7 +475,10 @@ TIMEZONE should be a string of the form: See the documentation of the TZ environment variable on your system, for more details about the format of TIMEZONE. -LABEL is a string to display as the label of that TIMEZONE's time." +LABEL is a string to display as the label of that TIMEZONE's time + +This is the only option that has effect on MS-Windows, where you also +cannot specify the [offset][,date[/time],date[/time]] part." :type '(repeat (list string string)) :version "23.1") commit 6a0bb7beae3ed4e3d2b420b73abcfaada38f53ee Author: Peter Oliver Date: Wed Apr 10 10:42:39 2024 +0200 * doc/emacs/misc.texi (emacsclient Options): Suggest forwarding sockets. (Bug#66667) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 488f6de04ed..41e37fd094e 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2161,8 +2161,9 @@ terminal. Set the prefix to add to filenames for Emacs to locate files on remote machines (@pxref{Remote Files}) using TRAMP (@pxref{Top, The Tramp Manual,, tramp, The Tramp Manual}). This is mostly useful in -combination with using the Emacs server over TCP (@pxref{TCP Emacs -server}). By ssh-forwarding the listening port and making the +combination with using the Emacs server from a remote host. By +ssh-forwarding the listening socket, or ssh-forwarding the listening +port @pxref{TCP Emacs server} and making the @var{server-file} available on a remote machine, programs on the remote machine can use @command{emacsclient} as the value for the @env{EDITOR} and similar environment variables, but instead of talking @@ -2174,16 +2175,29 @@ Setting the environment variable @env{EMACSCLIENT_TRAMP} has the same effect as using the @samp{-T} option. If both are specified, the command-line option takes precedence. -For example, assume two hosts, @samp{local} and @samp{remote}, and -that the local Emacs listens on tcp port 12345. Assume further that +For example, assume two hosts, @samp{local} and @samp{remote}. + +@example +local$ ssh -R "/home/%r/.emacs.socket":"$@{XDG_RUNTIME_DIR:-$@{TMPDIR:-/tmp@}/emacs%i@}$@{XDG_RUNTIME_DIR:+/emacs@}/server" remote +remote$ export EMACS_SOCKET_NAME=$HOME/.emacs.socket +remote$ export EMACSCLIENT_TRAMP=/ssh:remote: +remote$ export EDITOR=emacsclient +remote$ $EDITOR /tmp/foo.txt #Should open in local emacs. +@end example + +If you are using a platform where @command{emacsclient} does not use +Unix domain sockets (i.e., MS-Windows), or your SSH implementation is +not able to forward them (e.g., OpenSSH before version 6.7), you can +forward a TCP port instead. In this example, assume that the local +Emacs listens on tcp port 12345. Assume further that @file{/home} is on a shared file system, so that the server file @file{~/.emacs.d/server/server} is readable on both hosts. @example local$ ssh -R12345:localhost:12345 remote -remote$ export EDITOR="emacsclient \ - --server-file=server \ - --tramp=/ssh:remote:" +remote$ export EMACS_SERVER_FILE=server +remote$ export EMACSCLIENT_TRAMP=/ssh:remote: +remote$ export EDITOR=emacsclient remote$ $EDITOR /tmp/foo.txt #Should open in local emacs. @end example commit 859b4227e3de9f8e7bc26367540aa315cefc37dc Author: Yuan Fu Date: Mon Apr 8 20:20:25 2024 -0700 Update go-ts-mode to support latest tree-sitter-go grammar tree-sitter-go changed method_spec to method_elem in https://github.com/tree-sitter/tree-sitter-go/commit/b82ab803d887002a0af11f6ce63d72884580bf33 * lisp/progmodes/go-ts-mode.el: (go-ts-mode--method-elem-supported-p): New function. (go-ts-mode--font-lock-settings): Conditionally use method_elem or method_spec in the query. diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index e8a176e3d9d..a5b49bd8313 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -112,6 +112,13 @@ (ignore-errors (or (treesit-query-string "" '((iota) @font-lock-constant-face) 'go) t))) +;; tree-sitter-go changed method_spec to method_elem in +;; https://github.com/tree-sitter/tree-sitter-go/commit/b82ab803d887002a0af11f6ce63d72884580bf33 +(defun go-ts-mode--method-elem-supported-p () + "Return t if Go grammar uses `method_elem' instead of `method_spec'." + (ignore-errors + (or (treesit-query-string "" '((method_elem) @cap) 'go) t))) + (defvar go-ts-mode--font-lock-settings (treesit-font-lock-rules :language 'go @@ -136,11 +143,13 @@ :language 'go :feature 'definition - '((function_declaration + `((function_declaration name: (identifier) @font-lock-function-name-face) (method_declaration name: (field_identifier) @font-lock-function-name-face) - (method_spec + (,(if (go-ts-mode--method-elem-supported-p) + 'method_elem + 'method_spec) name: (field_identifier) @font-lock-function-name-face) (field_declaration name: (field_identifier) @font-lock-property-name-face) commit 407e85ce139c2f0ab8bc7f9643ee7506a4e561a1 Author: Yuan Fu Date: Mon Apr 8 21:07:11 2024 -0700 Fix c++-ts-mode defun navigation (bug#65885) * lisp/progmodes/c-ts-mode.el (c-ts-base-mode): Add BOL and EOL marker in the regexp. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index e69856baecc..a7a416b94f4 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -1155,7 +1155,9 @@ BEG and END are described in `treesit-range-rules'." "struct_specifier" "enum_specifier" "union_specifier" - "class_specifier" + ;; Make sure this doesn't match + ;; storage_class_specifier. + "^class_specifier$" "namespace_definition") (and c-ts-mode-emacs-sources-support '(;; DEFUN. commit aca5064f128e20a495e9ddf254248ab77b613754 Author: Eli Zaretskii Date: Sun Apr 7 10:33:14 2024 +0300 ; Fix last change. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 36fee69351e..54dc23c0951 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1618,9 +1618,9 @@ history to be cleared. *** XFCE: Selected frame loses focus This can happen, e.g., in Ediff: when you move between the differences -by typing into the control frame, input focus unexpectedly switches to -the buffers where Emacs shows the differences, instead of being left -in the Ediff control frame. +by typing 'n' or 'p' into the control frame, input focus unexpectedly +switches to the buffers where Emacs shows the differences, instead of +being left in the Ediff control frame. The reason is a bug in the window manager: it shifts input focus when raising a frame. A workaround is to activate the "focus stealing commit 55aab2d471024bda1878897e81e3b5695e242f09 Author: Eli Zaretskii Date: Sun Apr 7 10:32:47 2024 +0300 ; * etc/PROBLEMS: An entry about focus issues with XFCE (bug#70046). diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 16521e257dd..36fee69351e 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1615,6 +1615,18 @@ underlying functionality in plasmashell gets fully disabled as well. At least a restart of plasmashell is required for the clipboard history to be cleared. +*** XFCE: Selected frame loses focus + +This can happen, e.g., in Ediff: when you move between the differences +by typing into the control frame, input focus unexpectedly switches to +the buffers where Emacs shows the differences, instead of being left +in the Ediff control frame. + +The reason is a bug in the window manager: it shifts input focus when +raising a frame. A workaround is to activate the "focus stealing +prevention" option of the window manager (in XFCE settings, under +"window manager tweaks", in the "focus" tab). + *** CDE: Frames may cover dialogs they created when using CDE. This can happen if you have "Allow Primary Windows On Top" enabled which commit 19cee16576ef09990ac14d1ec5f0ddcd4594f5ce Author: Michael Albinus Date: Sun Apr 7 09:15:42 2024 +0200 ; * doc/emacs/misc.texi (emacsclient Options): Fix typo. (Bug#70238) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 48bc69456ad..488f6de04ed 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2157,7 +2157,7 @@ running on a text terminal, it creates a new frame in the current text terminal. @item -T @var{tramp-prefix} -@itemx --tramp-prefix=@var{tramp-prefix} +@itemx --tramp=@var{tramp-prefix} Set the prefix to add to filenames for Emacs to locate files on remote machines (@pxref{Remote Files}) using TRAMP (@pxref{Top, The Tramp Manual,, tramp, The Tramp Manual}). This is mostly useful in commit 2a41b6ba51457448b3937fbb1d9e06f62c3d5a9f Author: Eli Zaretskii Date: Sun Apr 7 09:24:58 2024 +0300 ; * src/filelock.c (Flock_file): Doc fix (bug#70216). diff --git a/src/filelock.c b/src/filelock.c index 7acee1f8ddd..3dc5f6d68d6 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -772,8 +772,11 @@ unlock_all_files (void) } DEFUN ("lock-file", Flock_file, Slock_file, 1, 1, 0, - doc: /* Lock FILE. -If the option `create-lockfiles' is nil, this does nothing. */) + doc: /* Check whether FILE was modified since it was visited, and lock it. +If user option `create-lockfiles' is nil, this does not create +a lock file for FILE, but it still checks whether FILE was modified +outside of the current Emacs session, and if so, asks the user +whether to modify FILE. */) (Lisp_Object file) { #ifndef MSDOS