commit b585fb8171dd139f178c398c64c584565deacfb1 (HEAD, refs/remotes/origin/master) Author: Juri Linkov Date: Thu Apr 18 09:36:18 2024 +0300 * lisp/tab-line.el: Use the new keyword :key for 'sort'. (tab-line-tabs-fixed-window-buffers): Use :key for 'sort'. Rename the window parameter 'tab-line-fixed-window-buffers' to shorter 'tab-line-buffers'. Add '(tab-line-buffers . writable) to window-persistent-parameters. diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 09081501705..2eb97012262 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -532,16 +532,16 @@ variable `tab-line-tabs-function'." This means that switching to a buffer previously shown in the same window will keep the same order of tabs that was before switching. And newly displayed buffers are added to the end of the tab line." - (let* ((old-buffers (window-parameter nil 'tab-line-fixed-window-buffers)) + (let* ((old-buffers (window-parameter nil 'tab-line-buffers)) (new-buffers (sort (tab-line-tabs-window-buffers) - (lambda (a b) - (< (or (seq-position old-buffers a) - most-positive-fixnum) - (or (seq-position old-buffers b) - most-positive-fixnum)))))) - (set-window-parameter nil 'tab-line-fixed-window-buffers new-buffers) + :key (lambda (buffer) + (or (seq-position old-buffers buffer) + most-positive-fixnum))))) + (set-window-parameter nil 'tab-line-buffers new-buffers) new-buffers)) +(add-to-list 'window-persistent-parameters '(tab-line-buffers . writable)) + (defcustom tab-line-tab-name-format-function #'tab-line-tab-name-format-default "Function to format a tab name. commit c19b988c2967f13597b7a3ceafb7c3cd40d83458 Author: Po Lu Date: Thu Apr 18 10:37:31 2024 +0800 Correctly verify availability of Android content URIs * java/org/gnu/emacs/EmacsService.java (checkContentUri): Call checkUriPermission with IPC-effective PID and UID rather than checkCallingUriPermission, which never considers permissions of Emacs itself, and delete the now-redundant workaround. diff --git a/java/org/gnu/emacs/EmacsService.java b/java/org/gnu/emacs/EmacsService.java index fd052653087..b1ec397bc41 100644 --- a/java/org/gnu/emacs/EmacsService.java +++ b/java/org/gnu/emacs/EmacsService.java @@ -70,15 +70,16 @@ import android.net.Uri; import android.os.BatteryManager; +import android.os.Binder; import android.os.Build; import android.os.Environment; -import android.os.Looper; -import android.os.IBinder; import android.os.Handler; +import android.os.IBinder; +import android.os.Looper; import android.os.ParcelFileDescriptor; +import android.os.VibrationEffect; import android.os.Vibrator; import android.os.VibratorManager; -import android.os.VibrationEffect; import android.provider.DocumentsContract; import android.provider.DocumentsContract.Document; @@ -1027,11 +1028,8 @@ invocation of app_process (through android-emacs) can public boolean checkContentUri (String name, boolean readable, boolean writable) { - String mode; - ParcelFileDescriptor fd; Uri uri; int rc, flags; - ParcelFileDescriptor descriptor; uri = Uri.parse (name); flags = 0; @@ -1042,47 +1040,21 @@ invocation of app_process (through android-emacs) can if (writable) flags |= Intent.FLAG_GRANT_WRITE_URI_PERMISSION; - rc = checkCallingUriPermission (uri, flags); - - if (rc == PackageManager.PERMISSION_GRANTED) - return true; - - /* In the event checkCallingUriPermission fails and only read - permissions are being verified, attempt to query the URI. This - enables ascertaining whether drag and drop URIs can be - accessed, something otherwise not provided for. */ - - descriptor = null; - - try - { - descriptor = resolver.openFileDescriptor (uri, "r"); - return true; - } - catch (Exception exception) - { - /* Ignored. */ - } - finally - { - try - { - if (descriptor != null) - descriptor.close (); - } - catch (IOException exception) - { - /* Ignored. */ - } - } + /* checkCallingUriPermission deals with permissions held by callers + of functions over the Binder IPC mechanism as contrasted with + Emacs itself, while getCallingPid and getCallingUid, despite the + class where they reside, return the process credentials against + which the system will actually test URIs being opened. */ - return false; + rc = checkUriPermission (uri, Binder.getCallingPid (), + Binder.getCallingUid (), flags); + return rc == PackageManager.PERMISSION_GRANTED; } /* Return a 8 character checksum for the string STRING, after encoding as UTF-8 data. */ - public static String + private static String getDisplayNameHash (String string) { byte[] encoded; commit 3cdd86b8affa6d58de8f6d07b4e117676fedd58c Author: Augusto Stoffel Date: Sun Apr 14 09:36:05 2024 +0200 Propagate 'lexical-binding' value to pp buffers See bug#70137. * lisp/emacs-lisp/pp.el (pp-display-expression): Set lexical-binding to match the value in the calling buffer. diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index d586fc59939..f89807c37be 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -327,7 +327,8 @@ If LISP, format with `pp-emacs-lisp-code'; use `pp' otherwise. If a temporary buffer is needed for representation, it will be named after OUT-BUFFER-NAME." - (let* ((old-show-function temp-buffer-show-function) + (let* ((lexical lexical-binding) + (old-show-function temp-buffer-show-function) ;; Use this function to display the buffer. ;; This function either decides not to display it at all ;; or displays it in the usual way. @@ -357,6 +358,7 @@ after OUT-BUFFER-NAME." (pp expression)) (with-current-buffer standard-output (emacs-lisp-mode) + (setq lexical-binding lexical) (setq buffer-read-only nil) (setq-local font-lock-verbose nil))))) commit 0dbd9ed04660152276696e462359204a45ca933d Author: Theodor Thornhill Date: Wed Apr 17 20:27:35 2024 +0200 Document earlier change in eglot-report-progress * lisp/progmodes/eglot.el (eglot-report-progress): Document the changed behavior. * etc/EGLOT-NEWS (https): Mention the change. diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 12e7d3f6b9b..0e3e4b7aff8 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -20,6 +20,12 @@ https://github.com/joaotavora/eglot/issues/1234. * Changes in upcoming Eglot +** Disable workDoneProgress if eglot-report-progress is nil + +Eglot will now try to not register $/progress messages from the server +when the defcustom is set to nil. This requires a restart of the server +for the change to take effect. + * Changes in Eglot 1.17 (25/1/2024) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index bff273338c4..c395efd9f55 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -517,7 +517,10 @@ ACTION is the default value for commands not in the alist." (defcustom eglot-report-progress t "If non-nil, show progress of long running LSP server work. If set to `messages', use *Messages* buffer, else use Eglot's -mode line indicator." +mode line indicator. + +For changes on this variable to take effect, you need to restart +the LSP connection. That can be done by `eglot-reconnect'." :type '(choice (const :tag "Don't show progress" nil) (const :tag "Show progress in *Messages*" messages) (const :tag "Show progress in Eglot's mode line indicator" t)) commit c15c9f4de62b5bf06d6ccdb5bbada4f542108a38 Author: Stefan Monnier Date: Wed Apr 17 14:30:10 2024 -0400 (conf-toml-recognize-section): Fix bug#70383 * lisp/textmodes/conf-mode.el (conf-toml-recognize-section): Move point, like font-lock matchers are expected to do. diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index 5e1636033f6..e74409128df 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -613,27 +613,26 @@ For details see `conf-mode'. Example: "Font-lock helper function for `conf-toml-mode'. Handles recognizing TOML section names, like [section], \[[section]], or [something.\"else\".section]." - (save-excursion - ;; Skip any number of "[" to handle things like [[section]]. - (when (re-search-forward "^\\s-*\\[+" limit t) - (let ((start (point))) - (backward-char) - (let ((end (min limit - (condition-case nil - (progn - (forward-list) - (1- (point))) - (scan-error - (end-of-line) - (point)))))) - ;; If there is a comma in the text, then we assume this is - ;; an array and not a section. (This could be refined to - ;; look only for unquoted commas if necessary.) - (save-excursion - (goto-char start) - (unless (search-forward "," end t) - (set-match-data (list start end)) - t))))))) + ;; Skip any number of "[" to handle things like [[section]]. + (when (re-search-forward "^\\s-*\\[+" limit t) + (let ((start (point))) + (backward-char) + (let ((end (min limit + (condition-case nil + (progn + (forward-list) + (1- (point))) + (scan-error + (end-of-line) + (point)))))) + ;; If there is a comma in the text, then we assume this is + ;; an array and not a section. (This could be refined to + ;; look only for unquoted commas if necessary.) + (save-excursion + (goto-char start) + (unless (search-forward "," end t) + (set-match-data (list start end)) + t)))))) ;;;###autoload (define-derived-mode conf-toml-mode conf-mode "Conf[TOML]" commit fcee1bf07bb807c568f0155f94ebd69636691de9 Author: Stefan Monnier Date: Wed Apr 17 13:58:40 2024 -0400 eglot.el: Remove accidentally included debugging code * lisp/progmodes/eglot.el (eglot--signal-textDocument/didChange): Remove leftover debug message. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 5e4f7bba679..bff273338c4 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2798,7 +2798,6 @@ When called interactively, use the currently active server" (list :textDocument (eglot--VersionedTextDocumentIdentifier) :contentChanges - (let ((changes (if full-sync-p (vector `(:text ,(eglot--widening (buffer-substring-no-properties (point-min) @@ -2812,8 +2811,6 @@ When called interactively, use the currently active server" when (numberp len) ;FIXME: Not needed with `track-changes'. vconcat `[,(list :range `(:start ,beg :end ,end) :rangeLength len :text text)])))) - (message "Sending changes: %S" changes) - changes))) (setq eglot--recent-changes nil) (jsonrpc--call-deferred server)))) commit 4dd3288569c30414abf0be4fd357d66e4dfeb8fb Author: Juri Linkov Date: Wed Apr 17 21:01:14 2024 +0300 * lisp/emacs-lisp/icons.el (define-icon): Add 'doc-string' to 'declare'. diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index f9591661688..847ef53a1cb 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -73,7 +73,7 @@ inferred if not present. `:help-echo': Informational text that explains what happens if the icon is used as a button and you click it." - (declare (indent 2)) + (declare (doc-string 4) (indent 2)) (unless (symbolp name) (error "NAME must be a symbol: %S" name)) (unless (plist-get keywords :version) commit 230eecf12a688f87354ed2d360a7dfcd7e2dae6a Author: Juri Linkov Date: Wed Apr 17 20:55:45 2024 +0300 New keymap tab-line-mode-map and new tab order on tab-line (bug#69993) * lisp/tab-line.el (tab-line-new-button-functions): New variable. (tab-line-tabs-function): Change the default value from 'tab-line-tabs-window-buffers' to the new option 'tab-line-tabs-fixed-window-buffers'. (tab-line-tabs-buffer-group-sort-function): Change the default value from nil to 'tab-line-tabs-buffer-group-sort-by-name'. (tab-line-tabs-buffer-group-sort-by-name): New function. (tab-line-tabs-fixed-window-buffers): New function. (tab-line-format-template): Use 'tab-line-new-button-functions'. (tab-line-mode-map, tab-line-switch-repeat-map): New keymaps. diff --git a/etc/NEWS b/etc/NEWS index e6f8eb5ba46..2f90a3067f7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -370,11 +370,33 @@ 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 keymap 'tab-line-mode-map'. +By default it contains keybindings for switching tabs: +'C-x ', 'C-x ', 'C-x C-', 'C-x C-'. +You can unbind them if you want to use these keys for the +commands 'previous-buffer' and 'next-buffer'. + +--- +*** Default list of tabs is changed to support a fixed order. +This means that the new default tabs function +'tab-line-tabs-fixed-window-buffers' is like the previous +'tab-line-tabs-window-buffers' where both of them show +only buffers that were previously displayed in the window. +But the difference is that the new function always keeps +the original order of buffers on the tab line, even after +switching between these buffers. + --- *** New user option 'tab-line-tabs-buffer-group-function'. It provides two choices to group tab buffers by major mode and by project name. +--- +*** Now buffers on group tabs are sorted alphabetically. +This will keep the fixed order of tabs, even after +switching between them. + +++ ** 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 48272b7b4b3..09081501705 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -210,6 +210,11 @@ If the value is a function, call it with no arguments." 'help-echo "Click to add tab") "Button for creating a new tab.") +(defvar tab-line-new-button-functions + '(tab-line-tabs-window-buffers + tab-line-tabs-fixed-window-buffers) + "Functions of `tab-line-tabs-function' for which to show a new button.") + (defcustom tab-line-close-button-show t "Defines where to show the close tab button. If t, show the close tab button on all tabs. @@ -333,18 +338,21 @@ If truncated, append ellipsis per `tab-line-tab-name-ellipsis'." 'help-echo tab-name)))) -(defcustom tab-line-tabs-function #'tab-line-tabs-window-buffers +(defcustom tab-line-tabs-function #'tab-line-tabs-fixed-window-buffers "Function to get a list of tabs to display in the tab line. This function should return either a list of buffers whose names will be displayed, or just a list of strings to display in the tab line. -By default, use function `tab-line-tabs-window-buffers' that -returns a list of buffers associated with the selected window. +By default, use function `tab-line-tabs-fixed-window-buffers' that +returns a list of buffers associated with the selected window where +buffers always keep the original order after switching buffers. 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 by `tab-line-tabs-buffer-group-function'." :type '(choice (const :tag "Window buffers" tab-line-tabs-window-buffers) + (const :tag "Window buffers with fixed order" + tab-line-tabs-fixed-window-buffers) (const :tag "Same mode buffers" tab-line-tabs-mode-buffers) (const :tag "Grouped buffers" @@ -400,9 +408,13 @@ as a group name." :group 'tab-line :version "30.1") -(defvar tab-line-tabs-buffer-group-sort-function nil +(defvar tab-line-tabs-buffer-group-sort-function + #'tab-line-tabs-buffer-group-sort-by-name "Function to sort buffers in a group.") +(defun tab-line-tabs-buffer-group-sort-by-name (a b) + (string< (buffer-name a) (buffer-name b))) + (defvar tab-line-tabs-buffer-groups-sort-function #'string< "Function to sort group names.") @@ -515,6 +527,21 @@ variable `tab-line-tabs-function'." (list buffer) next-buffers))) +(defun tab-line-tabs-fixed-window-buffers () + "Like `tab-line-tabs-window-buffers' but keep stable sorting order. +This means that switching to a buffer previously shown in the same +window will keep the same order of tabs that was before switching. +And newly displayed buffers are added to the end of the tab line." + (let* ((old-buffers (window-parameter nil 'tab-line-fixed-window-buffers)) + (new-buffers (sort (tab-line-tabs-window-buffers) + (lambda (a b) + (< (or (seq-position old-buffers a) + most-positive-fixnum) + (or (seq-position old-buffers b) + most-positive-fixnum)))))) + (set-window-parameter nil 'tab-line-fixed-window-buffers new-buffers) + new-buffers)) + (defcustom tab-line-tab-name-format-function #'tab-line-tab-name-format-default "Function to format a tab name. @@ -599,7 +626,7 @@ This is used by `tab-line-format'." tab-line-right-button))) (if hscroll (nthcdr (truncate hscroll) strings) strings) (list separator) - (when (and (eq tab-line-tabs-function #'tab-line-tabs-window-buffers) + (when (and (memq tab-line-tabs-function tab-line-new-button-functions) tab-line-new-button-show tab-line-new-button) (list tab-line-new-button))))) @@ -940,7 +967,7 @@ buffers, which effectively hides the buffer's tab from the tab line. If `kill-buffer', kills the tab's buffer. When a function, it is called with the tab as its argument. This option is useful when `tab-line-tabs-function' has the value -`tab-line-tabs-window-buffers'." +`tab-line-tabs-window-buffers' or `tab-line-tabs-fixed-window-buffers'." :type '(choice (const :tag "Bury buffer" bury-buffer) (const :tag "Kill buffer" kill-buffer) (function :tag "Function")) @@ -1033,6 +1060,19 @@ However, return the correct mouse position list if EVENT is a (event-start event))) +(defvar-keymap tab-line-mode-map + :doc "Keymap for keys of `tab-line-mode'." + "C-x " #'tab-line-switch-to-prev-tab + "C-x C-" #'tab-line-switch-to-prev-tab + "C-x " #'tab-line-switch-to-next-tab + "C-x C-" #'tab-line-switch-to-next-tab) + +(defvar-keymap tab-line-switch-repeat-map + :doc "Keymap to repeat tab/buffer cycling. Used in `repeat-mode'." + :repeat t + "" #'tab-line-switch-to-prev-tab + "" #'tab-line-switch-to-next-tab) + ;;;###autoload (define-minor-mode tab-line-mode "Toggle display of tab line in the windows displaying the current buffer." commit 91333dacfa1b9f1041ceeebb3d46e8e04048c4c9 Author: Stephen Berman Date: Wed Apr 17 19:33:24 2024 +0200 Allow tabbing between widgets to skip inactive widgets (bug#70413) * doc/misc/widget.texi (Widgets and the Buffer, Customization): Document it. * etc/NEWS: Announce it. * lisp/wid-edit.el (widget-skip-inactive): New user option. (widget-tabable-at): Use it. diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index cfb9d2211cf..f74605c92c0 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -795,6 +795,11 @@ Move point @var{count} buttons or editing fields backward. @end deffn @end table +@noindent +By default, tabbing can put point on an inactive widget. To skip over +inactive widgets when tabbing, set the user option +@code{widget-skip-inactive} to a non-@code{nil} value. +@xref{Customization}. When editing an @code{editable-field} widget, the following commands are available: @@ -3321,6 +3326,15 @@ If non-@code{nil}, toggle when there are just two options. By default, its value is @code{nil}. @end defopt +@defopt widget-skip-inactive +If non-@code{nil}, skip over inactive widgets when using @kbd{@key{TAB}} +(@code{widget-forward}) or @kbd{S-@key{TAB}} (@code{widget-backward}, +also bound to @kbd{M-@key{TAB}}) to navigate between widgets. + +By default, its value is @code{nil} and tabbing does not skip over +inactive widgets. +@end defopt + @defopt widget-documentation-links If non-@code{nil}, add hyperlinks to documentation strings. @end defopt diff --git a/etc/NEWS b/etc/NEWS index bc8be557711..e6f8eb5ba46 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1603,6 +1603,13 @@ This allows disabling JavaScript in xwidget Webkit sessions. 'insert-directory', now supports the '--time=TIME' and '--sort=time' options of GNU 'ls'. +** Widget + ++++ +*** New user option 'widget-skip-inactive'. +If non-nil, moving point forward or backward between widgets by typing +TAB or S-TAB skips over inactive widgets. The default value is nil. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 4bc1ebc406a..cb6d8ebc2c4 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1234,11 +1234,20 @@ If nothing was called, return non-nil." (when (commandp command) (call-interactively command)))))) +(defcustom widget-skip-inactive nil + "If non-nil, skip inactive widgets when tabbing through buffer." + :version "30.1" + :group 'widgets + :type 'boolean) + (defun widget-tabable-at (&optional pos) "Return the tabable widget at POS, or nil. -POS defaults to the value of (point)." +POS defaults to the value of (point). If user option +`widget-skip-inactive' is non-nil, inactive widgets are not tabable." (let ((widget (widget-at pos))) - (if widget + (if (and widget (if widget-skip-inactive + (widget-apply widget :active) + t)) (let ((order (widget-get widget :tab-order))) (if order (if (>= order 0) commit 523aca13a45159711d7d9d7561e69d38acdac12a Author: Stefan Monnier Date: Wed Apr 17 10:57:11 2024 -0400 * lisp/emacs-lisp/track-changes.el: Fix trailer diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index 03d031deb4d..c11c976312b 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2024 Free Software Foundation, Inc. ;; Author: Stefan Monnier -;; Version: 1.0 +;; Version: 1.1 ;; Package-Requires: ((emacs "24")) ;; This file is part of GNU Emacs. @@ -638,4 +638,4 @@ Re-arms ID's signal." `(track-changes-fetch ,id (lambda ,vars ,@body))) (provide 'track-changes) -;;; track-changes.el end here. +;;; track-changes.el ends here commit 3660c51736072816b65265e60e0b7475375e2a73 Author: Stefan Monnier Date: Wed Apr 17 09:04:12 2024 -0400 track-changes.el: Fix last change for early use * lisp/emacs-lisp/track-changes.el (track-changes--recover-from-error): Don't burp if there have been fewer than 20 keystrokes since Emacs start. diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index 6e4440b7771..03d031deb4d 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -442,7 +442,7 @@ Details logged to `track-changes--error-log'") (when tail (setcdr tail '...)) bf) (let ((rk (recent-keys 'include-cmds))) - (substring rk -20))) + (if (< (length rk) 20) rk (substring rk -20)))) track-changes--error-log)) (setq track-changes--before-clean 'unset) (setq track-changes--buffer-size (buffer-size)) commit 42b3024ca8e2d844084d2e8c78f58f530e1b18b3 Author: Eli Zaretskii Date: Wed Apr 17 14:50:38 2024 +0300 Another fix for bug#70385 * src/xdisp.c (note_fringe_highlight): Check value of x_y_to_hpos_vpos. diff --git a/src/xdisp.c b/src/xdisp.c index 5073af3e04f..5fe16ab9536 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35770,7 +35770,8 @@ note_fringe_highlight (struct frame *f, Lisp_Object window, int x, int y, /* 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); + if (x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, 0, 0, &area) == NULL) + return; /* not all glyph rows between 0 and Y are enabled */ /* Don't access the TEXT_AREA of a row that does not display text, when the window is outdated, or when vpos overflows the current commit 1606e14c6f1fb5c524dd21ac1b1187b5230f683e Author: Robert Pluim Date: Wed Apr 17 09:04:18 2024 +0200 ; * src/xdisp.c (redisplay_internal): Typo fix in comment diff --git a/src/xdisp.c b/src/xdisp.c index 3db8d64f731..5073af3e04f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -16864,7 +16864,7 @@ redisplay_internal (void) redisplay_trace ("redisplay_internal %d\n", redisplaying_p); /* I don't think this happens but let's be paranoid. In particular, - this was observed happening when Emacs shuits down to to losing X + this was observed happening when Emacs shuts down due to losing X connection, in which case accessing SELECTED_FRAME and the frame structure is likely to barf. */ if (redisplaying_p) commit ada429c375235c4d8bd3bf5e6bb2507fb44f63dd Author: Juri Linkov Date: Wed Apr 17 09:53:02 2024 +0300 * lisp/emacs-lisp/lisp.el (forward-sexp-function): Set back to nil. (forward-sexp): Revert back to checking 'forward-sexp-function' for nil (bug#70426). diff --git a/etc/NEWS b/etc/NEWS index 99f33a7b8dd..bc8be557711 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2103,10 +2103,6 @@ All tree-sitter enabled modes that define 'sentence' in ** Functions and variables to move by program sexps -*** New function 'forward-sexp-default-function'. -The previous implementation of 'forward-sexp' is moved into its -own function, to be bound by 'forward-sexp-function'. - *** New function 'treesit-forward-sexp'. Tree-sitter conditionally sets 'forward-sexp-function' for major modes that have defined 'sexp' in 'treesit-thing-settings' to enable diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index bd0b38db7ea..7e6db51b1d5 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -50,7 +50,7 @@ This affects `insert-parentheses' and `insert-pair'." (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) (if (< arg 0) (backward-prefix-chars))) -(defvar forward-sexp-function #'forward-sexp-default-function +(defvar forward-sexp-function nil ;; FIXME: ;; - for some uses, we may want a "sexp-only" version, which only ;; jumps over a well-formed sexp, rather than some dwimish thing @@ -79,9 +79,9 @@ report errors as appropriate for this kind of usage." "No next sexp" "No previous sexp")))) (or arg (setq arg 1)) - (funcall (or forward-sexp-function - #'forward-sexp-default-function) - arg))) + (if forward-sexp-function + (funcall forward-sexp-function arg) + (forward-sexp-default-function arg)))) (defun backward-sexp (&optional arg interactive) "Move backward across one balanced expression (sexp). diff --git a/lisp/treesit.el b/lisp/treesit.el index 2973aba771c..2b899a84183 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2153,7 +2153,7 @@ by `text' and `sexp' in `treesit-thing-settings'." (let ((arg (or arg 1)) (pred (or treesit-sexp-type-regexp 'sexp))) (or (when (treesit-node-match-p (treesit-node-at (point)) 'text t) - (funcall #'forward-sexp-default-function arg) + (forward-sexp-default-function arg) t) (if (> arg 0) (treesit-end-of-thing pred (abs arg) 'restricted) commit a33ab7565e20d9c04731491f6ae38a8d35be729f Author: Stefan Monnier Date: Tue Apr 16 21:57:05 2024 -0400 track-changes.el: Minor changes for version 1.0 Arrange for the library to be usable on older Emacsen, which includes reducing the noise when `before/after-change-functions` are badly paired or missing. Also, since the signal function receives the distance (for `:disjoint`), we don't need `track-changes--disjoint-threshold`: the signal function can simply do nothing when the distance is smaller than the threshold it wants to use. * lisp/emacs-lisp/track-changes.el: Prepare header for ELPA. (track-changes--tracker, track-changes--state): Don't use `:noinline`, so as to be compatible with Emacs<27. (track-changes-record-errors): New variable. (track-changes--recover-from-error): Use it. Record only the last 20 keys and the last 50 stack frames in the error log. (track-changes--disjoint-threshold): Delete variable. (track-changes--before): Don't use it any more. * lisp/progmodes/eglot.el (eglot--track-changes-signal): Coalesce disjoint changes nearer than what used to be coalesced because of `track-changes--disjoint-threshold`. diff --git a/lisp/emacs-lisp/track-changes.el b/lisp/emacs-lisp/track-changes.el index 9e62b8bdf30..6e4440b7771 100644 --- a/lisp/emacs-lisp/track-changes.el +++ b/lisp/emacs-lisp/track-changes.el @@ -3,6 +3,8 @@ ;; Copyright (C) 2024 Free Software Foundation, Inc. ;; Author: Stefan Monnier +;; Version: 1.0 +;; Package-Requires: ((emacs "24")) ;; This file is part of GNU Emacs. @@ -92,7 +94,7 @@ ;;;; Internal types and variables. (cl-defstruct (track-changes--tracker - (:noinline t) + ;; (:noinline t) ;Requires Emacs≥27 (:constructor nil) (:constructor track-changes--tracker ( signal state &optional @@ -100,7 +102,7 @@ signal state nobefore immediate) (cl-defstruct (track-changes--state - (:noinline t) + ;; (:noinline t) ;Requires Emacs≥27 (:constructor nil) (:constructor track-changes--state ())) "Object holding a description of a buffer state. @@ -164,6 +166,14 @@ This is used to try and detect cases where buffer modifications are \"lost\".") ;;;; Exposed API. +(defvar track-changes-record-errors + ;; By default, record errors only for non-release versions, because we + ;; presume that these might be too old to receive fixes, so better not + ;; annoy the user too much about errors. + (string-match "\\..*\\." emacs-version) + "If non-nil, keep track of errors in `before/after-chage-functions' calls. +The errors are kept in `track-changes--error-log'.") + (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. @@ -412,9 +422,6 @@ and re-enable the TRACKER corresponding to ID." (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).") @@ -424,12 +431,19 @@ Each element is a triplet (BUFFER-NAME BACKTRACE RECENT-KEYS).") ;; 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'!! + (if (not track-changes-record-errors) + (message "Recovering from confusing calls to `before/after-change-functions'!") + (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) + (push (list (buffer-name) + (let* ((bf (backtrace-frames + #'track-changes--recover-from-error)) + (tail (nthcdr 50 bf))) + (when tail (setcdr tail '...)) + bf) + (let ((rk (recent-keys 'include-cmds))) + (substring rk -20))) + 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! @@ -453,11 +467,10 @@ Details logged to `track-changes--error-log'") (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) + ;; If the distance is smaller than the size of the + ;; current change, then we may as well consider it + ;; as "near". + (max (length track-changes--before-string) size (- track-changes--before-end track-changes--before-beg))) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 478e7687bb3..5e4f7bba679 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2665,7 +2665,9 @@ Records BEG, END and PRE-CHANGE-LENGTH locally." (defun eglot--track-changes-signal (id &optional distance) (cl-incf eglot--versioned-identifier) (cond - (distance (eglot--track-changes-fetch id)) + (distance + ;; When distance is <100, we may as well coalesce the changes. + (when (> distance 100) (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. @@ -2796,6 +2798,7 @@ When called interactively, use the currently active server" (list :textDocument (eglot--VersionedTextDocumentIdentifier) :contentChanges + (let ((changes (if full-sync-p (vector `(:text ,(eglot--widening (buffer-substring-no-properties (point-min) @@ -2809,6 +2812,8 @@ When called interactively, use the currently active server" when (numberp len) ;FIXME: Not needed with `track-changes'. vconcat `[,(list :range `(:start ,beg :end ,end) :rangeLength len :text text)])))) + (message "Sending changes: %S" changes) + changes))) (setq eglot--recent-changes nil) (jsonrpc--call-deferred server)))) commit 484b0979099d91e286c248e32b2f693111fac2ad Author: Stefan Monnier Date: Tue Apr 16 21:17:47 2024 -0400 (cl-defstruct): Improve handling of unknown options Until now `cl-defstruct` signaled an error when encountering an unknown option. It's easy to code and it does the job, but it doesn't give good location info in the compiler's output, and it makes it more painful to use not-yet-supported options. So just signal a warning instead. * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Warn about unknown options, instead of signaling an error. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 1350e474d6a..2e501005bf7 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3010,6 +3010,7 @@ To see the documentation for a defined struct type, use ;; All the above is for the following def-form. &rest &or symbolp (symbolp &optional def-form &rest sexp)))) (let* ((name (if (consp struct) (car struct) struct)) + (warning nil) (opts (cdr-safe struct)) (slots nil) (defaults nil) @@ -3094,7 +3095,10 @@ To see the documentation for a defined struct type, use (setq descs (nconc (make-list (car args) '(cl-skip-slot)) descs))) (t - (error "Structure option %s unrecognized" opt))))) + (setq warning + (macroexp-warn-and-return + (format "Structure option %S unrecognized" opt) + warning nil nil (list opt struct))))))) (unless (or include-name type ;; Don't create a bogus parent to `cl-structure-object' ;; while compiling the (cl-defstruct cl-structure-object ..) @@ -3333,6 +3337,7 @@ To see the documentation for a defined struct type, use (cl-struct-define ',name ,docstring ',include-name ',(or type 'record) ,(eq named t) ',descs ',tag-symbol ',tag ',print-auto)) + ,warning ',name))) ;;; Add cl-struct support to pcase commit 2141caca30860ee04cad44ae2ad32744c1c11987 Author: Eric Abrahamsen Date: Mon Apr 15 20:14:50 2024 -0700 ; Improvements to PEG documentation (second attempt) * doc/lispref/peg.texi: Make more use of defmac/defmacro, and try to clarify the relationships between the various macros and functions. * lisp/progmodes/peg.el (peg-parse): Remove claim that PEXS can also be a single list of rules. diff --git a/doc/lispref/peg.texi b/doc/lispref/peg.texi index fbf57852ee0..72a7cacac20 100644 --- a/doc/lispref/peg.texi +++ b/doc/lispref/peg.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990--1995, 1998--1999, 2001--2023 Free Software +@c Copyright (C) 1990--1995, 1998--1999, 2001--2024 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Parsing Expression Grammars @@ -45,34 +45,57 @@ rule. For instance: @end example Once defined, grammars can be used to parse text after point in the -current buffer, in the following ways: +current buffer, in a number of ways. The @code{peg-parse} macro is the +simplest: @defmac peg-parse &rest pexs -Match @var{pexs} at point. If @var{pexs} is a list of PEG rules, the -first rule is considered the ``entry-point'': +Match @var{pexs} at point. @end defmac @example @group (peg-parse - ((number sign digit (* digit)) - (sign (or "+" "-" "")) - (digit [0-9]))) + (number sign digit (* digit)) + (sign (or "+" "-" "")) + (digit [0-9])) @end group @end example -@c FIXME: These two should be formally defined using @defmac and @defun. -@findex with-peg-rules -@findex peg-run -The @code{peg-parse} macro represents the simplest use of the -@acronym{PEG} library, but also the least flexible, as the rules must be -written directly into the source code. A more flexible approach -involves use of three macros in conjunction: @code{with-peg-rules}, a -@code{let}-like construct that makes a set of rules available within the -macro body; @code{peg-run}, which initiates parsing given a single rule; -and @code{peg}, which is used to wrap the entry-point rule name. In -fact, a call to @code{peg-parse} expands to just this set of calls. The -above example could be written as: +While this macro is simple it is also inflexible, as the rules must be +written directly into the source code. More flexibility can be gained +by using a combination of other functions and macros. + +@defmac with-peg-rules rules &rest body +Execute @var{body} with @var{rules}, a list of @acronym{PEX}s, in +effect. Within @var{BODY}, parsing is initiated with a call to +@code{peg-run}. +@end defmac + +@defun peg-run peg-matcher &optional failure-function success-function +This function accepts a single @var{peg-matcher}, which is the result of +calling @code{peg} (see below) on a named rule, usually the entry-point +of a larger grammar. + +At the end of parsing, one of @var{failure-function} or +@var{success-function} is called, depending on whether the parsing +succeeded or not. If @var{success-function} is called, it is passed a +lambda form that runs all the actions collected on the stack during +parsing -- by default this lambda form is simply executed. If parsing +fails, the @var{failure-function} is called with a list of @acronym{PEG} +expressions that failed during parsing; by default this list is +discarded. +@end defun + +The @var{peg-matcher} passed to @code{peg-run} is produced by a call to +@code{peg}: + +@defmac peg &rest pexs +Convert @var{pexs} into a single peg-matcher suitable for passing to +@code{peg-run}. +@end defmac + +The @code{peg-parse} example above expands to a set of calls to these +functions, and could be written in full as: @example @group @@ -84,14 +107,19 @@ above example could be written as: @end group @end example -This allows more explicit control over the ``entry-point'' of parsing, -and allows the combination of rules from different sources. +This approach allows more explicit control over the ``entry-point'' of +parsing, and allows the combination of rules from different sources. -@c FIXME: Use @defmac. -@findex define-peg-rule Individual rules can also be defined using a more @code{defun}-like syntax, using the macro @code{define-peg-rule}: +@defmac define-peg-rule name args &rest pexs +Define @var{name} as a PEG rule that accepts @var{args} and matches +@var{pexs} at point. +@end defmac + +For instance: + @example @group (define-peg-rule digit () @@ -99,14 +127,16 @@ syntax, using the macro @code{define-peg-rule}: @end group @end example -This also allows for rules that accept an argument (supplied by the -@code{funcall} PEG rule, @pxref{PEX Definitions}). +Arguments can be supplied to rules by the @code{funcall} PEG rule +(@pxref{PEX Definitions}). -@c FIXME: Use @defmac. -@findex define-peg-ruleset Another possibility is to define a named set of rules with @code{define-peg-ruleset}: +@defmac define-peg-ruleset name &rest rules +Define @var{name} as an identifier for @var{rules}. +@end defmac + @example @group (define-peg-ruleset number-grammar @@ -240,10 +270,10 @@ Returns non-@code{nil} if parsing @acronym{PEX} @var{e} from point fails Treats the value of the Lisp expression @var{exp} as a boolean. @end table -@c FIXME: peg-char-classes should be mentioned in the text below. @vindex peg-char-classes -Character class matching can use the same named character classes as -in regular expressions (@pxref{Top,, Character Classes,elisp}) +Character-class matching can refer to the classes named in +@code{peg-char-classes}, equivalent to character classes in regular +expressions (@pxref{Top,, Character Classes,elisp}) @node Parsing Actions @section Parsing Actions diff --git a/lisp/progmodes/peg.el b/lisp/progmodes/peg.el index bb57650d883..938f8da910d 100644 --- a/lisp/progmodes/peg.el +++ b/lisp/progmodes/peg.el @@ -316,13 +316,14 @@ EXPS is a list of rules/expressions that failed.") "Match PEXS at point. PEXS is a sequence of PEG expressions, implicitly combined with `and'. Returns STACK if the match succeed and signals an error on failure, -moving point along the way. -PEXS can also be a list of PEG rules, in which case the first rule is used." +moving point along the way." (if (and (consp (car pexs)) (symbolp (caar 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. + ;; The first of `pexs' has not been defined as a rule, so assume + ;; that none of them have been and they should be fed to + ;; `with-peg-rules' `(with-peg-rules ,pexs (peg-run (peg ,(caar pexs)) #'peg-signal-failure)) `(peg-run (peg ,@pexs) #'peg-signal-failure))) commit d39f0a165a7f87336990e3304f1a8fa455a61600 Author: Eli Zaretskii Date: Tue Apr 16 21:23:37 2024 +0300 * src/xdisp.c (note_fringe_highlight): Another attempt to fix bug#70385. diff --git a/src/xdisp.c b/src/xdisp.c index f8c8d763c5b..3db8d64f731 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35775,7 +35775,8 @@ note_fringe_highlight (struct frame *f, Lisp_Object window, int x, int y, /* Don't access the TEXT_AREA of a row that does not display text, when the window is outdated, or when vpos overflows the current matrix. (bug#70385) */ - if (window_outdated (w) + if (!w->window_end_valid + || window_outdated (w) || (vpos >= w->current_matrix->nrows) || !MATRIX_ROW_DISPLAYS_TEXT_P (MATRIX_ROW (w->current_matrix, vpos))) commit 1be21dd95388037cfb71474a1fbd2a7d3583a80a Author: Eli Zaretskii Date: Tue Apr 16 15:12:42 2024 +0300 Minor fix in detecting recursive redisplay invocations * src/xdisp.c (redisplay_internal): Detect recursive invocations earlier. (Bug#66416) diff --git a/src/xdisp.c b/src/xdisp.c index b154211cc3c..f8c8d763c5b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -16863,6 +16863,13 @@ redisplay_internal (void) redisplay_trace ("redisplay_internal %d\n", redisplaying_p); + /* I don't think this happens but let's be paranoid. In particular, + this was observed happening when Emacs shuits down to to losing X + connection, in which case accessing SELECTED_FRAME and the frame + structure is likely to barf. */ + if (redisplaying_p) + return; + /* No redisplay if running in batch mode or frame is not yet fully initialized, or redisplay is explicitly turned off by setting Vinhibit_redisplay. */ @@ -16890,10 +16897,6 @@ redisplay_internal (void) return; #endif - /* I don't think this happens but let's be paranoid. */ - if (redisplaying_p) - return; - /* Record a function that clears redisplaying_p when we leave this function. */ specpdl_ref count = SPECPDL_INDEX (); commit 9a673c6914d4ab39139a91e892089dac70206cd2 Author: Mattias Engdegård Date: Tue Apr 16 11:59:20 2024 +0200 Revert "; Improvements to PEG documentation" This reverts commit 930c578c1042e6372e5433e31b2ea801315c01c9. Looks like an editing mistake ate a large part of the text. diff --git a/doc/lispref/peg.texi b/doc/lispref/peg.texi index 90aa76988db..fbf57852ee0 100644 --- a/doc/lispref/peg.texi +++ b/doc/lispref/peg.texi @@ -1,31 +1,78 @@ -struct makes a set of rules available within its -body. The actual parsing is initiated with @code{peg-run}: - -@defun peg-run peg-matcher &optional failure-function success-function -This function accepts a single @var{peg-matcher}, which is the result of -calling @code{peg} (see below) on a named rule, usually the entry-point -of a larger grammar. - -At the end of parsing, one of @var{failure-function} or -@var{success-function} is called, depending on whether the parsing -succeeded or not. If @var{success-function} is called, it is passed a -lambda form that runs all the actions collected on the stack during -parsing -- by default this lambda form is simply executed. If parsing -fails, the @var{failure-function} is called with a list of @acronym{PEG} -expressions that failed during parsing; by default this list is -discarded. -@end defun - -The @var{peg-matcher} passed to @code{peg-run} is produced by a call to -@code{peg}: - -@defmac peg &rest pexs -Convert @var{pexs} into a single peg-matcher suitable for passing to -@code{peg-run}. +@c -*-texinfo-*- +@c This is part of the GNU Emacs Lisp Reference Manual. +@c Copyright (C) 1990--1995, 1998--1999, 2001--2023 Free Software +@c Foundation, Inc. +@c See the file elisp.texi for copying conditions. +@node Parsing Expression Grammars +@chapter Parsing Expression Grammars +@cindex text parsing +@cindex parsing expression grammar +@cindex PEG + + Emacs Lisp provides several tools for parsing and matching text, +from regular expressions (@pxref{Regular Expressions}) to full +left-to-right (a.k.a.@: @acronym{LL}) grammar parsers (@pxref{Top,, +Bovine parser development,bovine}). @dfn{Parsing Expression Grammars} +(@acronym{PEG}) are another approach to text parsing that offer more +structure and composibility than regular expressions, but less +complexity than context-free grammars. + +A Parsing Expression Grammar (@acronym{PEG}) describes a formal language +in terms of a set of rules for recognizing strings in the language. In +Emacs, a @acronym{PEG} parser is defined as a list of named rules, each +of which matches text patterns and/or contains references to other +rules. Parsing is initiated with the function @code{peg-run} or the +macro @code{peg-parse} (see below), and parses text after point in the +current buffer, using a given set of rules. + +@cindex parsing expression +@cindex root, of parsing expression grammar +@cindex entry-point, of parsing expression grammar +Each rule in a @acronym{PEG} is referred to as a @dfn{parsing +expression} (@acronym{PEX}), and can be specified a a literal string, a +regexp-like character range or set, a peg-specific construct resembling +an Emacs Lisp function call, a reference to another rule, or a +combination of any of these. A grammar is expressed as a tree of rules +in which one rule is typically treated as a ``root'' or ``entry-point'' +rule. For instance: + +@example +@group +((number sign digit (* digit)) + (sign (or "+" "-" "")) + (digit [0-9])) +@end group +@end example + +Once defined, grammars can be used to parse text after point in the +current buffer, in the following ways: + +@defmac peg-parse &rest pexs +Match @var{pexs} at point. If @var{pexs} is a list of PEG rules, the +first rule is considered the ``entry-point'': @end defmac -The @code{peg-parse} example above expands to just this set of calls, -and could be written as: +@example +@group +(peg-parse + ((number sign digit (* digit)) + (sign (or "+" "-" "")) + (digit [0-9]))) +@end group +@end example + +@c FIXME: These two should be formally defined using @defmac and @defun. +@findex with-peg-rules +@findex peg-run +The @code{peg-parse} macro represents the simplest use of the +@acronym{PEG} library, but also the least flexible, as the rules must be +written directly into the source code. A more flexible approach +involves use of three macros in conjunction: @code{with-peg-rules}, a +@code{let}-like construct that makes a set of rules available within the +macro body; @code{peg-run}, which initiates parsing given a single rule; +and @code{peg}, which is used to wrap the entry-point rule name. In +fact, a call to @code{peg-parse} expands to just this set of calls. The +above example could be written as: @example @group @@ -37,19 +84,14 @@ and could be written as: @end group @end example -This approach allows more explicit control over the ``entry-point'' of -parsing, and allows the combination of rules from different sources. +This allows more explicit control over the ``entry-point'' of parsing, +and allows the combination of rules from different sources. +@c FIXME: Use @defmac. +@findex define-peg-rule Individual rules can also be defined using a more @code{defun}-like syntax, using the macro @code{define-peg-rule}: -@defmac define-peg-rule name args &rest pexs -Define @var{name} as a PEG rule that accepts @var{args} and matches -@var{pexs} at point. -@end defmac - -For instance: - @example @group (define-peg-rule digit () @@ -57,16 +99,14 @@ For instance: @end group @end example -Arguments can be supplied to rules by the @code{funcall} PEG rule -(@pxref{PEX Definitions}). +This also allows for rules that accept an argument (supplied by the +@code{funcall} PEG rule, @pxref{PEX Definitions}). +@c FIXME: Use @defmac. +@findex define-peg-ruleset Another possibility is to define a named set of rules with @code{define-peg-ruleset}: -@defmac define-peg-ruleset name &rest rules -Define @var{name} as an identifier for @var{rules}. -@end defmac - @example @group (define-peg-ruleset number-grammar @@ -200,10 +240,10 @@ Returns non-@code{nil} if parsing @acronym{PEX} @var{e} from point fails Treats the value of the Lisp expression @var{exp} as a boolean. @end table +@c FIXME: peg-char-classes should be mentioned in the text below. @vindex peg-char-classes -Character-class matching can refer to the classes named in -@code{peg-char-classes}, equivalent to character classes in regular -expressions (@pxref{Top,, Character Classes,elisp}) +Character class matching can use the same named character classes as +in regular expressions (@pxref{Top,, Character Classes,elisp}) @node Parsing Actions @section Parsing Actions diff --git a/lisp/progmodes/peg.el b/lisp/progmodes/peg.el index 938f8da910d..bb57650d883 100644 --- a/lisp/progmodes/peg.el +++ b/lisp/progmodes/peg.el @@ -316,14 +316,13 @@ EXPS is a list of rules/expressions that failed.") "Match PEXS at point. PEXS is a sequence of PEG expressions, implicitly combined with `and'. Returns STACK if the match succeed and signals an error on failure, -moving point along the way." +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 (not (eq 'call (car (peg-normalize (car pexs)))))))) - ;; The first of `pexs' has not been defined as a rule, so assume - ;; that none of them have been and they should be fed to - ;; `with-peg-rules' + ;; `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))) commit b47b8159d88a9bef5a6bfd72e5c81ba2f6df95b5 Author: Michael Albinus Date: Tue Apr 16 10:55:37 2024 +0200 Adapt tree-sitter job on EMBA * test/infra/gitlab-ci.yml (.tree-sitter-template) (test-tree-sitter): Adapt tree-sitter job. diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 5299aee746b..4c44ba6c55c 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -183,9 +183,15 @@ default: changes: - "**.in" - lisp/progmodes/*-ts-mode.el + - lisp/progmodes/js.el + - lisp/progmodes/python.el + - src/treesit.{h,c} - test/infra/* - test/lisp/progmodes/*-ts-mode-resources/** - test/lisp/progmodes/*-ts-mode-tests.el + - test/lisp/progmodes/js-tests.el + - test/lisp/progmodes/python-tests.el + - test/src/treesit-tests.el .native-comp-template: rules: @@ -282,7 +288,7 @@ test-tree-sitter: variables: target: emacs-tree-sitter # This is needed in order to get a JUnit test report. - make_params: '-k -C test check-expensive TEST_HOME=/root LOGFILES="$tree_sitter_files"' + make_params: '-k -C test SELECTOR=\(and\ \$\{SELECTOR_EXPENSIVE\}\ \\\"-ts-\\\"\) TEST_HOME=/root LOGFILES="$tree_sitter_files"' build-image-gnustep: stage: platform-images commit f5e0fb11dbf4d2cc5d7ceabcec7600556fb12843 Author: Po Lu Date: Tue Apr 16 15:38:53 2024 +0800 Fix touch screen hscroll when initiated from widgets * lisp/wid-edit.el (widget-button--check-and-call-button): Return to the position of point during the tracking loop if a touch event is canceled. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 172da3db1e0..4bc1ebc406a 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1093,77 +1093,92 @@ If nothing was called, return non-nil." (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1))) (pos (widget-event-point event)) newpoint) - (catch 'button-press-cancelled - ;; Mouse click on a widget button. Do the following - ;; in a save-excursion so that the click on the button - ;; doesn't change point. - (save-selected-window - (select-window (posn-window (event-start event))) - (save-excursion - (goto-char (posn-point (event-start event))) - (let* ((overlay (widget-get button :button-overlay)) - (pressed-face (or (widget-get button :pressed-face) - widget-button-pressed-face)) - (face (overlay-get overlay 'face)) - (mouse-face (overlay-get overlay 'mouse-face))) - (unwind-protect - ;; Read events, including mouse-movement events, - ;; waiting for a release event. If we began with a - ;; mouse-1 event and receive a movement event, that - ;; means the user wants to perform drag-selection, so - ;; cancel the button press and do the default mouse-1 - ;; action. For mouse-2, just highlight/ unhighlight - ;; the button the mouse was initially on when we move - ;; over it. - ;; - ;; If this function was called in response to a - ;; touchscreen event, then wait for a corresponding - ;; touchscreen-end event instead. - (save-excursion - (when face ; avoid changing around image - (overlay-put overlay 'face pressed-face) - (overlay-put overlay 'mouse-face pressed-face)) - (if (eq (car event) 'touchscreen-begin) - ;; This a touchscreen event and must be handled - ;; specially through `touch-screen-track-tap'. - (progn - (unless (touch-screen-track-tap event nil nil t) - (throw 'button-press-cancelled t))) - (unless (widget-apply button :mouse-down-action event) - (let ((track-mouse t)) - (while (not (widget-button-release-event-p event)) - (setq event (read--potential-mouse-event)) - (when (and mouse-1 (mouse-movement-p event)) - (push event unread-command-events) - (setq event oevent) - (throw 'button-press-cancelled t)) - (unless (or (integerp event) - (memq (car event) - '(switch-frame select-window)) - (eq (car event) 'scroll-bar-movement)) - (setq pos (widget-event-point event)) - (if (and pos - (eq (get-char-property pos 'button) - button)) - (when face - (overlay-put overlay 'face pressed-face) - (overlay-put overlay 'mouse-face pressed-face)) - (overlay-put overlay 'face face) - (overlay-put overlay 'mouse-face mouse-face))))))) - - ;; When mouse is released over the button, run - ;; its action function. - (when (and pos (eq (get-char-property pos 'button) button)) - (goto-char pos) - (widget-apply-action button event) - (if widget-button-click-moves-point - (setq newpoint (point))))) - (overlay-put overlay 'face face) - (overlay-put overlay 'mouse-face mouse-face)))) - - (when newpoint - (goto-char newpoint))) - nil))) + (setq newpoint + (catch 'button-press-cancelled + ;; Mouse click on a widget button. Do the following + ;; in a save-excursion so that the click on the button + ;; doesn't change point. + (save-selected-window + (select-window (posn-window (event-start event))) + (save-excursion + (goto-char (posn-point (event-start event))) + (let* ((overlay (widget-get button :button-overlay)) + (pressed-face (or (widget-get button :pressed-face) + widget-button-pressed-face)) + (face (overlay-get overlay 'face)) + (mouse-face (overlay-get overlay 'mouse-face))) + (unwind-protect + ;; Read events, including mouse-movement events, + ;; waiting for a release event. If we began with + ;; a mouse-1 event and receive a movement event, + ;; that means the user wants to perform + ;; drag-selection, so cancel the button press and + ;; do the default mouse-1 action. For mouse-2, + ;; just highlight/ unhighlight the button the + ;; mouse was initially on when we move over it. + ;; + ;; If this function was called in response to a + ;; touchscreen event, then wait for a + ;; corresponding touchscreen-end event instead. + (save-excursion + (when face ; avoid changing around image + (overlay-put overlay 'face pressed-face) + (overlay-put overlay 'mouse-face pressed-face)) + (if (eq (car event) 'touchscreen-begin) + ;; This a touchscreen event and must be + ;; handled specially through + ;; `touch-screen-track-tap'. + (progn + (unless (touch-screen-track-tap event nil nil t) + ;; Report the current position of point + ;; to the catch block. + (throw 'button-press-cancelled (point)))) + (unless (widget-apply button :mouse-down-action event) + (let ((track-mouse t)) + (while (not (widget-button-release-event-p event)) + (setq event (read--potential-mouse-event)) + (when (and mouse-1 (mouse-movement-p event)) + (push event unread-command-events) + (setq event oevent) + (throw 'button-press-cancelled t)) + (unless (or (integerp event) + (memq (car event) + '(switch-frame select-window)) + (eq (car event) + 'scroll-bar-movement)) + (setq pos (widget-event-point event)) + (if (and pos + (eq (get-char-property pos 'button) + button)) + (when face + (overlay-put overlay + 'face pressed-face) + (overlay-put overlay + 'mouse-face pressed-face)) + (overlay-put overlay + 'face face) + (overlay-put overlay + 'mouse-face mouse-face))))))) + + ;; When mouse is released over the button, run + ;; its action function. + (when (and pos (eq (get-char-property pos 'button) + button)) + (goto-char pos) + (widget-apply-action button event) + (if widget-button-click-moves-point + (setq newpoint (point))))) + (overlay-put overlay 'face face) + (overlay-put overlay 'mouse-face mouse-face)))) + (when newpoint + (goto-char newpoint))) + nil)) + ;; Return to the position of point as it existed during the + ;; button-tracking loop if the event being tracked is a touch screen + ;; event, to prevent hscroll from being disturbed by movement of + ;; point to any previous location outside the visible confines of + ;; the window. + (when newpoint (goto-char newpoint)))) (defun widget-button-click (event) "Invoke the button that the mouse is pointing at." commit c59e67a41c512467a54cc92ed0fdb6c3b9e9ace8 Author: Po Lu Date: Tue Apr 16 14:54:32 2024 +0800 Another fix for bug#70385 * src/xdisp.c (note_fringe_highlight): Test that vpos falls within W->current_matrix. (bug#70385) diff --git a/src/xdisp.c b/src/xdisp.c index d984c12d1aa..b154211cc3c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -35769,9 +35769,11 @@ note_fringe_highlight (struct frame *f, Lisp_Object window, int x, int y, struct window *w = XWINDOW (window); x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, 0, 0, &area); - /* Don't access the TEXT_AREA of a row that does not display text, or - when the window is outdated. (bug#70385) */ + /* Don't access the TEXT_AREA of a row that does not display text, + when the window is outdated, or when vpos overflows the current + matrix. (bug#70385) */ if (window_outdated (w) + || (vpos >= w->current_matrix->nrows) || !MATRIX_ROW_DISPLAYS_TEXT_P (MATRIX_ROW (w->current_matrix, vpos))) return;