aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPo Lu2023-04-14 08:02:14 +0800
committerPo Lu2023-04-14 08:02:14 +0800
commit618ba26ed190f0b4b0fe725d4e717c01ce9fbeed (patch)
tree41411eb10c7371c6b11fc2fa1124f999abcb1733
parente11e56a057aae22872014e97684e0a9b3fbde156 (diff)
parent2c3ca78e811b288aa4801f78c11ba9ddf9ffe02c (diff)
downloademacs-618ba26ed190f0b4b0fe725d4e717c01ce9fbeed.tar.gz
emacs-618ba26ed190f0b4b0fe725d4e717c01ce9fbeed.zip
Merge remote-tracking branch 'origin/master' into feature/android
-rw-r--r--doc/misc/flymake.texi24
-rw-r--r--etc/NEWS10
-rw-r--r--lisp/emacs-lisp/byte-opt.el375
-rw-r--r--lisp/emacs-lisp/cl-macs.el54
-rw-r--r--lisp/emacs-lisp/eldoc.el37
-rw-r--r--lisp/progmodes/eglot.el129
-rw-r--r--lisp/progmodes/flymake.el89
-rw-r--r--lisp/subr.el2
-rw-r--r--src/data.c5
-rw-r--r--src/eval.c3
-rw-r--r--src/treesit.c201
-rw-r--r--test/lisp/progmodes/eglot-tests.el29
-rw-r--r--test/lisp/simple-tests.el6
-rw-r--r--test/src/treesit-tests.el115
14 files changed, 736 insertions, 343 deletions
diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi
index 13616f39f16..b6a540a6ea3 100644
--- a/doc/misc/flymake.texi
+++ b/doc/misc/flymake.texi
@@ -1,7 +1,7 @@
1\input texinfo @c -*- mode: texinfo; coding: utf-8 -*- 1\input texinfo @c -*- mode: texinfo; coding: utf-8 -*-
2@comment %**start of header 2@comment %**start of header
3@setfilename ../../info/flymake.info 3@setfilename ../../info/flymake.info
4@set VERSION 1.3.3 4@set VERSION 1.3.4
5@set UPDATED April 2023 5@set UPDATED April 2023
6@settitle GNU Flymake @value{VERSION} 6@settitle GNU Flymake @value{VERSION}
7@include docstyle.texi 7@include docstyle.texi
@@ -142,6 +142,12 @@ highlighted regions to learn what the specific problem
142is. Alternatively, place point on the highlighted regions and use the 142is. Alternatively, place point on the highlighted regions and use the
143commands @code{eldoc} or @code{display-local-help}. 143commands @code{eldoc} or @code{display-local-help}.
144 144
145Another easy way to get instant access to the diagnostic text is to
146set @code{flymake-show-diagnostics-at-end-of-line} to a non-@code{nil}
147value. This makes the diagnostic messages appear at the end of the
148line where the regular annotation is located (@pxref{Customizable
149variables})
150
145@cindex next and previous diagnostic 151@cindex next and previous diagnostic
146If the diagnostics are outside the visible region of the buffer, 152If the diagnostics are outside the visible region of the buffer,
147@code{flymake-goto-next-error} and @code{flymake-goto-prev-error} are 153@code{flymake-goto-next-error} and @code{flymake-goto-prev-error} are
@@ -314,6 +320,22 @@ Which fringe (if any) should show the warning/error bitmaps.
314@item flymake-wrap-around 320@item flymake-wrap-around
315If non-@code{nil}, moving to errors with @code{flymake-goto-next-error} and 321If non-@code{nil}, moving to errors with @code{flymake-goto-next-error} and
316@code{flymake-goto-prev-error} wraps around buffer boundaries. 322@code{flymake-goto-prev-error} wraps around buffer boundaries.
323
324@item flymake-show-diagnostics-at-end-of-line
325If non-@code{nil}, show summarized descriptions of diagnostics at the
326end of the line. Depending on your preference, this can either be
327distracting and easily confused with actual code, or a significant
328early aid that relieves you from moving around or reaching for the
329mouse to consult an error message.
330
331@item flymake-error-eol
332A custom face for summarizing diagnostic error messages.
333
334@item flymake-warning-eol
335A custom face for summarizing diagnostic warning messages.
336
337@item flymake-note-eol
338A custom face for summarizing diagnostic notes.
317@end vtable 339@end vtable
318 340
319@node Extending Flymake 341@node Extending Flymake
diff --git a/etc/NEWS b/etc/NEWS
index 3a44d016de2..e507ef1b55e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -277,13 +277,21 @@ following to your init file:
277 #'shortdoc-help-fns-examples-function) 277 #'shortdoc-help-fns-examples-function)
278 278
279** Package 279** Package
280
281--- 280---
282*** New user option 'package-vc-register-as-project'. 281*** New user option 'package-vc-register-as-project'.
283When non-nil, it will automatically register every package as a 282When non-nil, it will automatically register every package as a
284project, that you can quickly select using 'project-switch-project' 283project, that you can quickly select using 'project-switch-project'
285('C-x p p'). 284('C-x p p').
286 285
286** Flymake
287+++
288*** New user option 'flymake-show-diagnostics-at-end-of-line'.
289When non-nil, Flymake shows summarized descriptions of diagnostics at
290the end of the line. Depending on your preference, this can either be
291distracting and easily confused with actual code, or a significant
292early aid that relieves you from moving the buffer or reaching for the
293mouse to consult an error message.
294
287 295
288* New Modes and Packages in Emacs 30.1 296* New Modes and Packages in Emacs 30.1
289 297
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index c9c94f51ef0..2bdd3375728 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1636,99 +1636,231 @@ See Info node `(elisp) Integer Basics'."
1636 1636
1637;; I wonder if I missed any :-\) 1637;; I wonder if I missed any :-\)
1638(let ((side-effect-free-fns 1638(let ((side-effect-free-fns
1639 '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan 1639 '(
1640 assq 1640 ;; alloc.c
1641 base64-decode-string base64-encode-string base64url-encode-string 1641 make-bool-vector make-byte-code make-list make-record make-string
1642 make-symbol make-vector
1643 ;; buffer.c
1644 buffer-base-buffer buffer-chars-modified-tick buffer-file-name
1645 buffer-local-value buffer-local-variables buffer-modified-p
1646 buffer-modified-tick buffer-name get-buffer next-overlay-change
1647 overlay-buffer overlay-end overlay-get overlay-properties
1648 overlay-start overlays-at overlays-in previous-overlay-change
1649 ;; callint.c
1650 prefix-numeric-value
1651 ;; casefiddle.c
1652 capitalize downcase upcase upcase-initials
1653 ;; category.c
1654 category-docstring category-set-mnemonics char-category-set
1655 copy-category-table get-unused-category make-category-set
1656 ;; character.c
1657 char-width multibyte-char-to-unibyte string unibyte-char-to-multibyte
1658 ;; charset.c
1659 decode-char encode-char
1660 ;; chartab.c
1661 make-char-table
1662 ;; data.c
1663 % * + - / /= 1+ 1- < <= = > >=
1664 aref ash bare-symbol
1642 bool-vector-count-consecutive bool-vector-count-population 1665 bool-vector-count-consecutive bool-vector-count-population
1643 bool-vector-subsetp 1666 bool-vector-subsetp
1644 boundp buffer-file-name buffer-local-variables buffer-modified-p 1667 boundp car cdr default-boundp default-value fboundp
1645 buffer-substring 1668 get-variable-watchers indirect-variable
1646 capitalize car-less-than-car car cdr ceiling char-after char-before 1669 local-variable-if-set-p local-variable-p
1647 char-equal char-to-string char-width compare-strings 1670 logand logcount logior lognot logxor max min mod
1648 window-configuration-equal-p concat coordinates-in-window-p 1671 number-to-string position-symbol string-to-number
1649 copy-alist copy-sequence copy-marker copysign cos 1672 subr-arity subr-name subr-native-lambda-list subr-type
1650 current-time-string current-time-zone 1673 symbol-function symbol-name symbol-plist symbol-value
1651 decode-char 1674 symbol-with-pos-pos variable-binding-locus
1652 decode-time default-boundp default-value documentation downcase 1675 ;; doc.c
1653 elt encode-char exp expt encode-time error-message-string 1676 documentation
1654 fboundp fceiling featurep ffloor 1677 ;; editfns.c
1655 file-directory-p file-exists-p file-locked-p file-name-absolute-p 1678 buffer-substring buffer-substring-no-properties
1656 file-name-concat 1679 byte-to-position byte-to-string
1657 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p 1680 char-after char-before char-equal char-to-string
1658 float float-time floor format format-message format-time-string 1681 compare-buffer-substrings
1659 frame-first-window frame-root-window frame-selected-window 1682 format format-message
1660 frame-visible-p fround ftruncate 1683 group-name
1661 get gethash get-buffer get-buffer-window get-file-buffer 1684 line-beginning-position line-end-position ngettext pos-bol pos-eol
1662 hash-table-count 1685 propertize region-beginning region-end string-to-char
1663 intern-soft isnan 1686 user-full-name user-login-name
1664 keymap-parent 1687 ;; fileio.c
1665 ldexp 1688 car-less-than-car directory-name-p file-directory-p file-exists-p
1666 length length< length> length= 1689 file-name-absolute-p file-name-concat file-newer-than-file-p
1667 line-beginning-position line-end-position pos-bol pos-eol 1690 file-readable-p file-symlink-p file-writable-p
1668 local-variable-if-set-p local-variable-p locale-info 1691 ;; filelock.c
1669 log logand logb logcount logior lognot logxor 1692 file-locked-p
1670 make-byte-code make-list make-string make-symbol marker-buffer max 1693 ;; floatfns.c
1671 match-beginning match-end 1694 abs acos asin atan ceiling copysign cos exp expt fceiling ffloor
1672 member memq memql min minibuffer-selected-window minibuffer-window 1695 float floor fround ftruncate isnan ldexp log logb round sin sqrt tan
1673 mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string 1696 truncate
1674 prefix-numeric-value previous-window prin1-to-string propertize 1697 ;; fns.c
1675 rassq rassoc read-from-string 1698 append assq
1676 regexp-quote region-beginning region-end reverse round 1699 base64-decode-string base64-encode-string base64url-encode-string
1677 sin sqrt string string-equal string-lessp 1700 compare-strings concat copy-alist copy-hash-table copy-sequence elt
1678 string-search string-to-char 1701 featurep get
1679 string-to-number string-to-syntax substring substring-no-properties 1702 gethash hash-table-count hash-table-rehash-size
1680 sxhash-equal sxhash-eq sxhash-eql 1703 hash-table-rehash-threshold hash-table-size hash-table-test
1681 symbol-function symbol-name symbol-plist symbol-value 1704 hash-table-weakness
1682 string-make-unibyte 1705 length length< length= length>
1683 string-make-multibyte string-as-multibyte string-as-unibyte 1706 line-number-at-pos locale-info make-hash-table
1684 string-to-multibyte 1707 member memq memql nth nthcdr
1685 take tan time-convert truncate 1708 object-intervals rassoc rassq reverse
1686 unibyte-char-to-multibyte upcase user-full-name 1709 string-as-multibyte string-as-unibyte string-bytes string-distance
1687 user-login-name 1710 string-equal string-lessp string-make-multibyte string-make-unibyte
1688 vconcat 1711 string-search string-to-multibyte substring substring-no-properties
1689 window-at window-body-height 1712 sxhash-eq sxhash-eql sxhash-equal sxhash-equal-including-properties
1690 window-body-width window-buffer window-dedicated-p window-display-table 1713 take vconcat
1691 window-combination-limit window-frame window-fringes 1714 ;; frame.c
1692 window-hscroll 1715 frame-ancestor-p frame-bottom-divider-width frame-char-height
1693 window-left-child window-left-column window-margins window-minibuffer-p 1716 frame-char-width frame-child-frame-border-width frame-focus
1694 window-next-buffers window-next-sibling window-new-normal 1717 frame-fringe-width frame-internal-border-width frame-native-height
1695 window-new-total window-normal-size window-parameter window-parameters 1718 frame-native-width frame-parameter frame-parameters frame-parent
1696 window-parent window-point window-prev-buffers 1719 frame-pointer-visible-p frame-position frame-right-divider-width
1697 window-prev-sibling window-scroll-bars 1720 frame-scale-factor frame-scroll-bar-height frame-scroll-bar-width
1698 window-start window-text-height window-top-child window-top-line 1721 frame-text-cols frame-text-height frame-text-lines frame-text-width
1699 window-total-height window-total-width window-use-time window-vscroll 1722 frame-total-cols frame-total-lines frame-visible-p
1700 )) 1723 frame-window-state-change next-frame previous-frame
1724 tool-bar-pixel-width window-system
1725 ;; fringe.c
1726 fringe-bitmaps-at-pos
1727 ;; keyboard.c
1728 posn-at-point posn-at-x-y
1729 ;; keymap.c
1730 copy-keymap keymap-parent keymap-prompt make-keymap make-sparse-keymap
1731 ;; lread.c
1732 intern-soft read-from-string
1733 ;; marker.c
1734 copy-marker marker-buffer marker-insertion-type marker-position
1735 ;; minibuf.c
1736 active-minibuffer-window assoc-string innermost-minibuffer-p
1737 minibuffer-innermost-command-loop-p minibufferp
1738 ;; print.c
1739 error-message-string prin1-to-string
1740 ;; process.c
1741 format-network-address get-buffer-process get-process
1742 process-buffer process-coding-system process-command process-filter
1743 process-id process-inherit-coding-system-flag process-mark
1744 process-name process-plist process-query-on-exit-flag
1745 process-running-child-p process-sentinel process-thread
1746 process-tty-name process-type
1747 ;; search.c
1748 match-beginning match-end regexp-quote
1749 ;; sqlite.c
1750 sqlite-columns sqlite-more-p sqlite-version
1751 ;; syntax.c
1752 char-syntax copy-syntax-table matching-paren string-to-syntax
1753 syntax-class-to-char
1754 ;; term.c
1755 controlling-tty-p tty-display-color-cells tty-display-color-p
1756 tty-top-frame tty-type
1757 ;; terminal.c
1758 frame-terminal terminal-list terminal-live-p terminal-name
1759 terminal-parameter terminal-parameters
1760 ;; textprop.c
1761 get-char-property get-char-property-and-overlay get-text-property
1762 next-char-property-change next-property-change
1763 next-single-char-property-change next-single-property-change
1764 previous-char-property-change previous-property-change
1765 previous-single-char-property-change previous-single-property-change
1766 text-properties-at text-property-any text-property-not-all
1767 ;; thread.c
1768 all-threads condition-mutex condition-name mutex-name thread-live-p
1769 thread-name
1770 ;; timefns.c
1771 current-time-string current-time-zone decode-time encode-time
1772 float-time format-time-string time-add time-convert time-equal-p
1773 time-less-p time-subtract
1774 ;; window.c
1775 coordinates-in-window-p frame-first-window frame-root-window
1776 frame-selected-window get-buffer-window minibuffer-selected-window
1777 minibuffer-window next-window previous-window window-at
1778 window-body-height window-body-width window-buffer
1779 window-combination-limit window-configuration-equal-p
1780 window-dedicated-p window-display-table window-frame window-fringes
1781 window-hscroll window-left-child window-left-column window-margins
1782 window-minibuffer-p window-new-normal window-new-total
1783 window-next-buffers window-next-sibling window-normal-size
1784 window-parameter window-parameters window-parent window-point
1785 window-prev-buffers window-prev-sibling window-scroll-bars
1786 window-start window-text-height window-top-child window-top-line
1787 window-total-height window-total-width window-use-time window-vscroll
1788 ;; xdisp.c
1789 buffer-text-pixel-size current-bidi-paragraph-direction
1790 get-display-property invisible-p line-pixel-height lookup-image-map
1791 tab-bar-height tool-bar-height window-text-pixel-size
1792 ))
1701 (side-effect-and-error-free-fns 1793 (side-effect-and-error-free-fns
1702 '(arrayp atom 1794 '(
1703 bobp bolp bool-vector-p 1795 ;; alloc.c
1704 buffer-list buffer-size buffer-string bufferp 1796 bool-vector cons list make-marker purecopy record vector
1705 byte-code-function-p 1797 ;; buffer.c
1706 car-safe case-table-p cdr-safe char-or-string-p characterp 1798 buffer-list buffer-live-p current-buffer overlay-lists overlayp
1707 charsetp commandp cons consp 1799 ;; casetab.c
1708 current-buffer current-global-map current-indentation 1800 case-table-p current-case-table standard-case-table
1709 current-local-map current-minor-mode-maps current-time 1801 ;; category.c
1710 eobp eolp eq equal eql 1802 category-table category-table-p make-category-table
1711 floatp following-char framep 1803 standard-category-table
1712 hash-table-p 1804 ;; character.c
1713 identity indirect-function integerp integer-or-marker-p 1805 characterp max-char
1714 invocation-directory invocation-name 1806 ;; charset.c
1715 keymapp keywordp 1807 charsetp
1716 list listp 1808 ;; data.c
1717 make-marker mark-marker markerp max-char 1809 arrayp atom bare-symbol-p bool-vector-p bufferp byte-code-function-p
1718 natnump nlistp null number-or-marker-p numberp 1810 byteorder car-safe cdr-safe char-or-string-p char-table-p
1719 overlayp 1811 condition-variable-p consp eq floatp indirect-function
1720 point point-marker point-min point-max preceding-char 1812 integer-or-marker-p integerp keywordp listp markerp
1721 processp proper-list-p 1813 module-function-p multibyte-string-p mutexp natnump nlistp null
1722 recent-keys recursion-depth 1814 number-or-marker-p numberp recordp remove-pos-from-symbol
1723 safe-length selected-frame selected-window sequencep 1815 sequencep stringp subr-native-elisp-p subrp symbol-with-pos-p symbolp
1724 standard-case-table standard-syntax-table stringp subrp symbolp 1816 threadp type-of user-ptrp vector-or-char-table-p vectorp wholenump
1725 syntax-table syntax-table-p 1817 ;; editfns.c
1726 this-command-keys this-command-keys-vector this-single-command-keys 1818 bobp bolp buffer-size buffer-string current-message emacs-pid
1727 this-single-command-raw-keys type-of 1819 eobp eolp following-char gap-position gap-size group-gid
1728 user-real-login-name user-real-uid user-uid 1820 group-real-gid mark-marker point point-marker point-max point-min
1729 vector vectorp visible-frame-list 1821 position-bytes preceding-char system-name
1730 wholenump window-configuration-p window-live-p 1822 user-real-login-name user-real-uid user-uid
1731 window-valid-p windowp))) 1823 ;; emacs.c
1824 invocation-directory invocation-name
1825 ;; eval.c
1826 commandp functionp
1827 ;; fileio.c
1828 default-file-modes
1829 ;; fns.c
1830 eql equal hash-table-p identity proper-list-p safe-length
1831 secure-hash-algorithms
1832 ;; frame.c
1833 frame-list frame-live-p framep last-nonminibuffer-frame
1834 old-selected-frame selected-frame visible-frame-list
1835 ;; image.c
1836 imagep
1837 ;; indent.c
1838 current-column current-indentation
1839 ;; keyboard.c
1840 current-idle-time current-input-mode recent-keys recursion-depth
1841 this-command-keys this-command-keys-vector this-single-command-keys
1842 this-single-command-raw-keys
1843 ;; keymap.c
1844 current-global-map current-local-map current-minor-mode-maps keymapp
1845 ;; minibuf.c
1846 minibuffer-contents minibuffer-contents-no-properties minibuffer-depth
1847 minibuffer-prompt minibuffer-prompt-end
1848 ;; process.c
1849 process-list processp signal-names waiting-for-user-input-p
1850 ;; sqlite.c
1851 sqlite-available-p sqlitep
1852 ;; syntax.c
1853 standard-syntax-table syntax-table syntax-table-p
1854 ;; thread.c
1855 current-thread
1856 ;; timefns.c
1857 current-time
1858 ;; window.c
1859 selected-window window-configuration-p window-live-p window-valid-p
1860 windowp
1861 ;; xdisp.c
1862 long-line-optimizations-p
1863 )))
1732 (while side-effect-free-fns 1864 (while side-effect-free-fns
1733 (put (car side-effect-free-fns) 'side-effect-free t) 1865 (put (car side-effect-free-fns) 'side-effect-free t)
1734 (setq side-effect-free-fns (cdr side-effect-free-fns))) 1866 (setq side-effect-free-fns (cdr side-effect-free-fns)))
@@ -1753,41 +1885,34 @@ See Info node `(elisp) Integer Basics'."
1753;; values if a marker is moved. 1885;; values if a marker is moved.
1754 1886
1755(let ((pure-fns 1887(let ((pure-fns
1756 '(concat regexp-quote 1888 '(
1757 string-to-char string-to-syntax symbol-name 1889 ;; character.c
1758 eq eql 1890 characterp
1759 = /= < <= >= > min max 1891 ;; data.c
1760 + - * / % mod abs ash 1+ 1- sqrt 1892 % * + - / /= 1+ 1- < <= = > >= aref arrayp ash atom bare-symbol
1761 logand logior lognot logxor logcount 1893 bool-vector-count-consecutive bool-vector-count-population
1762 copysign isnan ldexp float logb 1894 bool-vector-p bool-vector-subsetp
1763 floor ceiling round truncate 1895 bufferp car car-safe cdr cdr-safe char-or-string-p char-table-p
1764 ffloor fceiling fround ftruncate 1896 condition-variable-p consp eq floatp integer-or-marker-p integerp
1765 string-equal string-lessp 1897 keywordp listp logand logcount logior lognot logxor markerp max min
1766 string-search 1898 mod multibyte-string-p mutexp natnump nlistp null number-or-marker-p
1767 consp atom listp nlistp proper-list-p 1899 numberp recordp remove-pos-from-symbol sequencep stringp symbol-name
1768 sequencep arrayp vectorp stringp bool-vector-p hash-table-p 1900 symbolp threadp type-of vector-or-char-table-p vectorp
1769 null 1901 ;; editfns.c
1770 numberp integerp floatp natnump characterp 1902 string-to-char
1771 integer-or-marker-p number-or-marker-p char-or-string-p 1903 ;; floatfns.c
1772 symbolp keywordp 1904 abs ceiling copysign fceiling ffloor float floor fround ftruncate
1773 type-of 1905 isnan ldexp logb round sqrt truncate
1774 identity 1906 ;; fns.c
1775 1907 assq base64-decode-string base64-encode-string base64url-encode-string
1776 ;; The following functions are pure up to mutation of their 1908 concat elt eql equal hash-table-p identity length length< length=
1777 ;; arguments. This is pure enough for the purposes of 1909 length> member memq memql nth nthcdr proper-list-p rassoc rassq
1778 ;; constant folding, but not necessarily for all kinds of 1910 safe-length string-bytes string-distance string-equal string-lessp
1779 ;; code motion. 1911 string-search take
1780 car cdr car-safe cdr-safe nth nthcdr take 1912 ;; search.c
1781 equal 1913 regexp-quote
1782 length safe-length 1914 ;; syntax.c
1783 memq memql member 1915 string-to-syntax
1784 ;; `assoc' and `assoc-default' are excluded since they are
1785 ;; impure if the test function is (consider `string-match').
1786 assq rassq rassoc
1787 aref elt
1788 base64-decode-string base64-encode-string base64url-encode-string
1789 bool-vector-subsetp
1790 bool-vector-count-population bool-vector-count-consecutive
1791 ))) 1916 )))
1792 (while pure-fns 1917 (while pure-fns
1793 (put (car pure-fns) 'pure t) 1918 (put (car pure-fns) 'pure t)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 41fc3b9f335..5382e0a0a52 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2891,45 +2891,14 @@ The function's arguments should be treated as immutable.
2891 ,(format "compiler-macro for inlining `%s'." name) 2891 ,(format "compiler-macro for inlining `%s'." name)
2892 (cl--defsubst-expand 2892 (cl--defsubst-expand
2893 ',argns '(cl-block ,name ,@(cdr (macroexp-parse-body body))) 2893 ',argns '(cl-block ,name ,@(cdr (macroexp-parse-body body)))
2894 ;; We used to pass `simple' as
2895 ;; (not (or unsafe (cl-expr-access-order pbody argns)))
2896 ;; But this is much too simplistic since it
2897 ;; does not pay attention to the argvs (and
2898 ;; cl-expr-access-order itself is also too naive).
2899 nil 2894 nil
2900 ,(and (memq '&key args) 'cl-whole) nil ,@argns))) 2895 ,(and (memq '&key args) 'cl-whole) nil ,@argns)))
2901 (cl-defun ,name ,args ,@body)))) 2896 (cl-defun ,name ,args ,@body))))
2902 2897
2903(defun cl--defsubst-expand (argns body simple whole _unsafe &rest argvs) 2898(defun cl--defsubst-expand (argns body _simple whole _unsafe &rest argvs)
2904 (if (and whole (not (cl--safe-expr-p (cons 'progn argvs)))) whole 2899 (if (and whole (not (cl--safe-expr-p (cons 'progn argvs))))
2905 (if (cl--simple-exprs-p argvs) (setq simple t)) 2900 whole
2906 (let* ((substs ()) 2901 `(let ,(cl-mapcar #'list argns argvs) ,body)))
2907 (lets (delq nil
2908 (cl-mapcar (lambda (argn argv)
2909 (if (or simple (macroexp-const-p argv))
2910 (progn (push (cons argn argv) substs)
2911 nil)
2912 (list argn argv)))
2913 argns argvs))))
2914 ;; FIXME: `sublis/subst' will happily substitute the symbol
2915 ;; `argn' in places where it's not used as a reference
2916 ;; to a variable.
2917 ;; FIXME: `sublis/subst' will happily copy `argv' to a different
2918 ;; scope, leading to name capture.
2919 (setq body (cond ((null substs) body)
2920 ((null (cdr substs))
2921 (cl-subst (cdar substs) (caar substs) body))
2922 (t (cl--sublis substs body))))
2923 (if lets `(let ,lets ,body) body))))
2924
2925(defun cl--sublis (alist tree)
2926 "Perform substitutions indicated by ALIST in TREE (non-destructively)."
2927 (let ((x (assq tree alist)))
2928 (cond
2929 (x (cdr x))
2930 ((consp tree)
2931 (cons (cl--sublis alist (car tree)) (cl--sublis alist (cdr tree))))
2932 (t tree))))
2933 2902
2934;;; Structures. 2903;;; Structures.
2935 2904
@@ -3244,19 +3213,8 @@ To see the documentation for a defined struct type, use
3244 (let* ((anames (cl--arglist-args args)) 3213 (let* ((anames (cl--arglist-args args))
3245 (make (cl-mapcar (lambda (s d) (if (memq s anames) s d)) 3214 (make (cl-mapcar (lambda (s d) (if (memq s anames) s d))
3246 slots defaults)) 3215 slots defaults))
3247 ;; `cl-defsubst' is fundamentally broken: it substitutes 3216 (con-fun (or type #'record)))
3248 ;; its arguments into the body's `sexp' much too naively 3217 (push `(,cldefsym ,cname
3249 ;; when inlinling, which results in various problems.
3250 ;; For example it generates broken code if your
3251 ;; argument's name happens to be the same as some
3252 ;; function used within the body.
3253 ;; E.g. (cl-defsubst sm-foo (list) (list list))
3254 ;; will expand `(sm-foo 1)' to `(1 1)' rather than to `(list t)'!
3255 ;; Try to catch this known case!
3256 (con-fun (or type #'record))
3257 (unsafe-cl-defsubst
3258 (or (memq con-fun args) (assq con-fun args))))
3259 (push `(,(if unsafe-cl-defsubst 'cl-defun cldefsym) ,cname
3260 (&cl-defs (nil ,@descs) ,@args) 3218 (&cl-defs (nil ,@descs) ,@args)
3261 ,(if (stringp doc) doc 3219 ,(if (stringp doc) doc
3262 (format "Constructor for objects of type `%s'." name)) 3220 (format "Constructor for objects of type `%s'." name))
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 1eb0d38c5ce..18d3eb37af3 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -681,29 +681,34 @@ This is the default value for `eldoc-documentation-strategy'."
681 (lambda (f) 681 (lambda (f)
682 (funcall f (eldoc--make-callback :eager f))))) 682 (funcall f (eldoc--make-callback :eager f)))))
683 683
684(defun eldoc--documentation-compose-1 (eagerlyp)
685 "Helper function for composing multiple doc strings.
686If EAGERLYP is non-nil show documentation as soon as possible,
687else wait for all doc strings."
688 (run-hook-wrapped 'eldoc-documentation-functions
689 (lambda (f)
690 (let* ((callback (eldoc--make-callback
691 (if eagerlyp :eager :patient)
692 f))
693 (str (funcall f callback)))
694 (if (or (null str) (stringp str)) (funcall callback str))
695 nil)))
696 t)
697
698(defun eldoc-documentation-compose () 684(defun eldoc-documentation-compose ()
699 "Show multiple documentation strings together after waiting for all of them. 685 "Show multiple documentation strings together after waiting for all of them.
700This is meant to be used as a value for `eldoc-documentation-strategy'." 686This is meant to be used as a value for `eldoc-documentation-strategy'."
701 (eldoc--documentation-compose-1 nil)) 687 (let (fns-and-callbacks)
688 ;; Make all the callbacks, setting up state inside
689 ;; `eldoc--invoke-strategy' to know how many callbacks to wait for
690 ;; before displaying the result (bug#62816).
691 (run-hook-wrapped 'eldoc-documentation-functions
692 (lambda (f)
693 (push (cons f (eldoc--make-callback :patient f))
694 fns-and-callbacks)
695 nil))
696 ;; Now call them. The last one will trigger the display.
697 (cl-loop for (f . callback) in fns-and-callbacks
698 for str = (funcall f callback)
699 when (or (null str) (stringp str)) do (funcall callback str)))
700 t)
702 701
703(defun eldoc-documentation-compose-eagerly () 702(defun eldoc-documentation-compose-eagerly ()
704 "Show multiple documentation strings one by one as soon as possible. 703 "Show multiple documentation strings one by one as soon as possible.
705This is meant to be used as a value for `eldoc-documentation-strategy'." 704This is meant to be used as a value for `eldoc-documentation-strategy'."
706 (eldoc--documentation-compose-1 t)) 705 (run-hook-wrapped 'eldoc-documentation-functions
706 (lambda (f)
707 (let* ((callback (eldoc--make-callback :eager f))
708 (str (funcall f callback)))
709 (if (or (null str) (stringp str)) (funcall callback str))
710 nil)))
711 t)
707 712
708(defun eldoc-documentation-enthusiast () 713(defun eldoc-documentation-enthusiast ()
709 "Show most important documentation string produced so far. 714 "Show most important documentation string produced so far.
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 3f00281e155..c4f773c8426 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -844,12 +844,9 @@ treated as in `eglot--dbind'."
844 :documentation "Short nickname for the associated project." 844 :documentation "Short nickname for the associated project."
845 :accessor eglot--project-nickname 845 :accessor eglot--project-nickname
846 :reader eglot-project-nickname) 846 :reader eglot-project-nickname)
847 (major-modes 847 (languages
848 :documentation "Major modes server is responsible for in a given project." 848 :documentation "Alist ((MODE . LANGUAGE-ID-STRING)...) of managed languages."
849 :accessor eglot--major-modes) 849 :accessor eglot--languages)
850 (language-id
851 :documentation "Language ID string for the mode."
852 :accessor eglot--language-id)
853 (capabilities 850 (capabilities
854 :documentation "JSON object containing server capabilities." 851 :documentation "JSON object containing server capabilities."
855 :accessor eglot--capabilities) 852 :accessor eglot--capabilities)
@@ -884,6 +881,12 @@ treated as in `eglot--dbind'."
884 :documentation 881 :documentation
885 "Represents a server. Wraps a process for LSP communication.") 882 "Represents a server. Wraps a process for LSP communication.")
886 883
884(defun eglot--major-modes (s) "Major modes server S is responsible for."
885 (mapcar #'car (eglot--languages s)))
886
887(defun eglot--language-ids (s) "LSP Language ID strings for server S's modes."
888 (mapcar #'cdr (eglot--languages s)))
889
887(cl-defmethod initialize-instance :before ((_server eglot-lsp-server) &optional args) 890(cl-defmethod initialize-instance :before ((_server eglot-lsp-server) &optional args)
888 (cl-remf args :initializationOptions)) 891 (cl-remf args :initializationOptions))
889 892
@@ -969,42 +972,44 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see."
969 972
970(defun eglot--lookup-mode (mode) 973(defun eglot--lookup-mode (mode)
971 "Lookup `eglot-server-programs' for MODE. 974 "Lookup `eglot-server-programs' for MODE.
972Return (MANAGED-MODES LANGUAGE-ID CONTACT-PROXY). 975Return (LANGUAGES . CONTACT-PROXY).
973 976
974MANAGED-MODES is a list with MODE as its first element. 977MANAGED-MODES is a list with MODE as its first element.
975Subsequent elements are other major modes also potentially 978Subsequent elements are other major modes also potentially
976managed by the server that is to manage MODE. 979managed by the server that is to manage MODE.
977 980
978If not specified in `eglot-server-programs' (which see), 981LANGUAGE-IDS is a list of the same length as MANAGED-MODES. Each
979LANGUAGE-ID is determined from MODE's name. 982elem is derived from the corresponding mode name, if not
983specified in `eglot-server-programs' (which see).
980 984
981CONTACT-PROXY is the value of the corresponding 985CONTACT-PROXY is the value of the corresponding
982`eglot-server-programs' entry." 986`eglot-server-programs' entry."
983 (cl-loop 987 (cl-flet ((languages (main-mode-sym specs)
984 for (modes . contact) in eglot-server-programs 988 (let* ((res
985 for mode-symbols = (cons mode 989 (mapcar (jsonrpc-lambda (sym &key language-id &allow-other-keys)
986 (delete mode 990 (cons sym
987 (mapcar #'car 991 (or language-id
988 (mapcar #'eglot--ensure-list 992 (or (get sym 'eglot-language-id)
989 (eglot--ensure-list modes))))) 993 (replace-regexp-in-string
990 thereis (cl-some 994 "\\(?:-ts\\)?-mode$" ""
991 (lambda (spec) 995 (symbol-name sym))))))
992 (cl-destructuring-bind (probe &key language-id &allow-other-keys) 996 specs))
993 (eglot--ensure-list spec) 997 (head (cl-find main-mode-sym res :key #'car)))
994 (and (provided-mode-derived-p mode probe) 998 (cons head (delq head res)))))
995 (list 999 (cl-loop
996 mode-symbols 1000 for (modes . contact) in eglot-server-programs
997 (or language-id 1001 for specs = (mapcar #'eglot--ensure-list
998 (or (get mode 'eglot-language-id) 1002 (if (or (symbolp modes) (keywordp (cadr modes)))
999 (get spec 'eglot-language-id) 1003 (list modes) modes))
1000 (string-remove-suffix "-mode" (symbol-name mode)))) 1004 thereis (cl-some (lambda (spec)
1001 contact)))) 1005 (cl-destructuring-bind (sym &key &allow-other-keys) spec
1002 (if (or (symbolp modes) (keywordp (cadr modes))) 1006 (and (provided-mode-derived-p mode sym)
1003 (list modes) modes)))) 1007 (cons (languages sym specs) contact))))
1008 specs))))
1004 1009
1005(defun eglot--guess-contact (&optional interactive) 1010(defun eglot--guess-contact (&optional interactive)
1006 "Helper for `eglot'. 1011 "Helper for `eglot'.
1007Return (MANAGED-MODE PROJECT CLASS CONTACT LANG-ID). If INTERACTIVE is 1012Return (MANAGED-MODES PROJECT CLASS CONTACT LANG-IDS). If INTERACTIVE is
1008non-nil, maybe prompt user, else error as soon as something can't 1013non-nil, maybe prompt user, else error as soon as something can't
1009be guessed." 1014be guessed."
1010 (let* ((guessed-mode (if buffer-file-name major-mode)) 1015 (let* ((guessed-mode (if buffer-file-name major-mode))
@@ -1022,11 +1027,10 @@ be guessed."
1022 ((not guessed-mode) 1027 ((not guessed-mode)
1023 (eglot--error "Can't guess mode to manage for `%s'" (current-buffer))) 1028 (eglot--error "Can't guess mode to manage for `%s'" (current-buffer)))
1024 (t guessed-mode))) 1029 (t guessed-mode)))
1025 (triplet (eglot--lookup-mode main-mode)) 1030 (languages-and-contact (eglot--lookup-mode main-mode))
1026 (managed-modes (car triplet)) 1031 (managed-modes (mapcar #'car (car languages-and-contact)))
1027 (language-id (or (cadr triplet) 1032 (language-ids (mapcar #'cdr (car languages-and-contact)))
1028 (string-remove-suffix "-mode" (symbol-name guessed-mode)))) 1033 (guess (cdr languages-and-contact))
1029 (guess (caddr triplet))
1030 (guess (if (functionp guess) 1034 (guess (if (functionp guess)
1031 (funcall guess interactive) 1035 (funcall guess interactive)
1032 guess)) 1036 guess))
@@ -1074,7 +1078,7 @@ be guessed."
1074 full-program-invocation 1078 full-program-invocation
1075 'eglot-command-history))) 1079 'eglot-command-history)))
1076 guess))) 1080 guess)))
1077 (list managed-modes (eglot--current-project) class contact language-id))) 1081 (list managed-modes (eglot--current-project) class contact language-ids)))
1078 1082
1079(defvar eglot-lsp-context) 1083(defvar eglot-lsp-context)
1080(put 'eglot-lsp-context 'variable-documentation 1084(put 'eglot-lsp-context 'variable-documentation
@@ -1092,24 +1096,25 @@ suitable root directory for a given LSP server's purposes."
1092 `(transient . ,(expand-file-name default-directory))))) 1096 `(transient . ,(expand-file-name default-directory)))))
1093 1097
1094;;;###autoload 1098;;;###autoload
1095(defun eglot (managed-major-mode project class contact language-id 1099(defun eglot (managed-major-modes project class contact language-ids
1096 &optional _interactive) 1100 &optional _interactive)
1097 "Start LSP server in support of PROJECT's buffers under MANAGED-MAJOR-MODE. 1101 "Start LSP server for PROJECT's buffers under MANAGED-MAJOR-MODES.
1098 1102
1099This starts a Language Server Protocol (LSP) server suitable for the 1103This starts a Language Server Protocol (LSP) server suitable for
1100buffers of PROJECT whose `major-mode' is MANAGED-MAJOR-MODE. 1104the buffers of PROJECT whose `major-mode' is among
1101CLASS is the class of the LSP server to start and CONTACT specifies 1105MANAGED-MAJOR-MODES. CLASS is the class of the LSP server to
1102how to connect to the server. 1106start and CONTACT specifies how to connect to the server.
1103 1107
1104Interactively, the command attempts to guess MANAGED-MAJOR-MODE 1108Interactively, the command attempts to guess MANAGED-MAJOR-MODES,
1105from the current buffer's `major-mode', CLASS and CONTACT from 1109CLASS, CONTACT, and LANGUAGE-IDS from `eglot-server-programs',
1106`eglot-server-programs' looked up by the major mode, and PROJECT from 1110according to the current buffer's `major-mode'. PROJECT is
1107`project-find-functions'. The search for active projects in this 1111guessed from `project-find-functions'. The search for active
1108context binds `eglot-lsp-context' (which see). 1112projects in this context binds `eglot-lsp-context' (which see).
1109 1113
1110If it can't guess, it prompts the user for the mode and the server. 1114If it can't guess, it prompts the user for the mode and the
1111With a single \\[universal-argument] prefix arg, it always prompts for COMMAND. 1115server. With a single \\[universal-argument] prefix arg, it
1112With two \\[universal-argument], it also always prompts for MANAGED-MAJOR-MODE. 1116always prompts for COMMAND. With two \\[universal-argument], it
1117also always prompts for MANAGED-MAJOR-MODE.
1113 1118
1114The LSP server of CLASS is started (or contacted) via CONTACT. 1119The LSP server of CLASS is started (or contacted) via CONTACT.
1115If this operation is successful, current *and future* file 1120If this operation is successful, current *and future* file
@@ -1127,8 +1132,8 @@ CONTACT specifies how to contact the server. It is a
1127keyword-value plist used to initialize CLASS or a plain list as 1132keyword-value plist used to initialize CLASS or a plain list as
1128described in `eglot-server-programs', which see. 1133described in `eglot-server-programs', which see.
1129 1134
1130LANGUAGE-ID is the language ID string to send to the server for 1135LANGUAGE-IDS is a list of language ID string to send to the
1131MANAGED-MAJOR-MODE, which matters to a minority of servers. 1136server for each element in MANAGED-MAJOR-MODES.
1132 1137
1133INTERACTIVE is ignored and provided for backward compatibility." 1138INTERACTIVE is ignored and provided for backward compatibility."
1134 (interactive 1139 (interactive
@@ -1139,8 +1144,9 @@ INTERACTIVE is ignored and provided for backward compatibility."
1139 (user-error "[eglot] Connection attempt aborted by user.")) 1144 (user-error "[eglot] Connection attempt aborted by user."))
1140 (prog1 (append (eglot--guess-contact t) '(t)) 1145 (prog1 (append (eglot--guess-contact t) '(t))
1141 (when current-server (ignore-errors (eglot-shutdown current-server)))))) 1146 (when current-server (ignore-errors (eglot-shutdown current-server))))))
1142 (eglot--connect (eglot--ensure-list managed-major-mode) 1147 (eglot--connect (eglot--ensure-list managed-major-modes)
1143 project class contact language-id)) 1148 project class contact
1149 (eglot--ensure-list language-ids)))
1144 1150
1145(defun eglot-reconnect (server &optional interactive) 1151(defun eglot-reconnect (server &optional interactive)
1146 "Reconnect to SERVER. 1152 "Reconnect to SERVER.
@@ -1152,7 +1158,7 @@ INTERACTIVE is t if called interactively."
1152 (eglot--project server) 1158 (eglot--project server)
1153 (eieio-object-class-name server) 1159 (eieio-object-class-name server)
1154 (eglot--saved-initargs server) 1160 (eglot--saved-initargs server)
1155 (eglot--language-id server)) 1161 (eglot--language-ids server))
1156 (eglot--message "Reconnected!")) 1162 (eglot--message "Reconnected!"))
1157 1163
1158(defvar eglot--managed-mode) ; forward decl 1164(defvar eglot--managed-mode) ; forward decl
@@ -1225,8 +1231,8 @@ Each function is passed the server as an argument")
1225(defvar-local eglot--cached-server nil 1231(defvar-local eglot--cached-server nil
1226 "A cached reference to the current Eglot server.") 1232 "A cached reference to the current Eglot server.")
1227 1233
1228(defun eglot--connect (managed-modes project class contact language-id) 1234(defun eglot--connect (managed-modes project class contact language-ids)
1229 "Connect to MANAGED-MODES, LANGUAGE-ID, PROJECT, CLASS and CONTACT. 1235 "Connect to MANAGED-MODES, LANGUAGE-IDS, PROJECT, CLASS and CONTACT.
1230This docstring appeases checkdoc, that's all." 1236This docstring appeases checkdoc, that's all."
1231 (let* ((default-directory (project-root project)) 1237 (let* ((default-directory (project-root project))
1232 (nickname (project-name project)) 1238 (nickname (project-name project))
@@ -1299,8 +1305,9 @@ This docstring appeases checkdoc, that's all."
1299 (setf (eglot--saved-initargs server) initargs) 1305 (setf (eglot--saved-initargs server) initargs)
1300 (setf (eglot--project server) project) 1306 (setf (eglot--project server) project)
1301 (setf (eglot--project-nickname server) nickname) 1307 (setf (eglot--project-nickname server) nickname)
1302 (setf (eglot--major-modes server) (eglot--ensure-list managed-modes)) 1308 (setf (eglot--languages server)
1303 (setf (eglot--language-id server) language-id) 1309 (cl-loop for m in managed-modes for l in language-ids
1310 collect (cons m l)))
1304 (setf (eglot--inferior-process server) autostart-inferior-process) 1311 (setf (eglot--inferior-process server) autostart-inferior-process)
1305 (run-hook-with-args 'eglot-server-initialized-hook server) 1312 (run-hook-with-args 'eglot-server-initialized-hook server)
1306 ;; Now start the handshake. To honor `eglot-sync-connect' 1313 ;; Now start the handshake. To honor `eglot-sync-connect'
@@ -2354,7 +2361,7 @@ THINGS are either registrations or unregisterations (sic)."
2354 (append 2361 (append
2355 (eglot--VersionedTextDocumentIdentifier) 2362 (eglot--VersionedTextDocumentIdentifier)
2356 (list :languageId 2363 (list :languageId
2357 (eglot--language-id (eglot--current-server-or-lose)) 2364 (alist-get major-mode (eglot--languages (eglot--current-server-or-lose)))
2358 :text 2365 :text
2359 (eglot--widening 2366 (eglot--widening
2360 (buffer-substring-no-properties (point-min) (point-max)))))) 2367 (buffer-substring-no-properties (point-min) (point-max))))))
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index c751e5bd432..f2fe97cb773 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -4,7 +4,7 @@
4 4
5;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> 5;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
6;; Maintainer: João Távora <joaotavora@gmail.com> 6;; Maintainer: João Távora <joaotavora@gmail.com>
7;; Version: 1.3.3 7;; Version: 1.3.4
8;; Keywords: c languages tools 8;; Keywords: c languages tools
9;; Package-Requires: ((emacs "26.1") (eldoc "1.14.0") (project "0.7.1")) 9;; Package-Requires: ((emacs "26.1") (eldoc "1.14.0") (project "0.7.1"))
10 10
@@ -431,6 +431,26 @@ verify FILTER, a function, and sort them by COMPARE (using KEY)."
431 "Face used for marking note regions." 431 "Face used for marking note regions."
432 :version "26.1") 432 :version "26.1")
433 433
434(defface flymake-error-echo
435 '((t :inherit compilation-error))
436 "Face used for showing summarized descriptions of errors."
437 :package-version '("Flymake" . "1.3.4"))
438
439(defface flymake-warning-echo
440 '((t :inherit compilation-warning))
441 "Face used for showing summarized descriptions of warnings."
442 :package-version '("Flymake" . "1.3.4"))
443
444(defface flymake-note-echo
445 '((t :inherit flymake-note))
446 "Face used for showing summarized descriptions of notes."
447 :package-version '("Flymake" . "1.3.4"))
448
449(defcustom flymake-show-diagnostics-at-end-of-line nil
450 "If non-nil, add diagnostic summary messages at end-of-line."
451 :type 'boolean
452 :package-version '("Flymake" . "1.3.4"))
453
434(define-obsolete-face-alias 'flymake-warnline 'flymake-warning "26.1") 454(define-obsolete-face-alias 'flymake-warnline 'flymake-warning "26.1")
435(define-obsolete-face-alias 'flymake-errline 'flymake-error "26.1") 455(define-obsolete-face-alias 'flymake-errline 'flymake-error "26.1")
436 456
@@ -584,22 +604,25 @@ Node `(Flymake)Flymake error types'"
584(put 'flymake-error 'face 'flymake-error) 604(put 'flymake-error 'face 'flymake-error)
585(put 'flymake-error 'flymake-bitmap 'flymake-error-bitmap) 605(put 'flymake-error 'flymake-bitmap 'flymake-error-bitmap)
586(put 'flymake-error 'severity (warning-numeric-level :error)) 606(put 'flymake-error 'severity (warning-numeric-level :error))
587(put 'flymake-error 'mode-line-face 'compilation-error) 607(put 'flymake-error 'mode-line-face 'flymake-error-echo)
588(put 'flymake-error 'echo-face 'error) 608(put 'flymake-error 'echo-face 'flymake-error-echo)
609(put 'flymake-error 'eol-face 'flymake-error-echo)
589(put 'flymake-error 'flymake-type-name "error") 610(put 'flymake-error 'flymake-type-name "error")
590 611
591(put 'flymake-warning 'face 'flymake-warning) 612(put 'flymake-warning 'face 'flymake-warning)
592(put 'flymake-warning 'flymake-bitmap 'flymake-warning-bitmap) 613(put 'flymake-warning 'flymake-bitmap 'flymake-warning-bitmap)
593(put 'flymake-warning 'severity (warning-numeric-level :warning)) 614(put 'flymake-warning 'severity (warning-numeric-level :warning))
594(put 'flymake-warning 'mode-line-face 'compilation-warning) 615(put 'flymake-warning 'mode-line-face 'flymake-warning-echo)
595(put 'flymake-warning 'echo-face 'warning) 616(put 'flymake-warning 'echo-face 'flymake-warning-echo)
617(put 'flymake-warning 'eol-face 'flymake-warning-echo)
596(put 'flymake-warning 'flymake-type-name "warning") 618(put 'flymake-warning 'flymake-type-name "warning")
597 619
598(put 'flymake-note 'face 'flymake-note) 620(put 'flymake-note 'face 'flymake-note)
599(put 'flymake-note 'flymake-bitmap 'flymake-note-bitmap) 621(put 'flymake-note 'flymake-bitmap 'flymake-note-bitmap)
600(put 'flymake-note 'severity (warning-numeric-level :debug)) 622(put 'flymake-note 'severity (warning-numeric-level :debug))
601(put 'flymake-note 'mode-line-face 'compilation-info) 623(put 'flymake-note 'mode-line-face 'flymake-note-echo)
602(put 'flymake-note 'echo-face 'compilation-info) 624(put 'flymake-note 'echo-face 'flymake-note-echo)
625(put 'flymake-note 'eol-face 'flymake-note-echo)
603(put 'flymake-note 'flymake-type-name "note") 626(put 'flymake-note 'flymake-type-name "note")
604 627
605(defun flymake--lookup-type-property (type prop &optional default) 628(defun flymake--lookup-type-property (type prop &optional default)
@@ -656,6 +679,12 @@ associated `flymake-category' return DEFAULT."
656 flymake-diagnostic-text) 679 flymake-diagnostic-text)
657 always (equal (funcall comp a) (funcall comp b))))) 680 always (equal (funcall comp a) (funcall comp b)))))
658 681
682(defun flymake--delete-overlay (ov)
683 "Like `delete-overlay', delete OV, but do some more stuff."
684 (let ((eolov (overlay-get ov 'eol-ov)))
685 (when eolov (delete-overlay eolov))
686 (delete-overlay ov)))
687
659(cl-defun flymake--highlight-line (diagnostic &optional foreign) 688(cl-defun flymake--highlight-line (diagnostic &optional foreign)
660 "Attempt to overlay DIAGNOSTIC in current buffer. 689 "Attempt to overlay DIAGNOSTIC in current buffer.
661 690
@@ -695,6 +724,7 @@ Return nil or the overlay created."
695 ;; diagnostic is already registered in the same place, which only 724 ;; diagnostic is already registered in the same place, which only
696 ;; happens for clashes between domestic and foreign diagnostics 725 ;; happens for clashes between domestic and foreign diagnostics
697 (cl-loop for e in (flymake-diagnostics beg end) 726 (cl-loop for e in (flymake-diagnostics beg end)
727 for eov = (flymake--diag-overlay e)
698 when (flymake--equal-diagnostic-p e diagnostic) 728 when (flymake--equal-diagnostic-p e diagnostic)
699 ;; FIXME. This is an imperfect heuristic. Ideally, we'd 729 ;; FIXME. This is an imperfect heuristic. Ideally, we'd
700 ;; want to delete no overlays and keep annotating the 730 ;; want to delete no overlays and keep annotating the
@@ -710,7 +740,7 @@ Return nil or the overlay created."
710 (flymake--diag-orig-beg e) 740 (flymake--diag-orig-beg e)
711 (flymake--diag-end e) 741 (flymake--diag-end e)
712 (flymake--diag-orig-end e)) 742 (flymake--diag-orig-end e))
713 (delete-overlay (flymake--diag-overlay e)))) 743 (flymake--delete-overlay eov)))
714 (setq ov (make-overlay end beg)) 744 (setq ov (make-overlay end beg))
715 (setf (flymake--diag-beg diagnostic) (overlay-start ov) 745 (setf (flymake--diag-beg diagnostic) (overlay-start ov)
716 (flymake--diag-end diagnostic) (overlay-end ov)) 746 (flymake--diag-end diagnostic) (overlay-end ov))
@@ -728,6 +758,37 @@ Return nil or the overlay created."
728 (flymake--lookup-type-property type 'flymake-overlay-control)) 758 (flymake--lookup-type-property type 'flymake-overlay-control))
729 (alist-get type flymake-diagnostic-types-alist)) 759 (alist-get type flymake-diagnostic-types-alist))
730 do (overlay-put ov ov-prop value)) 760 do (overlay-put ov ov-prop value))
761 ;; Handle `flymake-show-diagnostics-at-end-of-line'
762 ;;
763 (when-let ((eol-face (and flymake-show-diagnostics-at-end-of-line
764 (flymake--lookup-type-property type 'eol-face))))
765 (save-excursion
766 (goto-char (overlay-start ov))
767 (let* ((start (line-end-position))
768 (end (min (1+ start) (point-max)))
769 (eolov (car
770 (cl-remove-if-not
771 (lambda (o) (overlay-get o 'flymake-source-ovs))
772 (overlays-at start))))
773 (bs (flymake-diagnostic-oneliner diagnostic t)))
774 (setq bs (propertize bs 'face eol-face))
775 ;; FIXME: 1. no checking if there are unexpectedly more than
776 ;; one eolov at point. 2. The first regular source ov to
777 ;; die also kills the eolov (very rare this matters, but
778 ;; could be improved).
779 (cond (eolov
780 (overlay-put eolov 'before-string
781 (concat (overlay-get eolov 'before-string) " " bs))
782 (overlay-put eolov 'flymake-source-ovs
783 (cons ov (overlay-get eolov 'flymake-source-ovs))))
784 (t
785 (setq eolov (make-overlay start end nil t nil))
786 (setq bs (concat " " bs))
787 (put-text-property 0 1 'cursor t bs)
788 (overlay-put eolov 'before-string bs)
789 (overlay-put eolov 'evaporate (not (= start end)))
790 (overlay-put eolov 'flymake-source-ovs (list ov))
791 (overlay-put ov 'eol-ov eolov))))))
731 ;; Now ensure some essential defaults are set 792 ;; Now ensure some essential defaults are set
732 ;; 793 ;;
733 (cl-flet ((default-maybe 794 (cl-flet ((default-maybe
@@ -743,6 +804,8 @@ Return nil or the overlay created."
743 'flymake-bitmap 804 'flymake-bitmap
744 (alist-get 'bitmap (alist-get type ; backward compat 805 (alist-get 'bitmap (alist-get type ; backward compat
745 flymake-diagnostic-types-alist))))) 806 flymake-diagnostic-types-alist)))))
807 ;; (default-maybe 'after-string
808 ;; (flymake--diag-text diagnostic))
746 (default-maybe 'help-echo 809 (default-maybe 'help-echo
747 (lambda (window _ov pos) 810 (lambda (window _ov pos)
748 (with-selected-window window 811 (with-selected-window window
@@ -873,7 +936,7 @@ report applies to that region."
873 (maphash (lambda (_buffer diags) 936 (maphash (lambda (_buffer diags)
874 (cl-loop for d in diags 937 (cl-loop for d in diags
875 when (flymake--diag-overlay d) 938 when (flymake--diag-overlay d)
876 do (delete-overlay it))) 939 do (flymake--delete-overlay it)))
877 (flymake--state-foreign-diags state)) 940 (flymake--state-foreign-diags state))
878 (clrhash (flymake--state-foreign-diags state))) 941 (clrhash (flymake--state-foreign-diags state)))
879 942
@@ -900,7 +963,7 @@ and other buffers."
900 (flymake--intersects-p 963 (flymake--intersects-p
901 (overlay-start ov) (overlay-end ov) 964 (overlay-start ov) (overlay-end ov)
902 (car region) (cdr region))) 965 (car region) (cdr region)))
903 do (delete-overlay ov) 966 do (flymake--delete-overlay ov)
904 else collect diag into surviving 967 else collect diag into surviving
905 finally (setf (flymake--state-diags state) 968 finally (setf (flymake--state-diags state)
906 surviving))) 969 surviving)))
@@ -909,7 +972,7 @@ and other buffers."
909 (not (flymake--state-reported-p state)) 972 (not (flymake--state-reported-p state))
910 (cl-loop for diag in (flymake--state-diags state) 973 (cl-loop for diag in (flymake--state-diags state)
911 for ov = (flymake--diag-overlay diag) 974 for ov = (flymake--diag-overlay diag)
912 when ov do (delete-overlay ov)) 975 when ov do (flymake--delete-overlay ov))
913 (setf (flymake--state-diags state) nil) 976 (setf (flymake--state-diags state) nil)
914 ;; Also clear all overlays for `foreign-diags' in all other 977 ;; Also clear all overlays for `foreign-diags' in all other
915 ;; buffers. 978 ;; buffers.
@@ -1153,7 +1216,7 @@ special *Flymake log* buffer." :group 'flymake :lighter
1153 ;; existing diagnostic overlays, lest we forget them by blindly 1216 ;; existing diagnostic overlays, lest we forget them by blindly
1154 ;; reinitializing `flymake--state' in the next line. 1217 ;; reinitializing `flymake--state' in the next line.
1155 ;; See https://github.com/joaotavora/eglot/issues/223. 1218 ;; See https://github.com/joaotavora/eglot/issues/223.
1156 (mapc #'delete-overlay (flymake--overlays)) 1219 (mapc #'flymake--delete-overlay (flymake--overlays))
1157 (setq flymake--state (make-hash-table)) 1220 (setq flymake--state (make-hash-table))
1158 (setq flymake--recent-changes nil) 1221 (setq flymake--recent-changes nil)
1159 1222
@@ -1200,7 +1263,7 @@ special *Flymake log* buffer." :group 'flymake :lighter
1200 (when flymake-timer 1263 (when flymake-timer
1201 (cancel-timer flymake-timer) 1264 (cancel-timer flymake-timer)
1202 (setq flymake-timer nil)) 1265 (setq flymake-timer nil))
1203 (mapc #'delete-overlay (flymake--overlays)) 1266 (mapc #'flymake--delete-overlay (flymake--overlays))
1204 (when flymake--state 1267 (when flymake--state
1205 (maphash (lambda (_backend state) 1268 (maphash (lambda (_backend state)
1206 (flymake--clear-foreign-diags state)) 1269 (flymake--clear-foreign-diags state))
diff --git a/lisp/subr.el b/lisp/subr.el
index 46faff1cd18..649f64df57a 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -829,7 +829,7 @@ of course, also replace TO with a slightly larger value
829If TREE is a cons cell, this recursively copies both its car and its cdr. 829If TREE is a cons cell, this recursively copies both its car and its cdr.
830Contrast to `copy-sequence', which copies only along the cdrs. With second 830Contrast to `copy-sequence', which copies only along the cdrs. With second
831argument VECP, this copies vectors as well as conses." 831argument VECP, this copies vectors as well as conses."
832 (declare (side-effect-free t)) 832 (declare (side-effect-free error-free))
833 (if (consp tree) 833 (if (consp tree)
834 (let (result) 834 (let (result)
835 (while (consp tree) 835 (while (consp tree)
diff --git a/src/data.c b/src/data.c
index 8dc5000424e..4ab37e86ce5 100644
--- a/src/data.c
+++ b/src/data.c
@@ -4217,10 +4217,11 @@ syms_of_data (void)
4217 Fput (Qrecursion_error, Qerror_message, build_pure_c_string 4217 Fput (Qrecursion_error, Qerror_message, build_pure_c_string
4218 ("Excessive recursive calling error")); 4218 ("Excessive recursive calling error"));
4219 4219
4220 PUT_ERROR (Qexcessive_variable_binding, recursion_tail,
4221 "Variable binding depth exceeds max-specpdl-size");
4222 PUT_ERROR (Qexcessive_lisp_nesting, recursion_tail, 4220 PUT_ERROR (Qexcessive_lisp_nesting, recursion_tail,
4223 "Lisp nesting exceeds `max-lisp-eval-depth'"); 4221 "Lisp nesting exceeds `max-lisp-eval-depth'");
4222 /* Error obsolete (from 29.1), kept for compatibility. */
4223 PUT_ERROR (Qexcessive_variable_binding, recursion_tail,
4224 "Variable binding depth exceeds max-specpdl-size");
4224 4225
4225 /* Types that type-of returns. */ 4226 /* Types that type-of returns. */
4226 DEFSYM (Qinteger, "integer"); 4227 DEFSYM (Qinteger, "integer");
diff --git a/src/eval.c b/src/eval.c
index 1a4d3ad0307..545a280ae91 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2373,8 +2373,7 @@ grow_specpdl_allocation (void)
2373 union specbinding *pdlvec = specpdl - 1; 2373 union specbinding *pdlvec = specpdl - 1;
2374 ptrdiff_t size = specpdl_end - specpdl; 2374 ptrdiff_t size = specpdl_end - specpdl;
2375 ptrdiff_t pdlvecsize = size + 1; 2375 ptrdiff_t pdlvecsize = size + 1;
2376 if (max_size <= size) 2376 eassert (max_size > size);
2377 xsignal0 (Qexcessive_variable_binding); /* Can't happen, essentially. */
2378 pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); 2377 pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl);
2379 specpdl = pdlvec + 1; 2378 specpdl = pdlvec + 1;
2380 specpdl_end = specpdl + pdlvecsize - 1; 2379 specpdl_end = specpdl + pdlvecsize - 1;
diff --git a/src/treesit.c b/src/treesit.c
index fd5fda78133..45b5ab15390 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -3139,10 +3139,84 @@ treesit_traverse_child_helper (TSTreeCursor *cursor,
3139 } 3139 }
3140} 3140}
3141 3141
3142/* Return true if the node at CURSOR matches PRED. PRED can be a 3142/* Validate the PRED passed to treesit_traverse_match_predicate. If
3143 string or a function. This function assumes PRED is either a 3143 there's an error, set SIGNAL_DATA to something signal accepts, and
3144 string or a function. If NAMED is true, also check that the node 3144 return false, otherwise return true. */
3145 is named. */ 3145static bool
3146treesit_traverse_validate_predicate (Lisp_Object pred,
3147 Lisp_Object *signal_data)
3148{
3149 if (STRINGP (pred))
3150 return true;
3151 /* We want to allow cl-labels-defined functions, so we allow
3152 symbols. */
3153 else if (FUNCTIONP (pred) || SYMBOLP (pred))
3154 return true;
3155 else if (CONSP (pred))
3156 {
3157 Lisp_Object car = XCAR (pred);
3158 Lisp_Object cdr = XCDR (pred);
3159 if (EQ (car, Qnot))
3160 {
3161 if (!CONSP (cdr))
3162 {
3163 *signal_data = list2 (build_string ("Invalide `not' "
3164 "predicate"),
3165 pred);
3166 return false;
3167 }
3168 /* At this point CDR must be a cons. */
3169 if (XFIXNUM (Flength (cdr)) != 1)
3170 {
3171 *signal_data = list2 (build_string ("`not' can only "
3172 "have one argument"),
3173 pred);
3174 return false;
3175 }
3176 return treesit_traverse_validate_predicate (XCAR (cdr),
3177 signal_data);
3178 }
3179 else if (EQ (car, Qor))
3180 {
3181 if (!CONSP (cdr) || NILP (cdr))
3182 {
3183 *signal_data = list2 (build_string ("`or' must have a list "
3184 "of patterns as "
3185 "arguments "),
3186 pred);
3187 return false;
3188 }
3189 FOR_EACH_TAIL (cdr)
3190 {
3191 if (!treesit_traverse_validate_predicate (XCAR (cdr),
3192 signal_data))
3193 return false;
3194 }
3195 return true;
3196 }
3197 /* We allow the function to be a symbol to support cl-label. */
3198 else if (STRINGP (car) && (FUNCTIONP (cdr) || SYMBOLP (cdr)))
3199 return true;
3200 }
3201 *signal_data = list2 (build_string ("Invalid predicate, see TODO for "
3202 "valid forms of predicate"),
3203 pred);
3204 return false;
3205}
3206
3207/* Return true if the node at CURSOR matches PRED. PRED can be a lot
3208 of things:
3209
3210 PRED := string | function | (string . function)
3211 | (or PRED...) | (not PRED)
3212
3213 See docstring of treesit-search-forward and friends for the meaning
3214 of each shape.
3215
3216 This function assumes PRED is in one of its valid forms. If NAMED
3217 is true, also check that the node is named.
3218
3219 This function may signal if the predicate function signals. */
3146static bool 3220static bool
3147treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred, 3221treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred,
3148 Lisp_Object parser, bool named) 3222 Lisp_Object parser, bool named)
@@ -3156,24 +3230,62 @@ treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred,
3156 const char *type = ts_node_type (node); 3230 const char *type = ts_node_type (node);
3157 return fast_c_string_match (pred, type, strlen (type)) >= 0; 3231 return fast_c_string_match (pred, type, strlen (type)) >= 0;
3158 } 3232 }
3159 else 3233 /* We want to allow cl-labels-defined functions, so we allow
3234 symbols. */
3235 else if (FUNCTIONP (pred) || SYMBOLP (pred))
3160 { 3236 {
3161 Lisp_Object lisp_node = make_treesit_node (parser, node); 3237 Lisp_Object lisp_node = make_treesit_node (parser, node);
3162 return !NILP (CALLN (Ffuncall, pred, lisp_node)); 3238 return !NILP (CALLN (Ffuncall, pred, lisp_node));
3163 } 3239 }
3240 else if (CONSP (pred))
3241 {
3242 Lisp_Object car = XCAR (pred);
3243 Lisp_Object cdr = XCDR (pred);
3244
3245 if (EQ (car, Qnot))
3246 return !treesit_traverse_match_predicate (cursor, XCAR (cdr),
3247 parser, named);
3248 else if (EQ (car, Qor))
3249 {
3250 FOR_EACH_TAIL (cdr)
3251 {
3252 if (treesit_traverse_match_predicate (cursor, XCAR (cdr),
3253 parser, named))
3254 return true;
3255 }
3256 return false;
3257 }
3258 /* We want to allow cl-labels-defined functions, so we allow
3259 symbols. */
3260 else if (STRINGP (car) && (FUNCTIONP (cdr) || SYMBOLP (cdr)))
3261 {
3262 /* A bit of code duplication here, but should be fine. */
3263 const char *type = ts_node_type (node);
3264 if (!(fast_c_string_match (pred, type, strlen (type)) >= 0))
3265 return false;
3266
3267 Lisp_Object lisp_node = make_treesit_node (parser, node);
3268 if (NILP (CALLN (Ffuncall, pred, lisp_node)))
3269 return false;
3270
3271 return true;
3272 }
3273 }
3274 /* Returning false is better than UB. */
3275 return false;
3164} 3276}
3165 3277
3166/* Traverse the parse tree starting from CURSOR. PRED can be a 3278/* Traverse the parse tree starting from CURSOR. See TODO for the
3167 function (takes a node and returns nil/non-nil), or a string 3279 shapes PRED can have. If the node satisfies PRED, leave CURSOR on
3168 (treated as regexp matching the node's type, must be all single 3280 that node and return true. If no node satisfies PRED, move CURSOR
3169 byte characters). If the node satisfies PRED, leave CURSOR on that 3281 back to starting position and return false.
3170 node and return true. If no node satisfies PRED, move CURSOR back
3171 to starting position and return false.
3172 3282
3173 LIMIT is the number of levels we descend in the tree. FORWARD 3283 LIMIT is the number of levels we descend in the tree. FORWARD
3174 controls the direction in which we traverse the tree, true means 3284 controls the direction in which we traverse the tree, true means
3175 forward, false backward. If SKIP_ROOT is true, don't match ROOT. 3285 forward, false backward. If SKIP_ROOT is true, don't match ROOT.
3176 */ 3286
3287 This function may signal if the predicate function signals. */
3288
3177static bool 3289static bool
3178treesit_search_dfs (TSTreeCursor *cursor, 3290treesit_search_dfs (TSTreeCursor *cursor,
3179 Lisp_Object pred, Lisp_Object parser, 3291 Lisp_Object pred, Lisp_Object parser,
@@ -3209,7 +3321,10 @@ treesit_search_dfs (TSTreeCursor *cursor,
3209 START. PRED, PARSER, NAMED, FORWARD are the same as in 3321 START. PRED, PARSER, NAMED, FORWARD are the same as in
3210 ts_search_subtree. If a match is found, leave CURSOR at that node, 3322 ts_search_subtree. If a match is found, leave CURSOR at that node,
3211 and return true, if no match is found, return false, and CURSOR's 3323 and return true, if no match is found, return false, and CURSOR's
3212 position is undefined. */ 3324 position is undefined.
3325
3326 This function may signal if the predicate function signals. */
3327
3213static bool 3328static bool
3214treesit_search_forward (TSTreeCursor *cursor, 3329treesit_search_forward (TSTreeCursor *cursor,
3215 Lisp_Object pred, Lisp_Object parser, 3330 Lisp_Object pred, Lisp_Object parser,
@@ -3219,8 +3334,7 @@ treesit_search_forward (TSTreeCursor *cursor,
3219 nodes. This way repeated call of this function traverses each 3334 nodes. This way repeated call of this function traverses each
3220 node in the tree once and only once: 3335 node in the tree once and only once:
3221 3336
3222 (while node (setq node (treesit-search-forward node))) 3337 (while node (setq node (treesit-search-forward node))) */
3223 */
3224 bool initial = true; 3338 bool initial = true;
3225 while (true) 3339 while (true)
3226 { 3340 {
@@ -3247,6 +3361,14 @@ treesit_search_forward (TSTreeCursor *cursor,
3247 } 3361 }
3248} 3362}
3249 3363
3364/* Clean up the given tree cursor CURSOR. */
3365
3366static void
3367treesit_traverse_cleanup_cursor (void *cursor)
3368{
3369 ts_tree_cursor_delete (cursor);
3370}
3371
3250DEFUN ("treesit-search-subtree", 3372DEFUN ("treesit-search-subtree",
3251 Ftreesit_search_subtree, 3373 Ftreesit_search_subtree,
3252 Streesit_search_subtree, 2, 5, 0, 3374 Streesit_search_subtree, 2, 5, 0,
@@ -3266,11 +3388,13 @@ Return the first matched node, or nil if none matches. */)
3266 Lisp_Object all, Lisp_Object depth) 3388 Lisp_Object all, Lisp_Object depth)
3267{ 3389{
3268 CHECK_TS_NODE (node); 3390 CHECK_TS_NODE (node);
3269 CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate),
3270 list3 (Qor, Qstringp, Qfunctionp), predicate);
3271 CHECK_SYMBOL (all); 3391 CHECK_SYMBOL (all);
3272 CHECK_SYMBOL (backward); 3392 CHECK_SYMBOL (backward);
3273 3393
3394 Lisp_Object signal_data = Qnil;
3395 if (!treesit_traverse_validate_predicate (predicate, &signal_data))
3396 xsignal1 (Qtreesit_invalid_predicate, signal_data);
3397
3274 /* We use a default limit of 1000. See bug#59426 for the 3398 /* We use a default limit of 1000. See bug#59426 for the
3275 discussion. */ 3399 discussion. */
3276 ptrdiff_t the_limit = treesit_recursion_limit; 3400 ptrdiff_t the_limit = treesit_recursion_limit;
@@ -3288,14 +3412,17 @@ Return the first matched node, or nil if none matches. */)
3288 if (!treesit_cursor_helper (&cursor, XTS_NODE (node)->node, parser)) 3412 if (!treesit_cursor_helper (&cursor, XTS_NODE (node)->node, parser))
3289 return return_value; 3413 return return_value;
3290 3414
3415 specpdl_ref count = SPECPDL_INDEX ();
3416 record_unwind_protect_ptr (treesit_traverse_cleanup_cursor, &cursor);
3417
3291 if (treesit_search_dfs (&cursor, predicate, parser, NILP (backward), 3418 if (treesit_search_dfs (&cursor, predicate, parser, NILP (backward),
3292 NILP (all), the_limit, false)) 3419 NILP (all), the_limit, false))
3293 { 3420 {
3294 TSNode node = ts_tree_cursor_current_node (&cursor); 3421 TSNode node = ts_tree_cursor_current_node (&cursor);
3295 return_value = make_treesit_node (parser, node); 3422 return_value = make_treesit_node (parser, node);
3296 } 3423 }
3297 ts_tree_cursor_delete (&cursor); 3424
3298 return return_value; 3425 return unbind_to (count, return_value);
3299} 3426}
3300 3427
3301DEFUN ("treesit-search-forward", 3428DEFUN ("treesit-search-forward",
@@ -3332,11 +3459,13 @@ always traverse leaf nodes first, then upwards. */)
3332 Lisp_Object all) 3459 Lisp_Object all)
3333{ 3460{
3334 CHECK_TS_NODE (start); 3461 CHECK_TS_NODE (start);
3335 CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate),
3336 list3 (Qor, Qstringp, Qfunctionp), predicate);
3337 CHECK_SYMBOL (all); 3462 CHECK_SYMBOL (all);
3338 CHECK_SYMBOL (backward); 3463 CHECK_SYMBOL (backward);
3339 3464
3465 Lisp_Object signal_data = Qnil;
3466 if (!treesit_traverse_validate_predicate (predicate, &signal_data))
3467 xsignal1 (Qtreesit_invalid_predicate, signal_data);
3468
3340 treesit_initialize (); 3469 treesit_initialize ();
3341 3470
3342 Lisp_Object parser = XTS_NODE (start)->parser; 3471 Lisp_Object parser = XTS_NODE (start)->parser;
@@ -3345,20 +3474,25 @@ always traverse leaf nodes first, then upwards. */)
3345 if (!treesit_cursor_helper (&cursor, XTS_NODE (start)->node, parser)) 3474 if (!treesit_cursor_helper (&cursor, XTS_NODE (start)->node, parser))
3346 return return_value; 3475 return return_value;
3347 3476
3477 specpdl_ref count = SPECPDL_INDEX ();
3478 record_unwind_protect_ptr (treesit_traverse_cleanup_cursor, &cursor);
3479
3348 if (treesit_search_forward (&cursor, predicate, parser, 3480 if (treesit_search_forward (&cursor, predicate, parser,
3349 NILP (backward), NILP (all))) 3481 NILP (backward), NILP (all)))
3350 { 3482 {
3351 TSNode node = ts_tree_cursor_current_node (&cursor); 3483 TSNode node = ts_tree_cursor_current_node (&cursor);
3352 return_value = make_treesit_node (parser, node); 3484 return_value = make_treesit_node (parser, node);
3353 } 3485 }
3354 ts_tree_cursor_delete (&cursor); 3486
3355 return return_value; 3487 return unbind_to (count, return_value);
3356} 3488}
3357 3489
3358/* Recursively traverse the tree under CURSOR, and append the result 3490/* Recursively traverse the tree under CURSOR, and append the result
3359 subtree to PARENT's cdr. See more in Ftreesit_induce_sparse_tree. 3491 subtree to PARENT's cdr. See more in Ftreesit_induce_sparse_tree.
3360 Note that the top-level children list is reversed, because 3492 Note that the top-level children list is reversed, because
3361 reasons. */ 3493 reasons.
3494
3495 This function may signal if the predicate function signals. */
3362static void 3496static void
3363treesit_build_sparse_tree (TSTreeCursor *cursor, Lisp_Object parent, 3497treesit_build_sparse_tree (TSTreeCursor *cursor, Lisp_Object parent,
3364 Lisp_Object pred, Lisp_Object process_fn, 3498 Lisp_Object pred, Lisp_Object process_fn,
@@ -3444,8 +3578,10 @@ a regexp. */)
3444 Lisp_Object depth) 3578 Lisp_Object depth)
3445{ 3579{
3446 CHECK_TS_NODE (root); 3580 CHECK_TS_NODE (root);
3447 CHECK_TYPE (STRINGP (predicate) || FUNCTIONP (predicate), 3581
3448 list3 (Qor, Qstringp, Qfunctionp), predicate); 3582 Lisp_Object signal_data = Qnil;
3583 if (!treesit_traverse_validate_predicate (predicate, &signal_data))
3584 xsignal1 (Qtreesit_invalid_predicate, signal_data);
3449 3585
3450 if (!NILP (process_fn)) 3586 if (!NILP (process_fn))
3451 CHECK_TYPE (FUNCTIONP (process_fn), Qfunctionp, process_fn); 3587 CHECK_TYPE (FUNCTIONP (process_fn), Qfunctionp, process_fn);
@@ -3467,10 +3603,16 @@ a regexp. */)
3467 to use treesit_cursor_helper. */ 3603 to use treesit_cursor_helper. */
3468 TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (root)->node); 3604 TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (root)->node);
3469 3605
3606 specpdl_ref count = SPECPDL_INDEX ();
3607 record_unwind_protect_ptr (treesit_traverse_cleanup_cursor, &cursor);
3608
3470 treesit_build_sparse_tree (&cursor, parent, predicate, process_fn, 3609 treesit_build_sparse_tree (&cursor, parent, predicate, process_fn,
3471 the_limit, parser); 3610 the_limit, parser);
3472 ts_tree_cursor_delete (&cursor); 3611
3612 unbind_to (count, Qnil);
3613
3473 Fsetcdr (parent, Fnreverse (Fcdr (parent))); 3614 Fsetcdr (parent, Fnreverse (Fcdr (parent)));
3615
3474 if (NILP (Fcdr (parent))) 3616 if (NILP (Fcdr (parent)))
3475 return Qnil; 3617 return Qnil;
3476 else 3618 else
@@ -3571,6 +3713,7 @@ syms_of_treesit (void)
3571 DEFSYM (Qoutdated, "outdated"); 3713 DEFSYM (Qoutdated, "outdated");
3572 DEFSYM (Qhas_error, "has-error"); 3714 DEFSYM (Qhas_error, "has-error");
3573 DEFSYM (Qlive, "live"); 3715 DEFSYM (Qlive, "live");
3716 DEFSYM (Qnot, "not");
3574 3717
3575 DEFSYM (QCanchor, ":anchor"); 3718 DEFSYM (QCanchor, ":anchor");
3576 DEFSYM (QCequal, ":equal"); 3719 DEFSYM (QCequal, ":equal");
@@ -3595,6 +3738,7 @@ syms_of_treesit (void)
3595 "user-emacs-directory"); 3738 "user-emacs-directory");
3596 DEFSYM (Qtreesit_parser_deleted, "treesit-parser-deleted"); 3739 DEFSYM (Qtreesit_parser_deleted, "treesit-parser-deleted");
3597 DEFSYM (Qtreesit_pattern_expand, "treesit-pattern-expand"); 3740 DEFSYM (Qtreesit_pattern_expand, "treesit-pattern-expand");
3741 DEFSYM (Qtreesit_invalid_predicate, "treesit-invalid-predicate");
3598 3742
3599 DEFSYM (Qor, "or"); 3743 DEFSYM (Qor, "or");
3600 3744
@@ -3622,6 +3766,9 @@ syms_of_treesit (void)
3622 define_error (Qtreesit_parser_deleted, 3766 define_error (Qtreesit_parser_deleted,
3623 "This parser is deleted and cannot be used", 3767 "This parser is deleted and cannot be used",
3624 Qtreesit_error); 3768 Qtreesit_error);
3769 define_error (Qtreesit_invalid_predicate,
3770 "Invalid predicate, see TODO for valid forms for a predicate",
3771 Qtreesit_error);
3625 3772
3626 DEFVAR_LISP ("treesit-load-name-override-list", 3773 DEFVAR_LISP ("treesit-load-name-override-list",
3627 Vtreesit_load_name_override_list, 3774 Vtreesit_load_name_override_list,
diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el
index efb0f4d8844..d96ba2ebf07 100644
--- a/test/lisp/progmodes/eglot-tests.el
+++ b/test/lisp/progmodes/eglot-tests.el
@@ -1041,7 +1041,8 @@ int main() {
1041(cl-defmacro eglot--guessing-contact ((interactive-sym 1041(cl-defmacro eglot--guessing-contact ((interactive-sym
1042 prompt-args-sym 1042 prompt-args-sym
1043 guessed-class-sym guessed-contact-sym 1043 guessed-class-sym guessed-contact-sym
1044 &optional guessed-lang-id-sym) 1044 &optional guessed-major-modes-sym
1045 guessed-lang-ids-sym)
1045 &body body) 1046 &body body)
1046 "Guess LSP contact with `eglot--guessing-contact', evaluate BODY. 1047 "Guess LSP contact with `eglot--guessing-contact', evaluate BODY.
1047 1048
@@ -1051,10 +1052,10 @@ BODY is evaluated twice, with INTERACTIVE bound to the boolean passed to
1051If the user would have been prompted, PROMPT-ARGS-SYM is bound to 1052If the user would have been prompted, PROMPT-ARGS-SYM is bound to
1052the list of arguments that would have been passed to 1053the list of arguments that would have been passed to
1053`read-shell-command', else nil. GUESSED-CLASS-SYM, 1054`read-shell-command', else nil. GUESSED-CLASS-SYM,
1054GUESSED-CONTACT-SYM and GUESSED-LANG-ID-SYM are bound to the 1055GUESSED-CONTACT-SYM, GUESSED-LANG-IDS-SYM and
1055useful return values of `eglot--guess-contact'. Unless the 1056GUESSED-MAJOR-MODES-SYM are bound to the useful return values of
1056server program evaluates to \"a-missing-executable.exe\", this 1057`eglot--guess-contact'. Unless the server program evaluates to
1057macro will assume it exists." 1058\"a-missing-executable.exe\", this macro will assume it exists."
1058 (declare (indent 1) (debug t)) 1059 (declare (indent 1) (debug t))
1059 (let ((i-sym (cl-gensym))) 1060 (let ((i-sym (cl-gensym)))
1060 `(dolist (,i-sym '(nil t)) 1061 `(dolist (,i-sym '(nil t))
@@ -1070,8 +1071,9 @@ macro will assume it exists."
1070 `(lambda (&rest args) (setq ,prompt-args-sym args) "") 1071 `(lambda (&rest args) (setq ,prompt-args-sym args) "")
1071 `(lambda (&rest _dummy) "")))) 1072 `(lambda (&rest _dummy) ""))))
1072 (cl-destructuring-bind 1073 (cl-destructuring-bind
1073 (_ _ ,guessed-class-sym ,guessed-contact-sym 1074 (,(or guessed-major-modes-sym '_)
1074 ,(or guessed-lang-id-sym '_)) 1075 _ ,guessed-class-sym ,guessed-contact-sym
1076 ,(or guessed-lang-ids-sym '_))
1075 (eglot--guess-contact ,i-sym) 1077 (eglot--guess-contact ,i-sym)
1076 ,@body)))))) 1078 ,@body))))))
1077 1079
@@ -1166,16 +1168,17 @@ macro will assume it exists."
1166(ert-deftest eglot-test-server-programs-guess-lang () 1168(ert-deftest eglot-test-server-programs-guess-lang ()
1167 (let ((major-mode 'foo-mode)) 1169 (let ((major-mode 'foo-mode))
1168 (let ((eglot-server-programs '((foo-mode . ("prog-executable"))))) 1170 (let ((eglot-server-programs '((foo-mode . ("prog-executable")))))
1169 (eglot--guessing-contact (_ nil _ _ guessed-lang) 1171 (eglot--guessing-contact (_ nil _ _ _ guessed-langs)
1170 (should (equal guessed-lang "foo")))) 1172 (should (equal guessed-langs '("foo")))))
1171 (let ((eglot-server-programs '(((foo-mode :language-id "bar") 1173 (let ((eglot-server-programs '(((foo-mode :language-id "bar")
1172 . ("prog-executable"))))) 1174 . ("prog-executable")))))
1173 (eglot--guessing-contact (_ nil _ _ guessed-lang) 1175 (eglot--guessing-contact (_ nil _ _ _ guessed-langs)
1174 (should (equal guessed-lang "bar")))) 1176 (should (equal guessed-langs '("bar")))))
1175 (let ((eglot-server-programs '(((baz-mode (foo-mode :language-id "bar")) 1177 (let ((eglot-server-programs '(((baz-mode (foo-mode :language-id "bar"))
1176 . ("prog-executable"))))) 1178 . ("prog-executable")))))
1177 (eglot--guessing-contact (_ nil _ _ guessed-lang) 1179 (eglot--guessing-contact (_ nil _ _ modes guessed-langs)
1178 (should (equal guessed-lang "bar")))))) 1180 (should (equal guessed-langs '("bar" "baz")))
1181 (should (equal modes '(foo-mode baz-mode)))))))
1179 1182
1180(defun eglot--glob-match (glob str) 1183(defun eglot--glob-match (glob str)
1181 (funcall (eglot--glob-compile glob t t) str)) 1184 (funcall (eglot--glob-compile glob t t) str))
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 28d8120f143..7dabb735522 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -839,7 +839,7 @@ See Bug#21722."
839 (forward-line 2) 839 (forward-line 2)
840 (narrow-to-region (pos-bol) (pos-eol)) 840 (narrow-to-region (pos-bol) (pos-eol))
841 (should (equal (line-number-at-pos) 1)) 841 (should (equal (line-number-at-pos) 1))
842 (line-number-at-pos nil t) 842 (should (equal (line-number-at-pos nil t) 3))
843 (should (equal (line-number-at-pos) 1)))) 843 (should (equal (line-number-at-pos) 1))))
844 844
845(ert-deftest line-number-at-pos-keeps-point () 845(ert-deftest line-number-at-pos-keeps-point ()
@@ -849,8 +849,8 @@ See Bug#21722."
849 (goto-char (point-min)) 849 (goto-char (point-min))
850 (forward-line 2) 850 (forward-line 2)
851 (setq pos (point)) 851 (setq pos (point))
852 (line-number-at-pos) 852 (should (equal (line-number-at-pos) 3))
853 (line-number-at-pos nil t) 853 (should (equal (line-number-at-pos nil t) 3))
854 (should (equal pos (point)))))) 854 (should (equal pos (point))))))
855 855
856(ert-deftest line-number-at-pos-when-passing-point () 856(ert-deftest line-number-at-pos-when-passing-point ()
diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el
index 468cd221ef9..26a21c34152 100644
--- a/test/src/treesit-tests.el
+++ b/test/src/treesit-tests.el
@@ -257,6 +257,7 @@
257(defmacro treesit--ert-search-setup (&rest body) 257(defmacro treesit--ert-search-setup (&rest body)
258 "Setup macro used by `treesit-search-forward' and friends. 258 "Setup macro used by `treesit-search-forward' and friends.
259BODY is the test body." 259BODY is the test body."
260 (declare (debug (&rest form)))
260 `(with-temp-buffer 261 `(with-temp-buffer
261 (let (parser root array) 262 (let (parser root array)
262 (progn 263 (progn
@@ -332,6 +333,58 @@ BODY is the test body."
332 do (should (equal (treesit-node-text cursor) 333 do (should (equal (treesit-node-text cursor)
333 text))))) 334 text)))))
334 335
336(ert-deftest treesit-search-forward-predicate ()
337 "Test various form of supported predicates in search functions."
338 (skip-unless (treesit-language-available-p 'json))
339 (treesit--ert-search-setup
340 ;; The following tests are adapted from `treesit-search-forward'.
341
342 ;; Test `or'
343 (cl-loop for cursor = (treesit-node-child array 0)
344 then (treesit-search-forward cursor `(or "number" ,(rx "["))
345 nil t)
346 for text in '("[" "[" "1" "2" "3"
347 "[" "4" "5" "6"
348 "[" "7" "8" "9")
349 while cursor
350 do (should (equal (treesit-node-text cursor) text)))
351 ;; Test `not' and `or'
352 (cl-loop for cursor = (treesit-node-child array 0)
353 then (treesit-search-forward cursor
354 `(not (or "number" ,(rx "[")))
355 nil t)
356 for text in '("[" "," "," "]"
357 "[1,2,3]" ","
358 "," "," "]"
359 "[4,5,6]" ","
360 "," "," "]"
361 "[7,8,9]" "]"
362 "[[1,2,3], [4,5,6], [7,8,9]]")
363 while cursor
364 do (should (equal (treesit-node-text cursor) text)))
365 ;; Test (regexp . function)
366 (cl-labels ((is-odd (string)
367 (and (eq 1 (length string))
368 (cl-oddp (string-to-number string)))))
369 (cl-loop for cursor = (treesit-node-child array 0)
370 then (treesit-search-forward cursor '("number" . is-odd)
371 nil t)
372 for text in '("[" "1" "3" "5" "7" "9")
373 while cursor
374 do (should (equal (treesit-node-text cursor) text))))))
375
376(ert-deftest treesit-search-forward-predicate-invalid-predicate ()
377 "Test tree-sitter's ability to detect invalid predicates."
378 (skip-unless (treesit-language-available-p 'json))
379 (treesit--ert-search-setup
380 (dolist (pred '( 1 (not 1) (not "2" "3") (or) (or 1)))
381 (should-error (treesit-search-forward (treesit-node-child array 0)
382 pred)
383 :type 'treesit-invalid-predicate))
384 (should-error (treesit-search-forward (treesit-node-child array 0)
385 'not-a-function)
386 :type 'void-function)))
387
335(ert-deftest treesit-cursor-helper-with-missing-node () 388(ert-deftest treesit-cursor-helper-with-missing-node ()
336 "Test treesit_cursor_helper with a missing node." 389 "Test treesit_cursor_helper with a missing node."
337 (skip-unless (treesit-language-available-p 'json)) 390 (skip-unless (treesit-language-available-p 'json))
@@ -831,7 +884,7 @@ the return value is ((1 3) (1 3))."
831 (funcall fn))))) 884 (funcall fn)))))
832 885
833(defun treesit--ert-test-defun-navigation 886(defun treesit--ert-test-defun-navigation
834 (init program master &optional opening closing) 887 (init program master tactic &optional opening closing)
835 "Run defun navigation tests on PROGRAM and MASTER. 888 "Run defun navigation tests on PROGRAM and MASTER.
836 889
837INIT is a setup function that runs right after this function 890INIT is a setup function that runs right after this function
@@ -843,6 +896,8 @@ starting marker position, and the rest are marker positions the
843corresponding navigation should stop at (after running 896corresponding navigation should stop at (after running
844`treesit-defun-skipper'). 897`treesit-defun-skipper').
845 898
899TACTIC is the same as in `treesit--navigate-thing'.
900
846OPENING and CLOSING are the same as in 901OPENING and CLOSING are the same as in
847`treesit--ert-insert-and-parse-marker', by default they are \"[\" 902`treesit--ert-insert-and-parse-marker', by default they are \"[\"
848and \"]\"." 903and \"]\"."
@@ -873,7 +928,7 @@ and \"]\"."
873 (if-let ((pos (funcall 928 (if-let ((pos (funcall
874 #'treesit--navigate-thing 929 #'treesit--navigate-thing
875 (point) (car conf) (cdr conf) 930 (point) (car conf) (cdr conf)
876 regexp pred))) 931 regexp pred tactic)))
877 (save-excursion 932 (save-excursion
878 (goto-char pos) 933 (goto-char pos)
879 (funcall treesit-defun-skipper) 934 (funcall treesit-defun-skipper)
@@ -1025,43 +1080,42 @@ the prev-beg, now point should be at marker 103\", etc.")
1025 "Test defun navigation." 1080 "Test defun navigation."
1026 (skip-unless (treesit-language-available-p 'python)) 1081 (skip-unless (treesit-language-available-p 'python))
1027 ;; Nested defun navigation 1082 ;; Nested defun navigation
1028 (let ((treesit-defun-tactic 'nested)) 1083 (require 'python)
1029 (require 'python) 1084 (treesit--ert-test-defun-navigation
1030 (treesit--ert-test-defun-navigation 1085 'python-ts-mode
1031 'python-ts-mode 1086 treesit--ert-defun-navigation-python-program
1032 treesit--ert-defun-navigation-python-program 1087 treesit--ert-defun-navigation-nested-master
1033 treesit--ert-defun-navigation-nested-master))) 1088 'nested))
1034 1089
1035(ert-deftest treesit-defun-navigation-nested-2 () 1090(ert-deftest treesit-defun-navigation-nested-2 ()
1036 "Test defun navigation using `js-ts-mode'." 1091 "Test defun navigation using `js-ts-mode'."
1037 (skip-unless (treesit-language-available-p 'javascript)) 1092 (skip-unless (treesit-language-available-p 'javascript))
1038 ;; Nested defun navigation 1093 ;; Nested defun navigation
1039 (let ((treesit-defun-tactic 'nested)) 1094 (require 'js)
1040 (require 'js) 1095 (treesit--ert-test-defun-navigation
1041 (treesit--ert-test-defun-navigation 1096 'js-ts-mode
1042 'js-ts-mode 1097 treesit--ert-defun-navigation-js-program
1043 treesit--ert-defun-navigation-js-program 1098 treesit--ert-defun-navigation-nested-master
1044 treesit--ert-defun-navigation-nested-master))) 1099 'nested))
1045 1100
1046(ert-deftest treesit-defun-navigation-nested-3 () 1101(ert-deftest treesit-defun-navigation-nested-3 ()
1047 "Test defun navigation using `bash-ts-mode'." 1102 "Test defun navigation using `bash-ts-mode'."
1048 (skip-unless (treesit-language-available-p 'bash)) 1103 (skip-unless (treesit-language-available-p 'bash))
1049 ;; Nested defun navigation 1104 ;; Nested defun navigation
1050 (let ((treesit-defun-tactic 'nested)) 1105 (treesit--ert-test-defun-navigation
1051 (treesit--ert-test-defun-navigation 1106 (lambda ()
1052 (lambda () 1107 (treesit-parser-create 'bash)
1053 (treesit-parser-create 'bash) 1108 (setq-local treesit-defun-type-regexp "function_definition"))
1054 (setq-local treesit-defun-type-regexp "function_definition")) 1109 treesit--ert-defun-navigation-bash-program
1055 treesit--ert-defun-navigation-bash-program 1110 treesit--ert-defun-navigation-nested-master
1056 treesit--ert-defun-navigation-nested-master))) 1111 'nested))
1057 1112
1058(ert-deftest treesit-defun-navigation-nested-4 () 1113(ert-deftest treesit-defun-navigation-nested-4 ()
1059 "Test defun navigation using Elixir. 1114 "Test defun navigation using Elixir.
1060This tests bug#60355." 1115This tests bug#60355."
1061 (skip-unless (treesit-language-available-p 'elixir)) 1116 (skip-unless (treesit-language-available-p 'elixir))
1062 ;; Nested defun navigation 1117 ;; Nested defun navigation
1063 (let ((treesit-defun-tactic 'nested) 1118 (let ((pred (lambda (node)
1064 (pred (lambda (node)
1065 (member (treesit-node-text 1119 (member (treesit-node-text
1066 (treesit-node-child-by-field-name node "target")) 1120 (treesit-node-child-by-field-name node "target"))
1067 '("def" "defmodule"))))) 1121 '("def" "defmodule")))))
@@ -1070,18 +1124,19 @@ This tests bug#60355."
1070 (treesit-parser-create 'elixir) 1124 (treesit-parser-create 'elixir)
1071 (setq-local treesit-defun-type-regexp `("call" . ,pred))) 1125 (setq-local treesit-defun-type-regexp `("call" . ,pred)))
1072 treesit--ert-defun-navigation-elixir-program 1126 treesit--ert-defun-navigation-elixir-program
1073 treesit--ert-defun-navigation-nested-master))) 1127 treesit--ert-defun-navigation-nested-master
1128 'nested)))
1074 1129
1075(ert-deftest treesit-defun-navigation-top-level () 1130(ert-deftest treesit-defun-navigation-top-level ()
1076 "Test top-level only defun navigation." 1131 "Test top-level only defun navigation."
1077 (skip-unless (treesit-language-available-p 'python)) 1132 (skip-unless (treesit-language-available-p 'python))
1078 ;; Nested defun navigation 1133 ;; Nested defun navigation
1079 (let ((treesit-defun-tactic 'top-level)) 1134 (require 'python)
1080 (require 'python) 1135 (treesit--ert-test-defun-navigation
1081 (treesit--ert-test-defun-navigation 1136 'python-ts-mode
1082 'python-ts-mode 1137 treesit--ert-defun-navigation-python-program
1083 treesit--ert-defun-navigation-python-program 1138 treesit--ert-defun-navigation-top-level-master
1084 treesit--ert-defun-navigation-top-level-master))) 1139 'top-level))
1085 1140
1086;; TODO 1141;; TODO
1087;; - Functions in treesit.el 1142;; - Functions in treesit.el