diff options
| author | Po Lu | 2023-04-14 08:02:14 +0800 |
|---|---|---|
| committer | Po Lu | 2023-04-14 08:02:14 +0800 |
| commit | 618ba26ed190f0b4b0fe725d4e717c01ce9fbeed (patch) | |
| tree | 41411eb10c7371c6b11fc2fa1124f999abcb1733 | |
| parent | e11e56a057aae22872014e97684e0a9b3fbde156 (diff) | |
| parent | 2c3ca78e811b288aa4801f78c11ba9ddf9ffe02c (diff) | |
| download | emacs-618ba26ed190f0b4b0fe725d4e717c01ce9fbeed.tar.gz emacs-618ba26ed190f0b4b0fe725d4e717c01ce9fbeed.zip | |
Merge remote-tracking branch 'origin/master' into feature/android
| -rw-r--r-- | doc/misc/flymake.texi | 24 | ||||
| -rw-r--r-- | etc/NEWS | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 375 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 54 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eldoc.el | 37 | ||||
| -rw-r--r-- | lisp/progmodes/eglot.el | 129 | ||||
| -rw-r--r-- | lisp/progmodes/flymake.el | 89 | ||||
| -rw-r--r-- | lisp/subr.el | 2 | ||||
| -rw-r--r-- | src/data.c | 5 | ||||
| -rw-r--r-- | src/eval.c | 3 | ||||
| -rw-r--r-- | src/treesit.c | 201 | ||||
| -rw-r--r-- | test/lisp/progmodes/eglot-tests.el | 29 | ||||
| -rw-r--r-- | test/lisp/simple-tests.el | 6 | ||||
| -rw-r--r-- | test/src/treesit-tests.el | 115 |
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 | |||
| 142 | is. Alternatively, place point on the highlighted regions and use the | 142 | is. Alternatively, place point on the highlighted regions and use the |
| 143 | commands @code{eldoc} or @code{display-local-help}. | 143 | commands @code{eldoc} or @code{display-local-help}. |
| 144 | 144 | ||
| 145 | Another easy way to get instant access to the diagnostic text is to | ||
| 146 | set @code{flymake-show-diagnostics-at-end-of-line} to a non-@code{nil} | ||
| 147 | value. This makes the diagnostic messages appear at the end of the | ||
| 148 | line where the regular annotation is located (@pxref{Customizable | ||
| 149 | variables}) | ||
| 150 | |||
| 145 | @cindex next and previous diagnostic | 151 | @cindex next and previous diagnostic |
| 146 | If the diagnostics are outside the visible region of the buffer, | 152 | If 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 |
| 315 | If non-@code{nil}, moving to errors with @code{flymake-goto-next-error} and | 321 | If 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 | ||
| 325 | If non-@code{nil}, show summarized descriptions of diagnostics at the | ||
| 326 | end of the line. Depending on your preference, this can either be | ||
| 327 | distracting and easily confused with actual code, or a significant | ||
| 328 | early aid that relieves you from moving around or reaching for the | ||
| 329 | mouse to consult an error message. | ||
| 330 | |||
| 331 | @item flymake-error-eol | ||
| 332 | A custom face for summarizing diagnostic error messages. | ||
| 333 | |||
| 334 | @item flymake-warning-eol | ||
| 335 | A custom face for summarizing diagnostic warning messages. | ||
| 336 | |||
| 337 | @item flymake-note-eol | ||
| 338 | A custom face for summarizing diagnostic notes. | ||
| 317 | @end vtable | 339 | @end vtable |
| 318 | 340 | ||
| 319 | @node Extending Flymake | 341 | @node Extending Flymake |
| @@ -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'. |
| 283 | When non-nil, it will automatically register every package as a | 282 | When non-nil, it will automatically register every package as a |
| 284 | project, that you can quickly select using 'project-switch-project' | 283 | project, 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'. | ||
| 289 | When non-nil, Flymake shows summarized descriptions of diagnostics at | ||
| 290 | the end of the line. Depending on your preference, this can either be | ||
| 291 | distracting and easily confused with actual code, or a significant | ||
| 292 | early aid that relieves you from moving the buffer or reaching for the | ||
| 293 | mouse 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. | ||
| 686 | If EAGERLYP is non-nil show documentation as soon as possible, | ||
| 687 | else 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. |
| 700 | This is meant to be used as a value for `eldoc-documentation-strategy'." | 686 | This 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. |
| 705 | This is meant to be used as a value for `eldoc-documentation-strategy'." | 704 | This 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. |
| 972 | Return (MANAGED-MODES LANGUAGE-ID CONTACT-PROXY). | 975 | Return (LANGUAGES . CONTACT-PROXY). |
| 973 | 976 | ||
| 974 | MANAGED-MODES is a list with MODE as its first element. | 977 | MANAGED-MODES is a list with MODE as its first element. |
| 975 | Subsequent elements are other major modes also potentially | 978 | Subsequent elements are other major modes also potentially |
| 976 | managed by the server that is to manage MODE. | 979 | managed by the server that is to manage MODE. |
| 977 | 980 | ||
| 978 | If not specified in `eglot-server-programs' (which see), | 981 | LANGUAGE-IDS is a list of the same length as MANAGED-MODES. Each |
| 979 | LANGUAGE-ID is determined from MODE's name. | 982 | elem is derived from the corresponding mode name, if not |
| 983 | specified in `eglot-server-programs' (which see). | ||
| 980 | 984 | ||
| 981 | CONTACT-PROXY is the value of the corresponding | 985 | CONTACT-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'. |
| 1007 | Return (MANAGED-MODE PROJECT CLASS CONTACT LANG-ID). If INTERACTIVE is | 1012 | Return (MANAGED-MODES PROJECT CLASS CONTACT LANG-IDS). If INTERACTIVE is |
| 1008 | non-nil, maybe prompt user, else error as soon as something can't | 1013 | non-nil, maybe prompt user, else error as soon as something can't |
| 1009 | be guessed." | 1014 | be 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 | ||
| 1099 | This starts a Language Server Protocol (LSP) server suitable for the | 1103 | This starts a Language Server Protocol (LSP) server suitable for |
| 1100 | buffers of PROJECT whose `major-mode' is MANAGED-MAJOR-MODE. | 1104 | the buffers of PROJECT whose `major-mode' is among |
| 1101 | CLASS is the class of the LSP server to start and CONTACT specifies | 1105 | MANAGED-MAJOR-MODES. CLASS is the class of the LSP server to |
| 1102 | how to connect to the server. | 1106 | start and CONTACT specifies how to connect to the server. |
| 1103 | 1107 | ||
| 1104 | Interactively, the command attempts to guess MANAGED-MAJOR-MODE | 1108 | Interactively, the command attempts to guess MANAGED-MAJOR-MODES, |
| 1105 | from the current buffer's `major-mode', CLASS and CONTACT from | 1109 | CLASS, CONTACT, and LANGUAGE-IDS from `eglot-server-programs', |
| 1106 | `eglot-server-programs' looked up by the major mode, and PROJECT from | 1110 | according to the current buffer's `major-mode'. PROJECT is |
| 1107 | `project-find-functions'. The search for active projects in this | 1111 | guessed from `project-find-functions'. The search for active |
| 1108 | context binds `eglot-lsp-context' (which see). | 1112 | projects in this context binds `eglot-lsp-context' (which see). |
| 1109 | 1113 | ||
| 1110 | If it can't guess, it prompts the user for the mode and the server. | 1114 | If it can't guess, it prompts the user for the mode and the |
| 1111 | With a single \\[universal-argument] prefix arg, it always prompts for COMMAND. | 1115 | server. With a single \\[universal-argument] prefix arg, it |
| 1112 | With two \\[universal-argument], it also always prompts for MANAGED-MAJOR-MODE. | 1116 | always prompts for COMMAND. With two \\[universal-argument], it |
| 1117 | also always prompts for MANAGED-MAJOR-MODE. | ||
| 1113 | 1118 | ||
| 1114 | The LSP server of CLASS is started (or contacted) via CONTACT. | 1119 | The LSP server of CLASS is started (or contacted) via CONTACT. |
| 1115 | If this operation is successful, current *and future* file | 1120 | If this operation is successful, current *and future* file |
| @@ -1127,8 +1132,8 @@ CONTACT specifies how to contact the server. It is a | |||
| 1127 | keyword-value plist used to initialize CLASS or a plain list as | 1132 | keyword-value plist used to initialize CLASS or a plain list as |
| 1128 | described in `eglot-server-programs', which see. | 1133 | described in `eglot-server-programs', which see. |
| 1129 | 1134 | ||
| 1130 | LANGUAGE-ID is the language ID string to send to the server for | 1135 | LANGUAGE-IDS is a list of language ID string to send to the |
| 1131 | MANAGED-MAJOR-MODE, which matters to a minority of servers. | 1136 | server for each element in MANAGED-MAJOR-MODES. |
| 1132 | 1137 | ||
| 1133 | INTERACTIVE is ignored and provided for backward compatibility." | 1138 | INTERACTIVE 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. |
| 1230 | This docstring appeases checkdoc, that's all." | 1236 | This 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 | |||
| 829 | If TREE is a cons cell, this recursively copies both its car and its cdr. | 829 | If TREE is a cons cell, this recursively copies both its car and its cdr. |
| 830 | Contrast to `copy-sequence', which copies only along the cdrs. With second | 830 | Contrast to `copy-sequence', which copies only along the cdrs. With second |
| 831 | argument VECP, this copies vectors as well as conses." | 831 | argument 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. */ | 3145 | static bool |
| 3146 | treesit_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. */ | ||
| 3146 | static bool | 3220 | static bool |
| 3147 | treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred, | 3221 | treesit_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 | |||
| 3177 | static bool | 3289 | static bool |
| 3178 | treesit_search_dfs (TSTreeCursor *cursor, | 3290 | treesit_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 | |||
| 3213 | static bool | 3328 | static bool |
| 3214 | treesit_search_forward (TSTreeCursor *cursor, | 3329 | treesit_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 | |||
| 3366 | static void | ||
| 3367 | treesit_traverse_cleanup_cursor (void *cursor) | ||
| 3368 | { | ||
| 3369 | ts_tree_cursor_delete (cursor); | ||
| 3370 | } | ||
| 3371 | |||
| 3250 | DEFUN ("treesit-search-subtree", | 3372 | DEFUN ("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 | ||
| 3301 | DEFUN ("treesit-search-forward", | 3428 | DEFUN ("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. */ | ||
| 3362 | static void | 3496 | static void |
| 3363 | treesit_build_sparse_tree (TSTreeCursor *cursor, Lisp_Object parent, | 3497 | treesit_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 | |||
| 1051 | If the user would have been prompted, PROMPT-ARGS-SYM is bound to | 1052 | If the user would have been prompted, PROMPT-ARGS-SYM is bound to |
| 1052 | the list of arguments that would have been passed to | 1053 | the 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, |
| 1054 | GUESSED-CONTACT-SYM and GUESSED-LANG-ID-SYM are bound to the | 1055 | GUESSED-CONTACT-SYM, GUESSED-LANG-IDS-SYM and |
| 1055 | useful return values of `eglot--guess-contact'. Unless the | 1056 | GUESSED-MAJOR-MODES-SYM are bound to the useful return values of |
| 1056 | server program evaluates to \"a-missing-executable.exe\", this | 1057 | `eglot--guess-contact'. Unless the server program evaluates to |
| 1057 | macro 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. |
| 259 | BODY is the test body." | 259 | BODY 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 | ||
| 837 | INIT is a setup function that runs right after this function | 890 | INIT is a setup function that runs right after this function |
| @@ -843,6 +896,8 @@ starting marker position, and the rest are marker positions the | |||
| 843 | corresponding navigation should stop at (after running | 896 | corresponding navigation should stop at (after running |
| 844 | `treesit-defun-skipper'). | 897 | `treesit-defun-skipper'). |
| 845 | 898 | ||
| 899 | TACTIC is the same as in `treesit--navigate-thing'. | ||
| 900 | |||
| 846 | OPENING and CLOSING are the same as in | 901 | OPENING 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 \"[\" |
| 848 | and \"]\"." | 903 | and \"]\"." |
| @@ -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. |
| 1060 | This tests bug#60355." | 1115 | This 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 |