From a75d1da911c07a201a19d8827cd74f181220c274 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 19 Dec 2022 15:33:09 +0200 Subject: Make emacsclient add abbreviated file names to file-name-history * lisp/server.el (server-visit-files): Use 'file-name-history--add' to add the visited files to history. (Bug#60097) --- lisp/server.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/server.el b/lisp/server.el index fd740d126df..d963ee5b1e0 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1495,7 +1495,7 @@ so don't mark these buffers specially, just visit them normally." minibuffer-auto-raise)) (filen (car file)) (obuf (get-file-buffer filen))) - (add-to-history 'file-name-history filen) + (file-name-history--add filen) (if (null obuf) (progn (run-hooks 'pre-command-hook) -- cgit v1.2.1 From 64163618d21bfa31e56b47c813ce50681c3d3556 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Sun, 18 Dec 2022 23:04:00 -0500 Subject: whitespace: Fix unintended change in buffer modification status * lisp/whitespace.el (whitespace--empty-at-bob-matcher) whitespace--empty-at-eob-matcher, whitespace--update-bob-eob): Silently add the `font-lock-multiline' text property when highlighting beginning-of-buffer and end-of-buffer empty lines to prevent Emacs from running modification hooks or considering the buffer to be modified (Bug#60066). * test/lisp/whitespace-tests.el (whitespace-tests--empty-bob-eob-modified): Add a regression test. --- lisp/whitespace.el | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 25ea07e9db7..9bc6ad9db46 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -2268,10 +2268,11 @@ Highlighting those lines can be distracting.)" (save-excursion (goto-char whitespace-point) (line-beginning-position))))) (when (= p 1) - ;; See the comment in `whitespace--update-bob-eob' for why this - ;; text property is added here. - (put-text-property 1 whitespace-bob-marker - 'font-lock-multiline t)) + (with-silent-modifications + ;; See the comment in `whitespace--update-bob-eob' for why + ;; this text property is added here. + (put-text-property 1 whitespace-bob-marker + 'font-lock-multiline t))) (when (< p e) (set-match-data (list p e)) (goto-char e)))) @@ -2292,10 +2293,11 @@ about to start typing, and if they do, that line and previous empty lines will no longer be EoB empty lines. Highlighting those lines can be distracting.)" (when (= limit (1+ (buffer-size))) - ;; See the comment in `whitespace--update-bob-eob' for why this - ;; text property is added here. - (put-text-property whitespace-eob-marker limit - 'font-lock-multiline t)) + (with-silent-modifications + ;; See the comment in `whitespace--update-bob-eob' for why this + ;; text property is added here. + (put-text-property whitespace-eob-marker limit + 'font-lock-multiline t))) (let ((b (max (point) whitespace-eob-marker whitespace-bob-marker ; See comment in the bob func. (save-excursion (goto-char whitespace-point) @@ -2437,8 +2439,9 @@ purposes)." (save-match-data (when (looking-at whitespace-empty-at-bob-regexp) (set-marker whitespace-bob-marker (match-end 1)) - (put-text-property (match-beginning 1) (match-end 1) - 'font-lock-multiline t)))) + (with-silent-modifications + (put-text-property (match-beginning 1) (match-end 1) + 'font-lock-multiline t))))) (when (or (null end) (>= end (save-excursion (goto-char whitespace-eob-marker) @@ -2451,8 +2454,9 @@ purposes)." (when (whitespace--looking-back whitespace-empty-at-eob-regexp) (set-marker whitespace-eob-marker (match-beginning 1)) - (put-text-property (match-beginning 1) (match-end 1) - 'font-lock-multiline t))))))))) + (with-silent-modifications + (put-text-property (match-beginning 1) (match-end 1) + 'font-lock-multiline t)))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -- cgit v1.2.1 From 63cdbd986bb8f841717e2d813df6f75b6b02cf8b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 11 Dec 2022 19:16:07 -0800 Subject: ; Really respect browse-url var in erc-compat * lisp/erc/erc-compat.el: Do what was supposed to be done by 75f26646d4a569cfb485de4baddcda66ff44b2c3 "; Be nicer when updating browse-url var in erc-compat". This is the less harmful version of that patch (from bug#59976#8) but without the cl-lib requirement since users may not want to load the main ERC library right away. * lisp/erc/erc.el: Clarify some comments regarding the core API. --- lisp/erc/erc-compat.el | 10 +++++----- lisp/erc/erc.el | 12 ++++++------ 2 files changed, 11 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 77625398abd..fdcb146d42a 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -391,11 +391,11 @@ If START or END is negative, it counts from the end." (cond ((fboundp 'browse-url-irc)) ; 29 ((boundp 'browse-url-default-handlers) ; 28 - (setf (alist-get "\\`irc6?s?://" browse-url-default-handlers - nil nil (lambda (a _) - (and (stringp a) - (string-match-p a "irc://localhost")))) - #'erc-compat--29-browse-url-irc)) + (add-to-list 'browse-url-default-handlers + '("\\`irc6?s?://" . erc-compat--29-browse-url-irc) + nil (lambda (_ a) + (and (stringp (car-safe a)) + (string-match-p (car a) "irc://localhost"))))) ((boundp 'browse-url-browser-function) ; 27 (require 'browse-url) (let ((existing browse-url-browser-function)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6cfc39c4bda..6a5e0018964 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1765,8 +1765,7 @@ all channel buffers on all servers." ;; to, it was never realized. ;; ;; New library code should use the `erc--target' struct instead. -;; Third-party code can continue to use this until a getter for -;; `erc--target' (or whatever replaces it) is exported. +;; Third-party code can continue to use this and `erc-default-target'. (defvar-local erc-default-recipients nil "List of default recipients of the current buffer.") @@ -6012,13 +6011,14 @@ See also `erc-downcase'." ;; While `erc-default-target' happens to return nil in channel buffers ;; you've parted or from which you've been kicked, using it to detect ;; whether a channel is currently joined may become unreliable in the -;; future. For now, new code should consider using +;; future. For now, third-party code can use ;; ;; (erc-get-channel-user (erc-current-nick)) ;; -;; and expect a nicer option eventually. For retrieving a target -;; regardless of subscription or connection status, use replacements -;; based on `erc--target' instead. See also `erc--default-target'. +;; A predicate may be provided eventually. For retrieving a target's +;; name regardless of subscription or connection status, new library +;; code should use `erc--default-target'. Third-party code should +;; continue to use `erc-default-target'. (defun erc-default-target () "Return the current default target (as a character string) or nil if none." -- cgit v1.2.1 From 03e75b0f5f279f166db895ba4245bda6fa2f1ffe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 19 Dec 2022 17:42:33 +0100 Subject: called-interactively-p: cut broken comparison * lisp/subr.el (called-interactively-p): Remove attempt to detect `byte-code` frames; it wasn't done right but also does not seem to be necessary. Adjust comment that was out of date. --- lisp/subr.el | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/subr.el b/lisp/subr.el index e142eaa8104..4fa63a1f3cd 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6084,14 +6084,8 @@ command is called from a keyboard macro?" ;; Skip special forms (from non-compiled code). (and frame (null (car frame))) ;; Skip also `interactive-p' (because we don't want to know if - ;; interactive-p was called interactively but if it's caller was) - ;; and `byte-code' (idem; this appears in subexpressions of things - ;; like condition-case, which are wrapped in a separate bytecode - ;; chunk). - ;; FIXME: For lexical-binding code, this is much worse, - ;; because the frames look like "byte-code -> funcall -> #[...]", - ;; which is not a reliable signature. - (memq (nth 1 frame) '(interactive-p 'byte-code)) + ;; interactive-p was called interactively but if it's caller was). + (eq (nth 1 frame) 'interactive-p) ;; Skip package-specific stack-frames. (let ((skip (run-hook-with-args-until-success 'called-interactively-p-functions -- cgit v1.2.1 From 23f7c9c2a92e4619b7c4d2286d4249f812cd695d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 19 Dec 2022 19:01:04 +0200 Subject: Fix storing email into nnmail by Gnus * lisp/gnus/nnml.el (nnml--encode-headers): Wrap 'rfc2047-encode-string' calls with 'ignore-errors', to avoid disrupting email workflows due to possibly-invalid headers. Reported by Florian Weimer . --- lisp/gnus/nnml.el | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 40e4b9ea828..7aa445e6646 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -776,17 +776,22 @@ article number. This function is called narrowed to an article." (nnml--encode-headers headers) headers)))) +;; RFC2047-encode Subject and From, but leave invalid headers unencoded. (defun nnml--encode-headers (headers) (let ((subject (mail-header-subject headers)) (rfc2047-encoding-type 'mime)) (unless (string-match "\\`[[:ascii:]]*\\'" subject) - (setf (mail-header-subject headers) - (mail-encode-encoded-word-string subject t)))) + (let ((encoded-subject + (ignore-errors (mail-encode-encoded-word-string subject t)))) + (if encoded-subject + (setf (mail-header-subject headers) encoded-subject))))) (let ((from (mail-header-from headers)) (rfc2047-encoding-type 'address-mime)) (unless (string-match "\\`[[:ascii:]]*\\'" from) - (setf (mail-header-from headers) - (rfc2047-encode-string from t))))) + (let ((encoded-from + (ignore-errors (rfc2047-encode-string from t)))) + (if encoded-from + (setf (mail-header-from headers) encoded-from)))))) (defun nnml-get-nov-buffer (group &optional incrementalp) (let ((buffer (gnus-get-buffer-create -- cgit v1.2.1 From ae91da52335aafaff5405a49c23460082dfb460d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 19 Dec 2022 19:34:36 +0200 Subject: ; Fix byte-compilation warnings * lisp/cus-edit.el (custom-reset-standard-save-and-update): Fix byte-compilation warnings about using 'eq'. --- lisp/cus-edit.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 8af4618dbd1..65eb066a554 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -903,9 +903,9 @@ This also shows the saved values in the buffer." (defun custom-reset-standard-save-and-update () "Save settings and redraw after erasing customizations." (when (or (and custom-reset-standard-variables-list - (not (eq custom-reset-standard-variables-list '(t)))) + (not (equal custom-reset-standard-variables-list '(t)))) (and custom-reset-standard-faces-list - (not (eq custom-reset-standard-faces-list '(t))))) + (not (equal custom-reset-standard-faces-list '(t))))) ;; Save settings to file. (custom-save-all) ;; Set state of and redraw variables. -- cgit v1.2.1 From 399433cc2b9500b7ee78503c03cead106b76bbd6 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 19 Dec 2022 19:54:08 +0200 Subject: * lisp/progmodes/project.el: Filter out empty strings from history (bug#58447) (project--read-file-cpd-relative): Do not include empty strings (when prefix has the same length as the string). --- lisp/progmodes/project.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 559da6dd649..605636d93e3 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1045,6 +1045,7 @@ by the user at will." (mapcan (lambda (s) (and (string-prefix-p abbr-cpd s) + (not (eq (length abbr-cpd) (length s))) (list (substring s (length abbr-cpd))))) (symbol-value hist)))) (project--completing-read-strict prompt -- cgit v1.2.1 From b9e813f79f2d7afb5f14caad17a865e66af17f15 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Mon, 19 Dec 2022 19:37:44 +0200 Subject: ; ruby-indent-level: Improve the docstring --- lisp/progmodes/ruby-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index fa51597697f..d7efe982870 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -212,7 +212,7 @@ It should match the part after \"def\" and until \"=\".") :safe 'booleanp) (defcustom ruby-indent-level 2 - "Indentation of Ruby statements." + "Number of spaces for each indentation step in `ruby-mode'." :type 'integer :safe 'integerp) -- cgit v1.2.1 From 2b1fdbffcb595bcd72fa9aa3db674c6985042bcb Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Mon, 19 Dec 2022 21:01:27 +0200 Subject: ruby-method-params-indent: New user option * lisp/progmodes/ruby-mode.el (ruby-method-params-indent): New option (bug#60110). (ruby-smie-rules): Use it. * etc/NEWS: Mention it. * test/lisp/progmodes/ruby-mode-resources/ruby.rb: Ensure the var's value is default. * test/lisp/progmodes/ruby-mode-resources/ruby-method-params-indent.rb: New file. * test/lisp/progmodes/ruby-mode-tests.el (ruby-deftest-indent): New macro, use it to run the indentation test using the new file. Disable the :expensive-test tag, because neither runs for "longer than some few seconds", both take significantly below 1s. --- lisp/progmodes/ruby-mode.el | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index d7efe982870..2b813dfcbcc 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -268,6 +268,23 @@ Only has effect when `ruby-use-smie' is t." :safe 'booleanp :version "24.4") +(defcustom ruby-method-params-indent t + "Indentation of multiline method parameters. + +When t, the parameters list is indented to the method name. + +When a number, indent the parameters list this many columns +against the beginning of the method (the \"def\" keyword). + +The value nil means the same as 0. + +Only has effect when `ruby-use-smie' is t." + :type '(choice (const :tag "Indent to the method name" t) + (number :tag "Indent specified number of columns against def") + (const :tag "Indent to def" nil)) + :safe (lambda (val) (or (memq val '(t nil)) (numberp val))) + :version 29.1) + (defcustom ruby-deep-arglist t "Deep indent lists in parenthesis when non-nil. Also ignores spaces after parenthesis when `space'. @@ -660,9 +677,12 @@ This only affects the output of the command `ruby-toggle-block'." (unless (or (eolp) (forward-comment 1)) (cons 'column (current-column))))) ('(:before . " @ ") - (save-excursion - (skip-chars-forward " \t") - (cons 'column (current-column)))) + (if (or (eq ruby-method-params-indent t) + (not (smie-rule-parent-p "def" "def="))) + (save-excursion + (skip-chars-forward " \t") + (cons 'column (current-column))) + (smie-rule-parent (or ruby-method-params-indent 0)))) ('(:before . "do") (ruby-smie--indent-to-stmt)) ('(:before . ".") (if (smie-rule-sibling-p) -- cgit v1.2.1 From cfbfd393b450d4eb7ac0b7922b44208688553c9e Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 19 Dec 2022 21:46:40 +0200 Subject: * lisp/progmodes/project.el (project--read-file-cpd-relative): Optimize. --- lisp/progmodes/project.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 605636d93e3..c2633798473 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1040,13 +1040,14 @@ by the user at will." (setq substrings (cons "./" substrings)))) (new-collection (project--file-completion-table substrings)) (abbr-cpd (abbreviate-file-name common-parent-directory)) + (abbr-cpd-length (length abbr-cpd)) (relname (cl-letf ((history-add-new-input nil) ((symbol-value hist) (mapcan (lambda (s) (and (string-prefix-p abbr-cpd s) - (not (eq (length abbr-cpd) (length s))) - (list (substring s (length abbr-cpd))))) + (not (eq abbr-cpd-length (length s))) + (list (substring s abbr-cpd-length)))) (symbol-value hist)))) (project--completing-read-strict prompt new-collection -- cgit v1.2.1 From aaca72806ecd60f28384fe839cdfe6a28a2b5d1f Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 16 Dec 2022 22:34:52 -0700 Subject: vc-prepare-patch: Number the attached patches * lisp/gnus/mml.el (mml-attach-buffer): New FILENAME argument. * lisp/vc/vc.el (vc--subject-to-file-name): New function. (vc-prepare-patch): When vc-prepare-patches-separately is nil, generate file names for the attached patches. Call vc--subject-to-file-name, and then prepend numbers indicating the ordering of the patches (bug#60147). --- lisp/gnus/mml.el | 13 ++++++++----- lisp/vc/vc.el | 31 +++++++++++++++++++++++++------ 2 files changed, 33 insertions(+), 11 deletions(-) (limited to 'lisp') diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index ebd0adf2e25..dc86fe6db96 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1484,10 +1484,12 @@ Ask for type, description or disposition according to (setq disposition (mml-minibuffer-read-disposition type nil file))) (mml-attach-file file type description disposition))))) -(defun mml-attach-buffer (buffer &optional type description disposition) +(defun mml-attach-buffer (buffer &optional type description disposition filename) "Attach a buffer to the outgoing MIME message. BUFFER is the name of the buffer to attach. See -`mml-attach-file' for details of operation." +`mml-attach-file' regarding TYPE, DESCRIPTION and DISPOSITION. +FILENAME is a suggested file name for the attachment should a +recipient wish to save a copy separate from the message." (interactive (let* ((buffer (read-buffer "Attach buffer: ")) (type (mml-minibuffer-read-type buffer "text/plain")) @@ -1497,9 +1499,10 @@ BUFFER is the name of the buffer to attach. See ;; If in the message header, attach at the end and leave point unchanged. (let ((head (unless (message-in-body-p) (point)))) (if head (goto-char (point-max))) - (mml-insert-empty-tag 'part 'type type 'buffer buffer - 'disposition disposition - 'description description) + (apply #'mml-insert-empty-tag + 'part 'type type 'buffer buffer + 'disposition disposition 'description description + (and filename `(filename ,filename))) ;; When using Mail mode, make sure it does the mime encoding ;; when you send the message. (or (eq mail-user-agent 'message-user-agent) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 690c907c77e..b40bb31b603 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3369,7 +3369,7 @@ If nil, no default will be used. This option may be set locally." (declare-function message--name-table "message" (orig-string)) (declare-function mml-attach-buffer "mml" - (buffer &optional type description disposition)) + (buffer &optional type description disposition filename)) (declare-function log-view-get-marked "log-view" ()) (defun vc-default-prepare-patch (_backend rev) @@ -3410,6 +3410,19 @@ of the current file." (and-let* ((file (buffer-file-name))) (vc-working-revision file))))) +(defun vc--subject-to-file-name (subject) + "Generate a file name for a patch with subject line SUBJECT." + (let* ((stripped + (replace-regexp-in-string "\\`\\[.*PATCH.*\\]\\s-*" "" + subject)) + (truncated (if (length> stripped 50) + (substring stripped 0 50) + stripped))) + (concat + (string-trim (replace-regexp-in-string "\\W" "-" truncated) + "-+" "-+") + ".patch"))) + ;;;###autoload (defun vc-prepare-patch (addressee subject revisions) "Compose an Email sending patches for REVISIONS to ADDRESSEE. @@ -3466,11 +3479,17 @@ marked revisions, use those these." (rfc822-goto-eoh) (forward-line) (save-excursion - (dolist (patch patches) - (mml-attach-buffer (buffer-name (plist-get patch :buffer)) - "text/x-patch" - (plist-get patch :subject) - "attachment"))) + (let ((i 0)) + (dolist (patch patches) + (let* ((patch-subject (plist-get patch :subject)) + (filename + (vc--subject-to-file-name patch-subject))) + (mml-attach-buffer + (buffer-name (plist-get patch :buffer)) + "text/x-patch" + patch-subject + "attachment" + (format "%04d-%s" (cl-incf i) filename)))))) (open-line 2))))) (defun vc-default-responsible-p (_backend _file) -- cgit v1.2.1 From 8739cba1ee0336cef444ec07f170879e67f68202 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 19 Dec 2022 15:15:48 -0700 Subject: ; * lisp/vc/vc.el (vc-prepare-patch): Fix typo. --- lisp/vc/vc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index b40bb31b603..130214b840a 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3433,7 +3433,7 @@ revision, with SUBJECT derived from each revision subject. When invoked with a numerical prefix argument, use the last N revisions. When invoked interactively in a Log View buffer with -marked revisions, use those these." +marked revisions, use those." (interactive (let ((revs (vc-prepare-patch-prompt-revisions)) to) (require 'message) -- cgit v1.2.1 From fb7f3999c59ce3a1b08bca8d8b79db885fd3550f Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Tue, 20 Dec 2022 02:58:48 +0200 Subject: ; Fix ruby-method-params-indent's :version value --- lisp/progmodes/ruby-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 2b813dfcbcc..1f3e9b6ae7b 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -283,7 +283,7 @@ Only has effect when `ruby-use-smie' is t." (number :tag "Indent specified number of columns against def") (const :tag "Indent to def" nil)) :safe (lambda (val) (or (memq val '(t nil)) (numberp val))) - :version 29.1) + :version "29.1") (defcustom ruby-deep-arglist t "Deep indent lists in parenthesis when non-nil. -- cgit v1.2.1 From b4941419c5ba2818c82b58250eed9ac1c8f9dab9 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 20 Dec 2022 06:13:23 +0100 Subject: ; Fix typos in some function names * lisp/cedet/semantic/decorate/include.el (semantic-decoration-unparsed-include-reference-reset): Rename from 'semantic-decoration-unparsed-include-refrence-reset'. * lisp/emacs-lisp/rx.el (rx--normalize-or-arg): Rename from 'rx--normalise-or-arg'. * lisp/frame.el (frame--current-background-mode): Rename from 'frame--current-backround-mode'. * lisp/url/url-future.el (url-future-canceled-p): Rename from 'url-future-cancelled-p'. Update all uses. Make old names into obsolete function aliases. --- lisp/cedet/semantic/decorate/include.el | 8 ++++---- lisp/emacs-lisp/rx.el | 13 ++++++++----- lisp/frame.el | 9 ++++++--- lisp/url/url-future.el | 5 ++++- 4 files changed, 22 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el index fe510c371e3..26785298e6b 100644 --- a/lisp/cedet/semantic/decorate/include.el +++ b/lisp/cedet/semantic/decorate/include.el @@ -790,9 +790,7 @@ any decorated referring includes.") ;; This is a hack. Add in something better? (semanticdb-notify-references table (lambda (tab _me) - (semantic-decoration-unparsed-include-refrence-reset tab) - )) - )) + (semantic-decoration-unparsed-include-reference-reset tab))))) (cl-defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache) new-tags) @@ -805,7 +803,7 @@ any decorated referring includes.") "Synchronize a CACHE with some NEW-TAGS." (semantic-reset cache)) -(defun semantic-decoration-unparsed-include-refrence-reset (table) +(defun semantic-decoration-unparsed-include-reference-reset (table) "Refresh any highlighting in buffers referred to by TABLE. If TABLE is not in a buffer, do nothing." ;; This cache removal may seem odd in that we are "creating one", but @@ -835,6 +833,8 @@ If TABLE is not in a buffer, do nothing." (semantic-decorate-add-decorations allinc) )))) +(define-obsolete-function-alias 'semantic-decoration-unparsed-include-refrence-reset + #'semantic-decoration-unparsed-include-reference-reset "30.1") (provide 'semantic/decorate/include) diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index f2a0dc54832..2ebdbc0efc4 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -254,20 +254,20 @@ Left-fold the list L, starting with X, by the binary function F." (setq l (cdr l))) x) -(defun rx--normalise-or-arg (form) +(defun rx--normalize-or-arg (form) "Normalize the `or' argument FORM. Characters become strings, user-definitions and `eval' forms are expanded, and `or' forms are normalized recursively." (cond ((characterp form) (char-to-string form)) ((and (consp form) (memq (car form) '(or |))) - (cons (car form) (mapcar #'rx--normalise-or-arg (cdr form)))) + (cons (car form) (mapcar #'rx--normalize-or-arg (cdr form)))) ((and (consp form) (eq (car form) 'eval)) - (rx--normalise-or-arg (rx--expand-eval (cdr form)))) + (rx--normalize-or-arg (rx--expand-eval (cdr form)))) (t (let ((expanded (rx--expand-def form))) (if expanded - (rx--normalise-or-arg expanded) + (rx--normalize-or-arg expanded) form))))) (defun rx--all-string-or-args (body) @@ -302,7 +302,7 @@ Return (REGEXP . PRECEDENCE)." ((null (cdr body)) ; Single item. (rx--translate (car body))) (t - (let* ((args (mapcar #'rx--normalise-or-arg body)) + (let* ((args (mapcar #'rx--normalize-or-arg body)) (all-strings (catch 'rx--nonstring (rx--all-string-or-args args)))) (cond (all-strings ; Only strings. @@ -1494,6 +1494,9 @@ following constructs: ;; Obsolete internal symbol, used in old versions of the `flycheck' package. (define-obsolete-function-alias 'rx-submatch-n 'rx-to-string "27.1") +(define-obsolete-function-alias 'rx--normalise-or-arg + #'rx--normalize-or-arg "30.1") + (provide 'rx) ;;; rx.el ends here diff --git a/lisp/frame.el b/lisp/frame.el index 400f8a44eea..e4cd2cd8ae2 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1188,7 +1188,7 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))." (defvar inhibit-frame-set-background-mode nil) -(defun frame--current-backround-mode (frame) +(defun frame--current-background-mode (frame) (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame)) (bg-color (frame-parameter frame 'background-color)) (tty-type (tty-type frame)) @@ -1218,7 +1218,7 @@ If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate face specs for the new background mode." (unless inhibit-frame-set-background-mode (let* ((bg-mode - (frame--current-backround-mode frame)) + (frame--current-background-mode frame)) (display-type (cond ((null (window-system frame)) (if (tty-display-color-p frame) 'color 'mono)) @@ -1297,7 +1297,7 @@ the `background-mode' terminal parameter." ;; :global t ;; :group 'faces ;; (when (eq dark-mode -;; (eq 'light (frame--current-backround-mode (selected-frame)))) +;; (eq 'light (frame--current-background-mode (selected-frame)))) ;; ;; FIXME: Change the face's SPEC instead? ;; (set-face-attribute 'default nil ;; :foreground (face-attribute 'default :background) @@ -3105,6 +3105,9 @@ If FRAME isn't maximized, show the title bar." frame 'undecorated (eq (alist-get 'fullscreen (frame-parameters frame)) 'maximized))) +(define-obsolete-function-alias 'frame--current-backround-mode + #'frame--current-background-mode "30.1") + (provide 'frame) ;;; frame.el ends here diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el index 56787f7c5ec..737eea32c6a 100644 --- a/lisp/url/url-future.el +++ b/lisp/url/url-future.el @@ -53,7 +53,7 @@ (define-inline url-future-errored-p (url-future) (inline-quote (eq (url-future-status ,url-future) 'error))) -(define-inline url-future-cancelled-p (url-future) +(define-inline url-future-canceled-p (url-future) (inline-quote (eq (url-future-status ,url-future) 'cancel))) (defun url-future-finish (url-future &optional status) @@ -96,5 +96,8 @@ (signal 'error 'url-future-already-done) (url-future-finish url-future 'cancel))) +(define-obsolete-function-alias 'url-future-cancelled-p + #'url-future-canceled-p "30.1") + (provide 'url-future) ;;; url-future.el ends here -- cgit v1.2.1 From 8d6fb6498ab457e92b08e26203b585ba989a7844 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 20 Dec 2022 11:43:30 +0100 Subject: ; Revert UK->US spelling fix in rx.el * lisp/emacs-lisp/rx.el (rx--normalise-or-arg): Revert to British spelling of internal symbol. --- lisp/emacs-lisp/rx.el | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 2ebdbc0efc4..f2a0dc54832 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -254,20 +254,20 @@ Left-fold the list L, starting with X, by the binary function F." (setq l (cdr l))) x) -(defun rx--normalize-or-arg (form) +(defun rx--normalise-or-arg (form) "Normalize the `or' argument FORM. Characters become strings, user-definitions and `eval' forms are expanded, and `or' forms are normalized recursively." (cond ((characterp form) (char-to-string form)) ((and (consp form) (memq (car form) '(or |))) - (cons (car form) (mapcar #'rx--normalize-or-arg (cdr form)))) + (cons (car form) (mapcar #'rx--normalise-or-arg (cdr form)))) ((and (consp form) (eq (car form) 'eval)) - (rx--normalize-or-arg (rx--expand-eval (cdr form)))) + (rx--normalise-or-arg (rx--expand-eval (cdr form)))) (t (let ((expanded (rx--expand-def form))) (if expanded - (rx--normalize-or-arg expanded) + (rx--normalise-or-arg expanded) form))))) (defun rx--all-string-or-args (body) @@ -302,7 +302,7 @@ Return (REGEXP . PRECEDENCE)." ((null (cdr body)) ; Single item. (rx--translate (car body))) (t - (let* ((args (mapcar #'rx--normalize-or-arg body)) + (let* ((args (mapcar #'rx--normalise-or-arg body)) (all-strings (catch 'rx--nonstring (rx--all-string-or-args args)))) (cond (all-strings ; Only strings. @@ -1494,9 +1494,6 @@ following constructs: ;; Obsolete internal symbol, used in old versions of the `flycheck' package. (define-obsolete-function-alias 'rx-submatch-n 'rx-to-string "27.1") -(define-obsolete-function-alias 'rx--normalise-or-arg - #'rx--normalize-or-arg "30.1") - (provide 'rx) ;;; rx.el ends here -- cgit v1.2.1 From d03ea8937803c6714df71dd148c79ca893d159e9 Mon Sep 17 00:00:00 2001 From: Brian Leung Date: Mon, 19 Dec 2022 15:03:06 -0800 Subject: eglot.el: Add vscode-json-languageserver to eglot-server-programs * lisp/progmodes/eglot.el (eglot-server-programs): Add the alternative name of the vcscode JSON server. (Bug#60198) --- lisp/progmodes/eglot.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index ce4ca4f3d92..0f1bfd0447d 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -190,6 +190,7 @@ chosen (interactively or automatically)." '("pylsp" "pyls" ("pyright-langserver" "--stdio") "jedi-language-server"))) ((js-json-mode json-mode json-ts-mode) . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") + ("vscode-json-languageserver" "--stdio") ("json-languageserver" "--stdio")))) ((js-mode js-ts-mode tsx-ts-mode typescript-ts-mode typescript-mode) . ("typescript-language-server" "--stdio")) -- cgit v1.2.1 From d3a76db88b4357fe1c92f240796ea9b522b97a8e Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 20 Dec 2022 19:22:15 +0200 Subject: * lisp/repeat.el: Fix repeat-keep-prefix to allow customizing it to non-nil. * lisp/repeat.el (repeat-keep-prefix): Add or remove 'repeat-pre-hook' depending on the customized value. (repeat-mode): Add or remove 'repeat-pre-hook' to/from 'pre-command-hook' when 'repeat-keep-prefix' is non-nil. (repeat-pre-hook): New function. (repeat-get-map, repeat-check-map): New function refactored from 'repeat-post-hook'. (repeat-post-hook): Move some code to smaller functions. (describe-repeat-maps): Set outline-regexp without ^L. * test/lisp/repeat-tests.el (repeat-tests-keep-prefix): Uncomment test case that is fixed now in bug#51281 and bug#55986. --- lisp/repeat.el | 117 +++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 73 insertions(+), 44 deletions(-) (limited to 'lisp') diff --git a/lisp/repeat.el b/lisp/repeat.el index 33e8d98ce33..3b3a444ee24 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -368,6 +368,13 @@ This property can override the value of this variable." (defcustom repeat-keep-prefix nil "Whether to keep the prefix arg of the previous command when repeating." :type 'boolean + :initialize #'custom-initialize-default + :set (lambda (sym val) + (set-default sym val) + (when repeat-mode + (if repeat-keep-prefix + (add-hook 'pre-command-hook 'repeat-pre-hook) + (remove-hook 'pre-command-hook 'repeat-pre-hook)))) :group 'repeat :version "28.1") @@ -419,7 +426,11 @@ When Repeat mode is enabled, and the command symbol has the property named See `describe-repeat-maps' for a list of all repeatable commands." :global t :group 'repeat (if (not repeat-mode) - (remove-hook 'post-command-hook 'repeat-post-hook) + (progn + (remove-hook 'pre-command-hook 'repeat-pre-hook) + (remove-hook 'post-command-hook 'repeat-post-hook)) + (when repeat-keep-prefix + (add-hook 'pre-command-hook 'repeat-pre-hook)) (add-hook 'post-command-hook 'repeat-post-hook) (let* ((keymaps nil) (commands (all-completions @@ -431,15 +442,21 @@ See `describe-repeat-maps' for a list of all repeatable commands." (length commands) (length (delete-dups keymaps)))))) -(defvar repeat--prev-mb '(0) - "Previous minibuffer state.") - (defun repeat--command-property (property) (or (and (symbolp this-command) (get this-command property)) (and (symbolp real-this-command) (get real-this-command property)))) +(defun repeat-get-map () + "Return a transient map for keys repeatable after the current command." + (when repeat-mode + (let ((rep-map (or repeat-map (repeat--command-property 'repeat-map)))) + (when rep-map + (when (and (symbolp rep-map) (boundp rep-map)) + (setq rep-map (symbol-value rep-map))) + rep-map)))) + (defun repeat-check-key (key map) "Check if the last key is suitable to activate the repeating MAP." (let* ((prop (repeat--command-property 'repeat-check-key)) @@ -449,50 +466,61 @@ See `describe-repeat-maps' for a list of all repeatable commands." ;; Try without modifiers: (lookup-key map (vector (event-basic-type key)))))) +(defvar repeat--prev-mb '(0) + "Previous minibuffer state.") + +(defun repeat-check-map (map) + "Decides whether MAP can be used for the next command." + (and map + ;; Detect changes in the minibuffer state to allow repetitions + ;; in the same minibuffer, but not when the minibuffer is activated + ;; in the middle of repeating sequence (bug#47566). + (or (< (minibuffer-depth) (car repeat--prev-mb)) + (eq current-minibuffer-command (cdr repeat--prev-mb))) + (repeat-check-key last-command-event map) + t)) + +(defun repeat-pre-hook () + "Function run before commands to handle repeatable keys." + (when (and repeat-mode repeat-keep-prefix repeat-in-progress + (not prefix-arg) current-prefix-arg) + (let ((map (repeat-get-map))) + ;; Only when repeat-post-hook will activate the same map + (when (repeat-check-map map) + ;; Optimize to use less logic in the function `repeat-get-map' + ;; for the next call: when called again from `repeat-post-hook' + ;; it will use the variable `repeat-map'. + (setq repeat-map map) + ;; Preserve universal argument + (setq prefix-arg current-prefix-arg))))) + (defun repeat-post-hook () "Function run after commands to set transient keymap for repeatable keys." (let ((was-in-progress repeat-in-progress)) (setq repeat-in-progress nil) - (when repeat-mode - (let ((rep-map (or repeat-map (repeat--command-property 'repeat-map)))) - (when rep-map - (when (and (symbolp rep-map) (boundp rep-map)) - (setq rep-map (symbol-value rep-map))) - (let ((map (copy-keymap rep-map))) - - (when (and - ;; Detect changes in the minibuffer state to allow repetitions - ;; in the same minibuffer, but not when the minibuffer is activated - ;; in the middle of repeating sequence (bug#47566). - (or (< (minibuffer-depth) (car repeat--prev-mb)) - (eq current-minibuffer-command (cdr repeat--prev-mb))) - (or (not repeat-keep-prefix) prefix-arg) - (repeat-check-key last-command-event map)) - - ;; Messaging - (unless prefix-arg - (funcall repeat-echo-function map)) - - ;; Adding an exit key - (when repeat-exit-key - (define-key map (if (key-valid-p repeat-exit-key) - (kbd repeat-exit-key) - repeat-exit-key) - 'ignore)) - - (when (and repeat-keep-prefix (not prefix-arg)) - (setq prefix-arg current-prefix-arg)) - - (setq repeat-in-progress t) - (let ((exitfun (set-transient-map map))) - (repeat--exit) - (setq repeat-exit-function exitfun) - - (let* ((prop (repeat--command-property 'repeat-exit-timeout)) - (timeout (unless (eq prop 'no) (or prop repeat-exit-timeout)))) - (when timeout - (setq repeat-exit-timer - (run-with-idle-timer timeout nil #'repeat-exit)))))))))) + (let ((map (repeat-get-map))) + (when (repeat-check-map map) + ;; Messaging + (funcall repeat-echo-function map) + + ;; Adding an exit key + (when repeat-exit-key + (setq map (copy-keymap map)) + (define-key map (if (key-valid-p repeat-exit-key) + (kbd repeat-exit-key) + repeat-exit-key) + 'ignore)) + + (setq repeat-in-progress t) + (repeat--exit) + (let ((exitfun (set-transient-map map))) + (setq repeat-exit-function exitfun) + + (let* ((prop (repeat--command-property 'repeat-exit-timeout)) + (timeout (unless (eq prop 'no) (or prop repeat-exit-timeout)))) + (when timeout + (setq repeat-exit-timer + (run-with-idle-timer timeout nil #'repeat-exit))))))) (setq repeat-map nil) (setq repeat--prev-mb (cons (minibuffer-depth) current-minibuffer-command)) @@ -582,6 +610,7 @@ Used in `repeat-mode'." (push s (alist-get (get s 'repeat-map) keymaps))))) (with-help-window (help-buffer) (with-current-buffer standard-output + (setq-local outline-regexp "[*]+") (insert "A list of keymaps used by commands with the symbol property `repeat-map'.\n") (dolist (keymap (sort keymaps (lambda (a b) -- cgit v1.2.1 From 962bdfcdfe7e27687021c7dbaf0bb292afe9483c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 16 Dec 2022 11:28:20 -0700 Subject: vc-git-checkin: Offer to unstage conflicting changes * lisp/vc/vc-git.el (vc-git-checkin): When committing a patch, if conflicting changes are already staged, offer to clear them, instead of just immediately failing with "Index not empty" (bug#60126). --- lisp/vc/vc-git.el | 32 ++++++++++++++++++++------------ 1 file changed, 20 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 9f27f759d35..8f995021dcc 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1030,23 +1030,31 @@ It is based on `log-edit-mode', and has Git-specific extensions." (with-temp-buffer (vc-git-command (current-buffer) t nil "diff" "--cached") (goto-char (point-min)) - (let ((pos (point)) file-diff file-beg) + (let ((pos (point)) file-name file-diff file-beg) (while (not (eobp)) + (when (and (looking-at "^diff --git a/\\(.+\\) b/\\(.+\\)") + (string= (match-string 1) (match-string 2))) + (setq file-name (match-string 1))) (forward-line 1) ; skip current "diff --git" line (search-forward "diff --git" nil 'move) (move-beginning-of-line 1) (setq file-diff (buffer-substring pos (point))) - (if (and (setq file-beg (string-search - file-diff vc-git-patch-string)) - ;; Check that file diff ends with an empty string - ;; or the beginning of the next file diff. - (string-match-p "\\`\\'\\|\\`diff --git" - (substring - vc-git-patch-string - (+ file-beg (length file-diff))))) - (setq vc-git-patch-string - (string-replace file-diff "" vc-git-patch-string)) - (user-error "Index not empty")) + (cond ((and (setq file-beg (string-search + file-diff vc-git-patch-string)) + ;; Check that file diff ends with an empty string + ;; or the beginning of the next file diff. + (string-match-p "\\`\\'\\|\\`diff --git" + (substring + vc-git-patch-string + (+ file-beg (length file-diff))))) + (setq vc-git-patch-string + (string-replace file-diff "" vc-git-patch-string))) + ((and file-name + (yes-or-no-p + (format "Unstage already-staged changes to %s?" + file-name))) + (vc-git-command nil 0 file-name "reset" "-q" "--")) + (t (user-error "Index not empty"))) (setq pos (point)))))) (let ((patch-file (make-nearby-temp-file "git-patch"))) (with-temp-file patch-file -- cgit v1.2.1 From 1424342225ef5b18c630364dd88e004f4ebb1c7f Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 20 Dec 2022 15:53:19 -0700 Subject: vc-git-checkin: Don't try to apply an empty patch * lisp/vc/vc-git.el (vc-git-checkin): Don't try to apply an empty patch to the index, because in that case 'git apply' fails. --- lisp/vc/vc-git.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 8f995021dcc..0a4e9caa614 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1056,12 +1056,13 @@ It is based on `log-edit-mode', and has Git-specific extensions." (vc-git-command nil 0 file-name "reset" "-q" "--")) (t (user-error "Index not empty"))) (setq pos (point)))))) - (let ((patch-file (make-nearby-temp-file "git-patch"))) - (with-temp-file patch-file - (insert vc-git-patch-string)) - (unwind-protect - (vc-git-command nil 0 patch-file "apply" "--cached") - (delete-file patch-file)))) + (unless (string-empty-p vc-git-patch-string) + (let ((patch-file (make-nearby-temp-file "git-patch"))) + (with-temp-file patch-file + (insert vc-git-patch-string)) + (unwind-protect + (vc-git-command nil 0 patch-file "apply" "--cached") + (delete-file patch-file))))) (cl-flet ((boolean-arg-fn (argument) (lambda (value) (when (equal value "yes") (list argument))))) -- cgit v1.2.1 From 6d9f367ead32c688bcfc6a0366073dff6740099c Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 19 Dec 2022 17:54:12 -0800 Subject: ; * lisp/treesit.el (treesit-simple-indent-presets): Fix typo. --- lisp/treesit.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 82757d298e8..64076691186 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1183,7 +1183,7 @@ no-node \(n-p-gp NODE-TYPE PARENT-TYPE GRANDPARENT-TYPE) - Checks that NODE, its parent, and its grandparent's type. + Checks for NODE's, its parent's, and its grandparent's type. \(query QUERY) -- cgit v1.2.1 From 12b2b8864c295ce27594e8a907ebb3423e58a9d4 Mon Sep 17 00:00:00 2001 From: "Charl P. Botha" Date: Sat, 10 Dec 2022 19:09:38 +0200 Subject: Fix empty pairs in js tree-sitter imenu alist (bug#59945) The current js--treesit-imenu, used by the JavaScript, TypeScript and TSX tree-sitter modes, would return empty pairs in the imenu alist if there were none of that type of symbol. This would break both the built in imenu and also packages like consult-imenu. See https://github.com/minad/consult/issues/697 for the discussion there. * lisp/progmodes/js.el (js--treesit-imenu): Don't add nil indexes. Copyright-paperwork-exempt: yes --- lisp/progmodes/js.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 8c1ee495c2d..1b34c0de418 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3738,9 +3738,14 @@ definition*\"." node "function_declaration" nil 1000)) (var-tree (treesit-induce-sparse-tree node "lexical_declaration" nil 1000))) - `(("Class" . ,(js--treesit-imenu-1 class-tree)) - ("Variable" . ,(js--treesit-imenu-1 var-tree)) - ("Function" . ,(js--treesit-imenu-1 func-tree))))) + ;; When a sub-tree is empty, we should not return that pair at all. + (append + (and func-tree + `(("Function" . ,(js--treesit-imenu-1 func-tree)))) + (and var-tree + `(("Variable" . ,(js--treesit-imenu-1 var-tree)))) + (and class-tree + `(("Class" . ,(js--treesit-imenu-1 class-tree))))))) ;;; Main Function -- cgit v1.2.1 From c2f04019bff4085a09a993995ab8a9d71484dcb0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 21 Dec 2022 12:05:08 +0100 Subject: soap-client: fix validation against byte[] * lisp/net/soap-client.el (soap-validate-xs-basic-type): `byte[]` is read as the two Lisp values `byte` and `[]` but here the symbol `byte[]` is intended: the brackets need escaping. --- lisp/net/soap-client.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 5e7bdbe6c6a..6e9200e4656 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -1317,7 +1317,7 @@ See also `soap-wsdl-resolve-references'." "Validate VALUE against the basic type TYPE." (let* ((kind (soap-xs-basic-type-kind type))) (cl-case kind - ((anyType Array byte[]) + ((anyType Array byte\[\]) value) (t (let ((convert (get kind 'rng-xsd-convert))) -- cgit v1.2.1 From ad5a67996ddf23df904c09165475759e2e0a68b1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 21 Dec 2022 12:33:25 +0100 Subject: Fix broken eww desktop restore reload prompt message insertion * lisp/net/eww.el (eww-restore-desktop): Repair a malformed `cl-case` clause. This code probably never worked as intended. --- lisp/net/eww.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 3799ef96e84..a8a985b8dea 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -2498,10 +2498,10 @@ Otherwise, the restored buffer will contain a prompt to do so by using (when (plist-get eww-data :url) (cl-case eww-restore-desktop ((t auto) (eww (plist-get eww-data :url))) - ((zerop (buffer-size)) - (let ((inhibit-read-only t)) - (insert (substitute-command-keys - eww-restore-reload-prompt))))))) + ((nil) (when (zerop (buffer-size)) + (let ((inhibit-read-only t)) + (insert (substitute-command-keys + eww-restore-reload-prompt)))))))) ;; . (current-buffer))) -- cgit v1.2.1 From d76d7a3bebf1ff0b06a38f7f96d316752844ed10 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Tue, 13 Dec 2022 01:33:43 -0500 Subject: whitespace: Avoid mutating original buffer's markers in clones * lisp/whitespace.el (whitespace--clone): New hook function that is run after cloning a buffer that copies `whitespace-bob-marker' and `whitespace-eob-marker' and changes the copies to point to the new buffer (Bug#59618). (whitespace-color-on): Register the hook function. (whitespace-color-off): Unregister the hook function. * test/lisp/whitespace-tests.el (whitespace-tests--with-test-buffer): New macro. (whitespace-tests--check-markers): New function. (whitespace-tests--indirect-clone-breaks-base-markers) (whitespace-tests--indirect-clone-markers) (whitespace-tests--regular-clone-markers): New tests. --- lisp/whitespace.el | 15 +++++++++++++++ 1 file changed, 15 insertions(+) (limited to 'lisp') diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 9bc6ad9db46..558be1841ab 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -2093,6 +2093,17 @@ resultant list will be returned." t)) +(defun whitespace--clone () + "Hook function run after `make-indirect-buffer' and `clone-buffer'." + (when (whitespace-style-face-p) + (setq-local whitespace-bob-marker + (copy-marker (marker-position whitespace-bob-marker) + (marker-insertion-type whitespace-bob-marker))) + (setq-local whitespace-eob-marker + (copy-marker (marker-position whitespace-eob-marker) + (marker-insertion-type whitespace-eob-marker))))) + + (defun whitespace-color-on () "Turn on color visualization." (when (whitespace-style-face-p) @@ -2111,6 +2122,8 @@ resultant list will be returned." ;; The -1 ensures that it runs before any ;; `font-lock-mode' hook functions. -1 t) + (add-hook 'clone-buffer-hook #'whitespace--clone nil t) + (add-hook 'clone-indirect-buffer-hook #'whitespace--clone nil t) ;; Add whitespace-mode color into font lock. (setq whitespace-font-lock-keywords @@ -2204,6 +2217,8 @@ resultant list will be returned." (remove-hook 'before-change-functions #'whitespace-buffer-changed t) (remove-hook 'after-change-functions #'whitespace--update-bob-eob t) + (remove-hook 'clone-buffer-hook #'whitespace--clone t) + (remove-hook 'clone-indirect-buffer-hook #'whitespace--clone t) (font-lock-remove-keywords nil whitespace-font-lock-keywords) (font-lock-flush))) -- cgit v1.2.1 From 98c16a8c8838f068b9930d37d747ed2a357ba1c2 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 21 Dec 2022 19:30:24 +0200 Subject: ; * lisp/tab-bar.el: Remaining renaming of "fixed-width" to "auto-width". --- lisp/tab-bar.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index f040bc9786d..a4779af04aa 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1021,7 +1021,7 @@ This variable has effect only when `tab-bar-auto-width' is non-nil." :initialize 'custom-initialize-default :set (lambda (sym val) (set-default sym val) - (setq tab-bar--fixed-width-hash nil)) + (setq tab-bar--auto-width-hash nil)) :group 'tab-bar :version "29.1") @@ -1040,17 +1040,17 @@ tab bar might wrap to the second line when it shouldn't.") tab-bar-tab-group-inactive) "Resize tabs only with these faces.") -(defvar tab-bar--fixed-width-hash nil +(defvar tab-bar--auto-width-hash nil "Memoization table for `tab-bar-auto-width'.") (defun tab-bar-auto-width (items) "Return tab-bar items with resized tab names." - (unless tab-bar--fixed-width-hash - (define-hash-table-test 'tab-bar--fixed-width-hash-test + (unless tab-bar--auto-width-hash + (define-hash-table-test 'tab-bar--auto-width-hash-test #'equal-including-properties #'sxhash-equal-including-properties) - (setq tab-bar--fixed-width-hash - (make-hash-table :test 'tab-bar--fixed-width-hash-test))) + (setq tab-bar--auto-width-hash + (make-hash-table :test 'tab-bar--auto-width-hash-test))) (let ((tabs nil) ;; list of resizable tabs (non-tabs "") ;; concatenated names of non-resizable tabs (width 0)) ;; resize tab names to this width @@ -1078,7 +1078,7 @@ tab bar might wrap to the second line when it shouldn't.") (setf (nth 2 item) (with-memoization (gethash (list (selected-frame) width (nth 2 item)) - tab-bar--fixed-width-hash) + tab-bar--auto-width-hash) (let* ((name (nth 2 item)) (len (length name)) (close-p (get-text-property (1- len) 'close-tab name)) -- cgit v1.2.1 From f35da111990e17eea84febcff35763c40d3e393a Mon Sep 17 00:00:00 2001 From: Alexander Adolf Date: Wed, 21 Dec 2022 12:32:36 -0500 Subject: message: Do not default to eudc-capf-complete yet * lisp/gnus/message.el (message-mode): No longer add eudc-capf-complete to the buffer-local value of completion-at-point-functions. (Bug#59314) --- lisp/gnus/message.el | 1 - 1 file changed, 1 deletion(-) (limited to 'lisp') diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index e7d11b597b3..6c10a4ae976 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -3191,7 +3191,6 @@ Like `text-mode', but with these additional commands: (mail-abbrevs-setup)) ((message-mail-alias-type-p 'ecomplete) (ecomplete-setup))) - (add-hook 'completion-at-point-functions #'eudc-capf-complete -1 t) (add-hook 'completion-at-point-functions #'message-completion-function nil t) (unless buffer-file-name (message-set-auto-save-file-name)) -- cgit v1.2.1 From 777b383dd0f61488ba4e43756cf43521f994f906 Mon Sep 17 00:00:00 2001 From: montag451 Date: Wed, 21 Dec 2022 14:21:20 -0800 Subject: Fix Eshell electric slash when used from the root directory of a remote host * lisp/eshell/em-elecslash.el (eshell-electric-forward-slash): Insert the remote prefix as determined by 'file-remote-p'. Copyright-paperwork-exempt: Yes --- lisp/eshell/em-elecslash.el | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/em-elecslash.el b/lisp/eshell/em-elecslash.el index 091acb9a861..0ce3a4cc963 100644 --- a/lisp/eshell/em-elecslash.el +++ b/lisp/eshell/em-elecslash.el @@ -74,8 +74,9 @@ insertion." (command (save-excursion (eshell-bol) (skip-syntax-forward " ") - (thing-at-point 'sexp)))) - (if (and (file-remote-p default-directory) + (thing-at-point 'sexp))) + (prefix (file-remote-p default-directory))) + (if (and prefix ;; We can't formally parse the input. But if there is ;; one of these operators behind us, then looking at ;; the first command would not be sensible. So be @@ -93,14 +94,9 @@ insertion." (or eshell-prefer-lisp-functions (not (eshell-search-path command)))))))) (let ((map (make-sparse-keymap)) - (start (if tilde-before (1- (point)) (point))) - (localname - (tramp-file-name-localname - (tramp-dissect-file-name default-directory)))) + (start (if tilde-before (1- (point)) (point)))) (when tilde-before (delete-char -1)) - (insert - (substring default-directory 0 - (string-search localname default-directory))) + (insert prefix) (unless tilde-before (insert "/")) ;; Typing a second slash undoes the insertion, for when ;; you really do want to type a local absolute file name. -- cgit v1.2.1 From e59216d3be86918b995bd63273c851ebc6176a83 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 21 Dec 2022 23:26:52 +0100 Subject: * Invoke spawed Emacs processes with '-Q' when native compiling (bug#60208) * lisp/emacs-lisp/comp.el (comp-final): Invoke spawned Emacs with '-Q'. (comp-run-async-workers): Likewise. --- lisp/emacs-lisp/comp.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2c306d892c7..7fec370d474 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3716,7 +3716,7 @@ Prepare every function for final compilation and drive the C back-end." (if (zerop (call-process (expand-file-name invocation-name invocation-directory) - nil t t "-no-comp-spawn" "--batch" "-l" + nil t t "-no-comp-spawn" "-Q" "--batch" "-l" temp-file)) (progn (delete-file temp-file) @@ -4005,7 +4005,7 @@ display a message." :command (list (expand-file-name invocation-name invocation-directory) - "-no-comp-spawn" "--batch" + "-no-comp-spawn" "-Q" "--batch" "--eval" ;; Suppress Abort dialogs on MS-Windows "(setq w32-disable-abort-dialog t)" -- cgit v1.2.1 From d6c8d5dbc9fc4786e91b76654058e904c96f0e11 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 20 Dec 2022 16:20:50 -0800 Subject: When redirecting in Eshell, check for "/dev/null" specifically This is so that users can type "cmd ... > /dev/null" in Eshell no matter what their system's null device is called. (Users can still use their system's null device name when redirecting, too. Eshell doesn't need to do anything special to support that.) This partially reverts 67a8bdb90c9b5865b7f17290c7135b1a5458c36d. See bug#59545. Do not merge to master. * lisp/eshell/esh-io.el (eshell-set-output-handle): Use "/dev/null" literally. --- lisp/eshell/esh-io.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 4620565f857..d223be680f9 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -342,7 +342,11 @@ If HANDLES is nil, use `eshell-current-handles'." (when target (let ((handles (or handles eshell-current-handles))) (if (and (stringp target) - (string= target (null-device))) + ;; The literal string "/dev/null" is intentional here. + ;; It just provides compatibility so that users can + ;; redirect to "/dev/null" no matter the actual value + ;; of `null-device'. + (string= target "/dev/null")) (aset handles index nil) (let ((where (eshell-get-target target mode)) (current (car (aref handles index)))) -- cgit v1.2.1 From 05d8310fb5ddb35c2566c2b50ca07e86edf3c670 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 22 Dec 2022 10:03:09 +0200 Subject: Use the new keyword ':repeat' in repeatable keymaps. * lisp/bindings.el (undo-repeat-map) (buffer-navigation-repeat-map, next-error-repeat-map) (page-navigation-repeat-map): * lisp/comint.el (comint-repeat-map): * lisp/dired.el (dired-jump-map): * lisp/outline.el (outline-navigation-repeat-map) (outline-editing-repeat-map): * lisp/shell.el (shell-repeat-map): * lisp/tab-bar.el (tab-bar-switch-repeat-map) (tab-bar-move-repeat-map): * lisp/window.el (other-window-repeat-map) (resize-window-repeat-map): * lisp/winner.el (winner-repeat-map): * lisp/eshell/em-prompt.el (eshell-prompt-repeat-map): * lisp/eshell/esh-mode.el (eshell-command-repeat-map): Add the keyword ':repeat' to 'defvar-keymap' instead of setting the symbol property 'repeat-map' explicitly. * lisp/keymap.el (defvar-keymap): Check for 'props' that is used in 'defvar-form'. --- lisp/bindings.el | 13 ++++--------- lisp/comint.el | 4 +--- lisp/dired.el | 2 +- lisp/eshell/em-prompt.el | 4 +--- lisp/eshell/esh-mode.el | 4 +--- lisp/keymap.el | 2 +- lisp/outline.el | 15 ++------------- lisp/shell.el | 4 +--- lisp/tab-bar.el | 6 ++---- lisp/window.el | 7 ++----- lisp/winner.el | 4 +--- 11 files changed, 17 insertions(+), 48 deletions(-) (limited to 'lisp') diff --git a/lisp/bindings.el b/lisp/bindings.el index c1ad5f7520e..c298a43952f 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1010,8 +1010,8 @@ if `inhibit-field-text-motion' is non-nil." ;; (define-key ctl-x-map "U" 'undo-only) (defvar-keymap undo-repeat-map :doc "Keymap to repeat undo key sequences \\`C-x u u'. Used in `repeat-mode'." + :repeat t "u" #'undo) -(put 'undo 'repeat-map 'undo-repeat-map) (define-key global-map '[(control ??)] 'undo-redo) (define-key global-map [?\C-\M-_] 'undo-redo) @@ -1031,12 +1031,10 @@ if `inhibit-field-text-motion' is non-nil." (defvar-keymap buffer-navigation-repeat-map :doc "Keymap to repeat `next-buffer' and `previous-buffer'. Used in `repeat-mode'." + :repeat t "" #'next-buffer "" #'previous-buffer) -(put 'next-buffer 'repeat-map 'buffer-navigation-repeat-map) -(put 'previous-buffer 'repeat-map 'buffer-navigation-repeat-map) - (let ((map minibuffer-local-map)) (define-key map "\en" 'next-history-element) (define-key map [next] 'next-history-element) @@ -1109,12 +1107,11 @@ if `inhibit-field-text-motion' is non-nil." (defvar-keymap next-error-repeat-map :doc "Keymap to repeat `next-error' key sequences. Used in `repeat-mode'." + :repeat t "n" #'next-error "M-n" #'next-error "p" #'previous-error "M-p" #'previous-error) -(put 'next-error 'repeat-map 'next-error-repeat-map) -(put 'previous-error 'repeat-map 'next-error-repeat-map) (defvar-keymap goto-map :doc "Keymap for navigation commands." @@ -1472,12 +1469,10 @@ if `inhibit-field-text-motion' is non-nil." (defvar-keymap page-navigation-repeat-map :doc "Keymap to repeat page navigation key sequences. Used in `repeat-mode'." + :repeat t "]" #'forward-page "[" #'backward-page) -(put 'forward-page 'repeat-map 'page-navigation-repeat-map) -(put 'backward-page 'repeat-map 'page-navigation-repeat-map) - (define-key ctl-x-map "\C-p" 'mark-page) (define-key ctl-x-map "l" 'count-lines-page) (define-key ctl-x-map "np" 'narrow-to-page) diff --git a/lisp/comint.el b/lisp/comint.el index f0bb8da4355..fd0e06a3612 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -606,12 +606,10 @@ via PTYs.") (defvar-keymap comint-repeat-map :doc "Keymap to repeat comint key sequences. Used in `repeat-mode'." + :repeat t "C-n" #'comint-next-prompt "C-p" #'comint-previous-prompt) -(put #'comint-next-prompt 'repeat-map 'comint-repeat-map) -(put #'comint-previous-prompt 'repeat-map 'comint-repeat-map) - ;; Fixme: Is this still relevant? (defvar comint-ptyp t "Non-nil if communications via pty; false if by pipe. Buffer local. diff --git a/lisp/dired.el b/lisp/dired.el index 81e62f88cf1..f5d1b90abf4 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4882,9 +4882,9 @@ Interactively with prefix argument, read FILE-NAME." (defvar-keymap dired-jump-map :doc "Keymap to repeat `dired-jump'. Used in `repeat-mode'." + :repeat t "j" #'dired-jump "C-j" #'dired-jump) -(put 'dired-jump 'repeat-map 'dired-jump-map) ;;; Miscellaneous commands diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index a8744de1dba..abb123bcff2 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -102,12 +102,10 @@ arriving, or after." (defvar-keymap eshell-prompt-repeat-map :doc "Keymap to repeat eshell-prompt key sequences. Used in `repeat-mode'." + :repeat t "C-n" #'eshell-next-prompt "C-p" #'eshell-previous-prompt) -(put #'eshell-next-prompt 'repeat-map 'eshell-prompt-repeat-map) -(put #'eshell-previous-prompt 'repeat-map 'eshell-prompt-repeat-map) - ;;; Functions: (define-minor-mode eshell-prompt-mode diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 4357a0e29a0..b3db0f6af45 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -282,12 +282,10 @@ This is used by `eshell-watch-for-password-prompt'." (defvar-keymap eshell-command-repeat-map :doc "Keymap to repeat eshell-command key sequences. Used in `repeat-mode'." + :repeat t "C-f" #'eshell-forward-argument "C-b" #'eshell-backward-argument) -(put #'eshell-forward-argument 'repeat-map 'eshell-command-repeat-map) -(put #'eshell-backward-argument 'repeat-map 'eshell-command-repeat-map) - ;;; User Functions: (defun eshell-kill-buffer-function () diff --git a/lisp/keymap.el b/lisp/keymap.el index b355f68aa2f..e93e3c5f3bc 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -625,7 +625,7 @@ command exists in this specific map, but it doesn't have the `(defvar ,variable-name (define-keymap ,@(nreverse opts) ,@defs) ,@(and doc (list doc))))) - (if repeat + (if props `(progn ,defvar-form ,@(nreverse props)) diff --git a/lisp/outline.el b/lisp/outline.el index 53bfc4d556f..c2b33b4c58f 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -1868,6 +1868,7 @@ With a prefix argument, show headings up to that LEVEL." (defvar-keymap outline-navigation-repeat-map + :repeat t "C-b" #'outline-backward-same-level "b" #'outline-backward-same-level "C-f" #'outline-forward-same-level @@ -1879,14 +1880,8 @@ With a prefix argument, show headings up to that LEVEL." "C-u" #'outline-up-heading "u" #'outline-up-heading) -(dolist (command '(outline-backward-same-level - outline-forward-same-level - outline-next-visible-heading - outline-previous-visible-heading - outline-up-heading)) - (put command 'repeat-map 'outline-navigation-repeat-map)) - (defvar-keymap outline-editing-repeat-map + :repeat t "C-v" #'outline-move-subtree-down "v" #'outline-move-subtree-down "C-^" #'outline-move-subtree-up @@ -1896,12 +1891,6 @@ With a prefix argument, show headings up to that LEVEL." "C-<" #'outline-promote "<" #'outline-promote) -(dolist (command '(outline-move-subtree-down - outline-move-subtree-up - outline-demote - outline-promote)) - (put command 'repeat-map 'outline-editing-repeat-map)) - (provide 'outline) (provide 'noutline) diff --git a/lisp/shell.el b/lisp/shell.el index dadbdcbc034..727f2aa0dd7 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -395,12 +395,10 @@ Useful for shells like zsh that has this feature." (defvar-keymap shell-repeat-map :doc "Keymap to repeat shell key sequences. Used in `repeat-mode'." + :repeat t "C-f" #'shell-forward-command "C-b" #'shell-backward-command) -(put #'shell-forward-command 'repeat-map 'shell-repeat-map) -(put #'shell-backward-command 'repeat-map 'shell-repeat-map) - (defcustom shell-mode-hook '() "Hook for customizing Shell mode." :type 'hook diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index a4779af04aa..114294615b4 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -2626,18 +2626,16 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (defvar-keymap tab-bar-switch-repeat-map :doc "Keymap to repeat tab switch key sequences \\`C-x t o o O'. Used in `repeat-mode'." + :repeat t "o" #'tab-next "O" #'tab-previous) -(put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map) -(put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map) (defvar-keymap tab-bar-move-repeat-map :doc "Keymap to repeat tab move key sequences \\`C-x t m m M'. Used in `repeat-mode'." + :repeat t "m" #'tab-move "M" #'tab-bar-move-tab-backward) -(put 'tab-move 'repeat-map 'tab-bar-move-repeat-map) -(put 'tab-bar-move-tab-backward 'repeat-map 'tab-bar-move-repeat-map) (provide 'tab-bar) diff --git a/lisp/window.el b/lisp/window.el index a4a84218818..5dd5b808831 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -10561,26 +10561,23 @@ displaying that processes's buffer." (defvar-keymap other-window-repeat-map :doc "Keymap to repeat `other-window' key sequences. Used in `repeat-mode'." + :repeat t "o" #'other-window "O" (lambda () (interactive) (setq repeat-map 'other-window-repeat-map) (other-window -1))) -(put 'other-window 'repeat-map 'other-window-repeat-map) (defvar-keymap resize-window-repeat-map :doc "Keymap to repeat window resizing commands. Used in `repeat-mode'." + :repeat t ;; Standard keys: "^" #'enlarge-window "}" #'enlarge-window-horizontally "{" #'shrink-window-horizontally ;; Additional keys: "v" #'shrink-window) -(put 'enlarge-window 'repeat-map 'resize-window-repeat-map) -(put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map) -(put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map) -(put 'shrink-window 'repeat-map 'resize-window-repeat-map) (defvar-keymap window-prefix-map :doc "Keymap for subcommands of \\`C-x w'." diff --git a/lisp/winner.el b/lisp/winner.el index c8354b18bec..aed57aa0371 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -330,12 +330,10 @@ You may want to include buffer names such as *Help*, *Apropos*, (defvar-keymap winner-repeat-map :doc "Keymap to repeat winner key sequences. Used in `repeat-mode'." + :repeat t "" #'winner-undo "" #'winner-redo) -(put #'winner-undo 'repeat-map 'winner-repeat-map) -(put #'winner-redo 'repeat-map 'winner-repeat-map) - ;;;###autoload (define-minor-mode winner-mode -- cgit v1.2.1 From 69123d4aa4e8a116d4fe328146af5829f3790fc7 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Tue, 20 Dec 2022 21:21:48 -0800 Subject: ; Fix treesit--defuns-around Now it doesn't move point. * lisp/treesit.el (treesit--defuns-around): Wrap some code with save-excursion. --- lisp/treesit.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 64076691186..e4f3698dcd9 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1657,10 +1657,13 @@ REGEXP and PRED are the same as in `treesit-defun-type-regexp'." ;; defun, in that case we want to use a node that's actually ;; before/after point. (node-before (if (>= (treesit-node-start node) pos) - (treesit-search-forward-goto node "" t t t) + (save-excursion + (treesit-search-forward-goto node "" t t t)) node)) (node-after (if (<= (treesit-node-end node) pos) - (treesit-search-forward-goto node "" nil nil t) + (save-excursion + (treesit-search-forward-goto + node "" nil nil t)) node)) (result (list nil nil nil)) (pred (or pred (lambda (_) t)))) -- cgit v1.2.1 From 7dea58b88db3e272e01e537a3a5d2158ef7f9608 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Tue, 20 Dec 2022 21:22:30 -0800 Subject: Add treesit-defun-at-point and fix c-ts-mode-indent-defun * lisp/treesit.el (treesit-defun-at-point): New function. * lisp/progmodes/c-ts-mode.el (c-ts-mode-indent-defun): Implement with treesit-defun-at-point. --- lisp/progmodes/c-ts-mode.el | 11 ++++------- lisp/treesit.el | 23 +++++++++++++++++++++++ 2 files changed, 27 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 8ed1a77637a..ea9891f3345 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -556,13 +556,10 @@ the semicolon. This function skips the semicolon." `treesit-defun-type-regexp' defines what constructs to indent." (interactive "*") - (let ((orig-point (point-marker))) - ;; If `treesit-beginning-of-defun' returns nil, we are not in a - ;; defun, so don't indent anything. - (when (treesit-beginning-of-defun) - (let ((start (point))) - (treesit-end-of-defun) - (indent-region start (point)))) + (when-let ((orig-point (point-marker)) + (node (treesit-defun-at-point))) + (indent-region (treesit-node-start node) + (treesit-node-end node)) (goto-char orig-point))) (defvar-keymap c-ts-mode-map diff --git a/lisp/treesit.el b/lisp/treesit.el index e4f3698dcd9..a7882dda2cc 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1834,6 +1834,29 @@ function is called recursively." ;; Counter equal to 0 means we successfully stepped ARG steps. (if (eq counter 0) pos nil))) +;; TODO: In corporate into thing-at-point. +(defun treesit-defun-at-point () + "Return the defun at point or nil if none is found. + +Respects `treesit-defun-tactic': return the top-level defun if it +is `top-level', return the immediate parent defun if it is +`nested'." + (pcase-let* ((`(,regexp . ,pred) + (if (consp treesit-defun-type-regexp) + treesit-defun-type-regexp + (cons treesit-defun-type-regexp nil))) + (`(,_ ,next ,parent) + (treesit--defuns-around (point) regexp pred)) + ;; If point is at the beginning of a defun, we + ;; prioritize that defun over the parent in nested + ;; mode. + (node (or (and (eq (treesit-node-start next) (point)) + next) + parent))) + (if (eq treesit-defun-tactic 'top-level) + (treesit--top-level-defun node regexp pred) + node))) + ;;; Activating tree-sitter (defun treesit-ready-p (language &optional quiet) -- cgit v1.2.1 From 02e046566e2c70cf268f359ef29802268ab43de1 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Thu, 22 Dec 2022 00:41:58 -0800 Subject: Set beginning/end-of-defun-function in treesit-major-mode-setup * lisp/treesit.el (treesit-major-mode-setup): Set them. --- lisp/treesit.el | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index a7882dda2cc..ec5b3e399f9 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1941,7 +1941,16 @@ before calling this function." (keymap-set (current-local-map) " " #'treesit-beginning-of-defun) (keymap-set (current-local-map) " " - #'treesit-end-of-defun))) + #'treesit-end-of-defun) + ;; `end-of-defun' will not work completely correctly in nested + ;; defuns due to its implementation. However, many lisp programs + ;; use `beginning/end-of-defun', so we should still set + ;; `beginning/end-of-defun-function' so they still mostly work. + ;; This is also what `cc-mode' does: rebind user commands and set + ;; the variables. In future we should update `end-of-defun' to + ;; work with nested defuns. + (setq-local beginning-of-defun-function #'treesit-beginning-of-defun) + (setq-local end-of-defun-function #'treesit-end-of-defun))) ;;; Debugging -- cgit v1.2.1 From a488a6870acc6df67cc6790a756c5d45f21d7b85 Mon Sep 17 00:00:00 2001 From: Benson Chu Date: Wed, 21 Dec 2022 17:41:32 -0600 Subject: Add alias for removed font-lock function As part of 18947103fabf8070738b3bd9c5a8d02f90988a3d, `font-lock-fontify-syntactically-region' was renamed to `font-lock-default-fontify-sytactically'. * lisp/font-lock.el (font-lock-fontify-syntactically-region): Add obsolete alias for the renamed function. Copyright-paperwork-exempt: yes --- lisp/font-lock.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/font-lock.el b/lisp/font-lock.el index bf9a179d6ae..2dfbe3ad232 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -2361,6 +2361,7 @@ in which C preprocessor directives are used, e.g. `asm-mode' and (define-obsolete-function-alias 'font-lock-after-fontify-buffer #'ignore "29.1") (define-obsolete-function-alias 'font-lock-after-unfontify-buffer #'ignore "29.1") +(define-obsolete-function-alias 'font-lock-fontify-syntactically-region #'font-lock-default-fontify-syntactically "29.1") (provide 'font-lock) -- cgit v1.2.1 From bbe35c280c2bf9fb2fd9b6e33b2950b8fae67e2c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 22 Dec 2022 11:29:49 +0000 Subject: Prevent stale servers when using eglot-extend-to-xref A weak-valued hash-table is not enough to guarantee that a reference to a zombie server in eglot--servers-by-xrefed-file variable won't survive long enough to confuse the next call to eglot--current-server in some buffers. So, before this fix it was common to get "Process EGLOT ... not running" errors if some xref-extended buffers (like system libraries) were open and M-x eglot-reconnect was issued. This should be prevented now. Note however, that even after this the eglot-extend-to-xref logic is still flawed. For example, if a buffer for the xref-extended buffer happens to be already visited by the time M-. is issued to navigate to it, Eglot won't be activated. A half-decent workaround is to kill the buffer and re-visit it. * lisp/progmodes/eglot.el (eglot--servers-by-xrefed-file): Move up. (eglot--on-shutdown): Make sure to cleanup eglot--servers-by-xrefed-file. --- lisp/progmodes/eglot.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 0f1bfd0447d..e7782ea8112 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -908,6 +908,9 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see." do (with-demoted-errors "[eglot] shutdown all: %s" (cl-loop for s in ss do (eglot-shutdown s nil nil preserve-buffers))))) +(defvar eglot--servers-by-xrefed-file + (make-hash-table :test 'equal :weakness 'value)) + (defun eglot--on-shutdown (server) "Called by jsonrpc.el when SERVER is already dead." ;; Turn off `eglot--managed-mode' where appropriate. @@ -926,6 +929,9 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see." (setf (gethash (eglot--project server) eglot--servers-by-project) (delq server (gethash (eglot--project server) eglot--servers-by-project))) + (maphash (lambda (f s) + (when (eq s server) (remhash f eglot--servers-by-xrefed-file))) + eglot--servers-by-xrefed-file) (cond ((eglot--shutdown-requested server) t) ((not (eglot--inhibit-autoreconnect server)) @@ -1057,9 +1063,6 @@ be guessed." (put 'eglot-lsp-context 'variable-documentation "Dynamically non-nil when searching for projects in LSP context.") -(defvar eglot--servers-by-xrefed-file - (make-hash-table :test 'equal :weakness 'value)) - (defun eglot--current-project () "Return a project object for Eglot's LSP purposes. This relies on `project-current' and thus on -- cgit v1.2.1 From 014232d3840e9d7249fe28636935b7166b85e675 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 22 Dec 2022 15:44:11 +0000 Subject: Eglot: eglot--servers-by-xrefed-file doesn't need to be value-weak * lisp/progmodes/eglot.el (eglot--servers-by-xrefed-file): Doesn't need to be weak. --- lisp/progmodes/eglot.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index e7782ea8112..15cb1b6fad0 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -908,8 +908,7 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see." do (with-demoted-errors "[eglot] shutdown all: %s" (cl-loop for s in ss do (eglot-shutdown s nil nil preserve-buffers))))) -(defvar eglot--servers-by-xrefed-file - (make-hash-table :test 'equal :weakness 'value)) +(defvar eglot--servers-by-xrefed-file (make-hash-table :test 'equal)) (defun eglot--on-shutdown (server) "Called by jsonrpc.el when SERVER is already dead." -- cgit v1.2.1 From 86b11981b0d49917c3185b0b1d4ca95afc85dfcf Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 22 Dec 2022 16:46:00 +0100 Subject: Update Tramp version (don't merge with master) * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.6.0.29.1". (customize-package-emacs-version-alist): Adapt Tramp version integrated in Emacs 29.1. --- lisp/net/trampver.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index caf6750c26d..49caadc93ab 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.6.0-pre +;; Version: 2.6.0.29.1 ;; Package-Requires: ((emacs "26.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.6.0-pre" +(defconst tramp-version "2.6.0.29.1" "This version of Tramp.") ;;;###tramp-autoload @@ -78,7 +78,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "26.1")) "ok" - (format "Tramp 2.6.0-pre is not fit for %s" + (format "Tramp 2.6.0.29.1 is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) @@ -104,7 +104,8 @@ ("2.3.3" . "26.1") ("2.3.3.26.1" . "26.1") ("2.3.5.26.2" . "26.2") ("2.3.5.26.3" . "26.3") ("2.4.3.27.1" . "27.1") ("2.4.5.27.2" . "27.2") - ("2.5.2.28.1" . "28.1") ("2.5.3.28.2" . "28.2"))) + ("2.5.2.28.1" . "28.1") ("2.5.3.28.2" . "28.2") + ("2.6.0.29.1" . "29.1"))) (add-hook 'tramp-unload-hook (lambda () -- cgit v1.2.1 From 0754173c923a1888a1b18b4c6c5d1dc72e6cc6af Mon Sep 17 00:00:00 2001 From: Ikumi Keita Date: Thu, 22 Dec 2022 18:23:34 +0100 Subject: ; Fix docstring * lisp/textmodes/reftex-vars.el (reftex-allow-detached-macro-args): Fix macro name in docstring. --- lisp/textmodes/reftex-vars.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index ee94cc5d693..51dedddf3a5 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -2096,8 +2096,8 @@ may require a restart of Emacs in order to become effective." (defcustom reftex-allow-detached-macro-args nil "Non-nil means, allow arguments of macros to be detached by whitespace. -When this is t, `aaa' will be considered as argument of \\bb in the following -construct: \\bbb [xxx] {aaa}." +When this is t, `aaa' will be considered as argument of \\bbb in +the following construct: \\bbb [xxx] {aaa}." :group 'reftex-miscellaneous-configurations :type 'boolean) -- cgit v1.2.1 From d3f1682ae9f95ee912d9bc5a2ab5c58659abf065 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 22 Dec 2022 19:39:59 +0100 Subject: Handle make-directory return values in file name handlers * lisp/net/ange-ftp.el (ange-ftp-make-directory): Handle return values. * lisp/net/tramp.el (tramp-skeleton-make-directory): New defmacro. Handle also return values. * lisp/net/tramp-adb.el (tramp-adb-handle-make-directory): * lisp/net/tramp-crypt.el (tramp-crypt-handle-make-directory): * lisp/net/tramp-fuse.el (tramp-fuse-handle-make-directory): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-make-directory): * lisp/net/tramp-sh.el (tramp-sh-handle-make-directory): * lisp/net/tramp-smb.el (tramp-smb-handle-make-directory): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-make-directory): Use it. * test/lisp/net/tramp-tests.el (tramp-test13-make-directory): Handle return values. --- lisp/net/ange-ftp.el | 5 +++-- lisp/net/tramp-adb.el | 19 +++++-------------- lisp/net/tramp-crypt.el | 11 ++--------- lisp/net/tramp-fuse.el | 10 ++-------- lisp/net/tramp-gvfs.el | 26 ++++++-------------------- lisp/net/tramp-sh.el | 13 ++----------- lisp/net/tramp-smb.el | 32 ++++++++------------------------ lisp/net/tramp-sudoedit.el | 13 ++----------- lisp/net/tramp.el | 21 +++++++++++++++++++++ 9 files changed, 51 insertions(+), 99 deletions(-) (limited to 'lisp') diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 9781ebf863a..f8e2858bc3f 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4129,7 +4129,7 @@ directory, so that Emacs will know its current contents." (or (file-exists-p parent) (ange-ftp-make-directory parent parents)))) (if (file-exists-p dir) - (unless parents + (if parents t (signal 'file-already-exists (list "Cannot make directory: file already exists" dir))) @@ -4158,7 +4158,8 @@ directory, so that Emacs will know its current contents." (format "Could not make directory %s: %s" dir (cdr result)))) - (ange-ftp-add-file-entry dir t)) + (ange-ftp-add-file-entry dir t) + nil) (ange-ftp-real-make-directory dir))))) (defun ange-ftp-delete-directory (dir &optional recursive trash) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 90020fbb1b6..5a025130ecf 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -411,20 +411,11 @@ Emacs dired can't find files." (defun tramp-adb-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (setq dir (expand-file-name dir)) - (with-parsed-tramp-file-name dir nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists dir)) - (when parents - (let ((par (expand-file-name ".." dir))) - (unless (file-directory-p par) - (make-directory par parents)))) - (tramp-flush-directory-properties v localname) - (unless (or (tramp-adb-send-command-and-check - v (format "mkdir -m %#o %s" - (default-file-modes) - (tramp-shell-quote-argument localname))) - (and parents (file-directory-p dir))) + (tramp-skeleton-make-directory dir parents + (unless (tramp-adb-send-command-and-check + v (format "mkdir -m %#o %s" + (default-file-modes) + (tramp-shell-quote-argument localname))) (tramp-error v 'file-error "Couldn't make directory %s" dir)))) (defun tramp-adb-handle-delete-directory (directory &optional recursive trash) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 249b3fcd4d7..e6c0ebccbff 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -800,16 +800,9 @@ WILDCARD is not supported." (defun tramp-crypt-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name dir) nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists dir)) + (tramp-skeleton-make-directory dir parents (let (tramp-crypt-enabled) - (make-directory (tramp-crypt-encrypt-file-name dir) parents)) - ;; When PARENTS is non-nil, DIR could be a chain of non-existent - ;; directories a/b/c/... Instead of checking, we simply flush the - ;; whole cache. - (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))))) + (make-directory (tramp-crypt-encrypt-file-name dir) parents)))) (defun tramp-crypt-handle-rename-file (filename newname &optional ok-if-already-exists) diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index ea6b5a0622c..5176c6e9c48 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -127,14 +127,8 @@ (defun tramp-fuse-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name dir) nil - (make-directory (tramp-fuse-local-file-name dir) parents) - ;; When PARENTS is non-nil, DIR could be a chain of non-existent - ;; directories a/b/c/... Instead of checking, we simply flush the - ;; whole file cache. - (tramp-flush-file-properties v localname) - (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))))) + (tramp-skeleton-make-directory dir parents + (make-directory (tramp-fuse-local-file-name dir) parents))) ;; File name helper functions. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index da7641774fb..66f4de989d0 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1560,27 +1560,13 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (setq dir (directory-file-name (expand-file-name dir))) - (with-parsed-tramp-file-name dir nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists dir)) - (tramp-flush-directory-properties v localname) + (tramp-skeleton-make-directory dir parents (save-match-data - (let ((ldir (file-name-directory dir))) - ;; Make missing directory parts. "gvfs-mkdir -p ..." does not - ;; work robust. - (when (and parents (not (file-directory-p ldir))) - (make-directory ldir parents)) - ;; Just do it. - (or (when-let ((mkdir-succeeded - (and - (tramp-gvfs-send-command - v "gvfs-mkdir" (tramp-gvfs-url-file-name dir)) - (tramp-gvfs-info dir)))) - (set-file-modes dir (default-file-modes)) - mkdir-succeeded) - (and parents (file-directory-p dir)) - (tramp-error v 'file-error "Couldn't make directory %s" dir)))))) + (if (and (tramp-gvfs-send-command + v "gvfs-mkdir" (tramp-gvfs-url-file-name dir)) + (tramp-gvfs-info dir)) + (set-file-modes dir (default-file-modes)) + (tramp-error v 'file-error "Couldn't make directory %s" dir))))) (defun tramp-gvfs-handle-rename-file (filename newname &optional ok-if-already-exists) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6087f16431e..19c160f4d6d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2559,19 +2559,10 @@ The method used must be an out-of-band method." (defun tramp-sh-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (setq dir (expand-file-name dir)) - (with-parsed-tramp-file-name dir nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists dir)) - ;; When PARENTS is non-nil, DIR could be a chain of non-existent - ;; directories a/b/c/... Instead of checking, we simply flush the - ;; whole cache. - (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))) + (tramp-skeleton-make-directory dir parents (tramp-barf-unless-okay v (format "%s -m %#o %s" - (if parents "mkdir -p" "mkdir") - (default-file-modes) + "mkdir" (default-file-modes) (tramp-shell-quote-argument localname)) "Couldn't make directory %s" dir))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index cd73b9b8eca..b51f42deb45 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1172,30 +1172,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (setq dir (directory-file-name (expand-file-name dir))) - (unless (file-name-absolute-p dir) - (setq dir (expand-file-name dir default-directory))) - (with-parsed-tramp-file-name dir nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists dir)) - (let* ((ldir (file-name-directory dir))) - ;; Make missing directory parts. - (when (and parents - (tramp-smb-get-share v) - (not (file-directory-p ldir))) - (make-directory ldir parents)) - ;; Just do it. - (when (file-directory-p ldir) - (tramp-smb-send-command - v (if (tramp-smb-get-cifs-capabilities v) - (format "posix_mkdir %s %o" - (tramp-smb-shell-quote-localname v) (default-file-modes)) - (format "mkdir %s" (tramp-smb-shell-quote-localname v)))) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname)) - (unless (file-directory-p dir) - (tramp-error v 'file-error "Couldn't make directory %s" dir))))) + (tramp-skeleton-make-directory dir parents + (tramp-smb-send-command + v (if (tramp-smb-get-cifs-capabilities v) + (format "posix_mkdir %s %o" + (tramp-smb-shell-quote-localname v) (default-file-modes)) + (format "mkdir %s" (tramp-smb-shell-quote-localname v)))) + (unless (file-directory-p dir) + (tramp-error v 'file-error "Couldn't make directory %s" dir)))) ;; This is not used anymore. (defun tramp-smb-handle-make-directory-internal (directory) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index fcc27dd8343..8774367cefe 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -626,18 +626,9 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." - (setq dir (expand-file-name dir)) - (with-parsed-tramp-file-name dir nil - (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists "Directory already exists %s" dir)) - ;; When PARENTS is non-nil, DIR could be a chain of non-existent - ;; directories a/b/c/... Instead of checking, we simply flush the - ;; whole cache. - (tramp-flush-directory-properties - v (if parents "/" (file-name-directory localname))) + (tramp-skeleton-make-directory dir parents (unless (tramp-sudoedit-send-command - v (if parents '("mkdir" "-p") "mkdir") - "-m" (format "%#o" (default-file-modes)) + v "mkdir" "-m" (format "%#o" (default-file-modes)) (tramp-compat-file-name-unquote localname)) (tramp-error v 'file-error "Couldn't make directory %s" dir)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ca8963fbf54..e39c9ccc31a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3537,6 +3537,27 @@ BODY is the backend specific code." ;; Trigger the `file-missing' error. (signal 'error nil))))) +(defmacro tramp-skeleton-make-directory (dir &optional parents &rest body) + "Skeleton for `tramp-*-handle-make-directory'. +BODY is the backend specific code." + ;; Since Emacs 29.1, PARENTS isn't propagated to the handlers + ;; anymore. And the return values are specified since then as well. + (declare (indent 2) (debug t)) + `(let* ((dir (directory-file-name (expand-file-name ,dir))) + (par (file-name-directory dir))) + (with-parsed-tramp-file-name dir nil + (when (and (null ,parents) (file-exists-p dir)) + (tramp-error v 'file-already-exists dir)) + ;; Make missing directory parts. + (when ,parents + (unless (file-directory-p par) + (make-directory par ,parents))) + ;; Just do it. + (if (file-exists-p dir) t + (tramp-flush-file-properties v localname) + ,@body + nil)))) + (defmacro tramp-skeleton-set-file-modes-times-uid-gid (filename &rest body) "Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'. -- cgit v1.2.1 From 54087e84df872c9aa30866b880e8ac0b917cbd94 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Mon, 19 Dec 2022 22:21:10 -0800 Subject: Add 'eshell-duplicate-handles' to return a copy of file handles * lisp/eshell/esh-io.el (eshell-create-handles): Support creating with multiple targets for stdout and/or stderr. Make the targets for a handle always be a list, and store whether the targets are the default in a separate 'default' field. (eshell-protect-handles, eshell-close-handles) (eshell-copy-output-handle, eshell-interactive-output-p) (eshell-output-object): Update for changes in 'eshell-create-handles'. (eshell-duplicate-handles, eshell-get-targets): New functions. * lisp/eshell/esh-cmd.el (eshell-copy-handles): Rename and alias to... (eshell-with-copied-handles): ... this function, and use 'eshell-duplicate-handles'. (eshell-execute-pipeline): Use 'eshell-duplicate-handles'. --- lisp/eshell/esh-cmd.el | 20 +++++------- lisp/eshell/esh-io.el | 83 +++++++++++++++++++++++++++++++------------------- 2 files changed, 60 insertions(+), 43 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 1fb84991120..03388236b06 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -788,16 +788,15 @@ this grossness will be made to disappear by using `call/cc'..." (defvar eshell-output-handle) ;Defined in esh-io.el. (defvar eshell-error-handle) ;Defined in esh-io.el. -(defmacro eshell-copy-handles (object) +(defmacro eshell-with-copied-handles (object) "Duplicate current I/O handles, so OBJECT works with its own copy." `(let ((eshell-current-handles - (eshell-create-handles - (car (aref eshell-current-handles - eshell-output-handle)) nil - (car (aref eshell-current-handles - eshell-error-handle)) nil))) + (eshell-duplicate-handles eshell-current-handles))) ,object)) +(define-obsolete-function-alias 'eshell-copy-handles + #'eshell-with-copied-handles "30.1") + (defmacro eshell-protect (object) "Protect I/O handles, so they aren't get closed after eval'ing OBJECT." `(progn @@ -808,7 +807,7 @@ this grossness will be made to disappear by using `call/cc'..." "Execute the commands in PIPELINE, connecting each to one another. This macro calls itself recursively, with NOTFIRST non-nil." (when (setq pipeline (cadr pipeline)) - `(eshell-copy-handles + `(eshell-with-copied-handles (progn ,(when (cdr pipeline) `(let ((nextproc @@ -880,11 +879,8 @@ This is used on systems where async subprocesses are not supported." (progn ,(if (fboundp 'make-process) `(eshell-do-pipelines ,pipeline) - `(let ((tail-handles (eshell-create-handles - (car (aref eshell-current-handles - ,eshell-output-handle)) nil - (car (aref eshell-current-handles - ,eshell-error-handle)) nil))) + `(let ((tail-handles (eshell-duplicate-handles + eshell-current-handles))) (eshell-do-pipelines-synchronously ,pipeline))) (eshell-process-identity (cons (symbol-value headproc) (symbol-value tailproc)))))) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 4620565f857..58084db28a8 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -291,25 +291,42 @@ describing the mode, e.g. for using with `eshell-get-target'.") (defun eshell-create-handles (stdout output-mode &optional stderr error-mode) "Create a new set of file handles for a command. -The default location for standard output and standard error will go to -STDOUT and STDERR, respectively. -OUTPUT-MODE and ERROR-MODE are either `overwrite', `append' or `insert'; -a nil value of mode defaults to `insert'." +The default target for standard output and standard error will +go to STDOUT and STDERR, respectively. OUTPUT-MODE and +ERROR-MODE are either `overwrite', `append' or `insert'; a nil +value of mode defaults to `insert'. + +The result is a vector of file handles. Each handle is of the form: + + (TARGETS DEFAULT REF-COUNT) + +TARGETS is a list of destinations for output. DEFAULT is non-nil +if handle has its initial default value (always t after calling +this function). REF-COUNT is the number of references to this +handle (initially 1); see `eshell-protect-handles' and +`eshell-close-handles'." (let* ((handles (make-vector eshell-number-of-handles nil)) - (output-target (eshell-get-target stdout output-mode)) + (output-target (eshell-get-targets stdout output-mode)) (error-target (if stderr - (eshell-get-target stderr error-mode) + (eshell-get-targets stderr error-mode) output-target))) - (aset handles eshell-output-handle (cons output-target 1)) - (aset handles eshell-error-handle (cons error-target 1)) + (aset handles eshell-output-handle (list output-target t 1)) + (aset handles eshell-error-handle (list error-target t 1)) handles)) +(defun eshell-duplicate-handles (handles) + "Create a duplicate of the file handles in HANDLES. +This will copy the targets of each handle in HANDLES, setting the +DEFAULT field to t (see `eshell-create-handles')." + (eshell-create-handles + (car (aref handles eshell-output-handle)) nil + (car (aref handles eshell-error-handle)) nil)) + (defun eshell-protect-handles (handles) "Protect the handles in HANDLES from a being closed." (dotimes (idx eshell-number-of-handles) - (when (aref handles idx) - (setcdr (aref handles idx) - (1+ (cdr (aref handles idx)))))) + (when-let ((handle (aref handles idx))) + (setcar (nthcdr 2 handle) (1+ (nth 2 handle))))) handles) (defun eshell-close-handles (&optional exit-code result handles) @@ -330,8 +347,8 @@ the value already set in `eshell-last-command-result'." (let ((handles (or handles eshell-current-handles))) (dotimes (idx eshell-number-of-handles) (when-let ((handle (aref handles idx))) - (setcdr handle (1- (cdr handle))) - (when (= (cdr handle) 0) + (setcar (nthcdr 2 handle) (1- (nth 2 handle))) + (when (= (nth 2 handle) 0) (dolist (target (ensure-list (car (aref handles idx)))) (eshell-close-target target (= eshell-last-command-status 0))) (setcar handle nil)))))) @@ -344,15 +361,17 @@ If HANDLES is nil, use `eshell-current-handles'." (if (and (stringp target) (string= target (null-device))) (aset handles index nil) - (let ((where (eshell-get-target target mode)) - (current (car (aref handles index)))) - (if (listp current) + (let* ((where (eshell-get-target target mode)) + (handle (or (aref handles index) + (aset handles index (list nil nil 1)))) + (current (car handle)) + (defaultp (cadr handle))) + (if (not defaultp) (unless (member where current) (setq current (append current (list where)))) (setq current (list where))) - (if (not (aref handles index)) - (aset handles index (cons nil 1))) - (setcar (aref handles index) current)))))) + (setcar handle current) + (setcar (cdr handle) nil)))))) (defun eshell-copy-output-handle (index index-to-copy &optional handles) "Copy the handle INDEX-TO-COPY to INDEX for the current HANDLES. @@ -482,6 +501,13 @@ it defaults to `insert'." (error "Invalid redirection target: %s" (eshell-stringify target))))) +(defun eshell-get-targets (targets &optional mode) + "Convert TARGETS into valid output targets. +TARGETS can be a single raw target or a list thereof. MODE is either +`overwrite', `append' or `insert'; if it is omitted or nil, it +defaults to `insert'." + (mapcar (lambda (i) (eshell-get-target i mode)) (ensure-list targets))) + (defun eshell-interactive-output-p (&optional index handles) "Return non-nil if the specified handle is bound for interactive display. HANDLES is the set of handles to check; if nil, use @@ -493,9 +519,9 @@ INDEX is the handle index to check. If nil, check (let ((handles (or handles eshell-current-handles)) (index (or index eshell-output-handle))) (if (eq index 'all) - (and (eq (car (aref handles eshell-output-handle)) t) - (eq (car (aref handles eshell-error-handle)) t)) - (eq (car (aref handles index)) t)))) + (and (equal (car (aref handles eshell-output-handle)) '(t)) + (equal (car (aref handles eshell-error-handle)) '(t))) + (equal (car (aref handles index)) '(t))))) (defvar eshell-print-queue nil) (defvar eshell-print-queue-count -1) @@ -602,15 +628,10 @@ Returns what was actually sent, or nil if nothing was sent." If HANDLE-INDEX is nil, output to `eshell-output-handle'. HANDLES is the set of file handles to use; if nil, use `eshell-current-handles'." - (let ((target (car (aref (or handles eshell-current-handles) - (or handle-index eshell-output-handle))))) - (if (listp target) - (while target - (eshell-output-object-to-target object (car target)) - (setq target (cdr target))) - (eshell-output-object-to-target object target) - ;; Explicitly return nil to match the list case above. - nil))) + (let ((targets (car (aref (or handles eshell-current-handles) + (or handle-index eshell-output-handle))))) + (dolist (target targets) + (eshell-output-object-to-target object target)))) (provide 'esh-io) ;;; esh-io.el ends here -- cgit v1.2.1 From 6defbd65b664b17ad7389a936743debe23d5257e Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 20 Dec 2022 09:39:07 -0800 Subject: Fix handling of output handles in nested Eshell forms Previously, the output handles in nested forms would be reset to the default, leading to wrong behavior for commands like {echo a; echo b} > file "b" would be written to "file" as expected, but "a" would go to standard output (bug#59545). * lisp/eshell/esh-cmd.el (eshell-parse-command): Use 'eshell-with-copied-handles' for each statement within the whole Eshell command. * test/lisp/eshell/esh-io-tests.el (esh-io-test/redirect-subcommands) (esh-io-test/redirect-subcommands/override) (esh-io-test/redirect-subcommands/interpolated): New tests. * test/lisp/eshell/em-script-tests.el (em-script-test/source-script/redirect) (em-script-test/source-script/redirect/dev-null): New tests. (em-script-test/source-script, em-script-test/source-script/arg-vars) (em-script-test/source-script/all-args-var): Tweak names/docstrings. * test/lisp/eshell/em-extpipe-tests.el (em-extpipe-tests--deftest): Skip over the newly-added 'eshell-with-copied-handles' form when checking the parse results. * test/lisp/eshell/em-tramp-tests.el (em-tramp-test/su-default) (em-tramp-test/su-user, em-tramp-test/su-login) (em-tramp-test/sudo-shell, em-tramp-test/sudo-user-shell) (em-tramp-test/doas-shell, em-tramp-test/doas-user-shell): Update expected command forms. --- lisp/eshell/esh-cmd.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 03388236b06..79957aeb416 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -418,8 +418,12 @@ hooks should be run before and after the command." (eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms)))) (let ((cmd commands)) (while cmd - (if (cdr cmd) - (setcar cmd `(eshell-commands ,(car cmd)))) + ;; Copy I/O handles so each full statement can manipulate them + ;; if they like. As a small optimization, skip this for the + ;; last top-level one; we won't use these handles again + ;; anyway. + (when (or (not toplevel) (cdr cmd)) + (setcar cmd `(eshell-with-copied-handles ,(car cmd)))) (setq cmd (cdr cmd)))) (if toplevel `(eshell-commands (progn -- cgit v1.2.1 From 17bf6a829ca2fd2920c01e1aee30ab16b9c672eb Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 20 Dec 2022 13:47:20 -0800 Subject: Simplify handling of /dev/null redirection in Eshell This also fixes an issue where "echo hi > foo > /dev/null" didn't write to the file "foo". (Note that users can still use their system's null device name when redirecting; Eshell doesn't need to do anything special to support that.) * lisp/eshell/esh-io.el (eshell-virtual-targets): Add "/dev/null". (eshell-set-output-handle): Handle 'eshell-null-device'. * test/lisp/eshell/esh-io-tests.el (esh-io-test/redirect-subcommands/dev-null) (esh-io-test/virtual/dev-null, esh-io-test/virtual/dev-null/multiple): New tests. --- lisp/eshell/esh-io.el | 54 +++++++++++++++++++++++++-------------------------- 1 file changed, 27 insertions(+), 27 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 58084db28a8..f2bc87374c1 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -116,16 +116,22 @@ from executing while Emacs is redisplaying." :group 'eshell-io) (defcustom eshell-virtual-targets - '(("/dev/eshell" eshell-interactive-print nil) + '(;; The literal string "/dev/null" is intentional here. It just + ;; provides compatibility so that users can redirect to + ;; "/dev/null" no matter the actual value of `null-device'. + ("/dev/null" (lambda (_mode) (throw 'eshell-null-device t)) t) + ("/dev/eshell" eshell-interactive-print nil) ("/dev/kill" (lambda (mode) - (if (eq mode 'overwrite) - (kill-new "")) - 'eshell-kill-append) t) + (when (eq mode 'overwrite) + (kill-new "")) + #'eshell-kill-append) + t) ("/dev/clip" (lambda (mode) - (if (eq mode 'overwrite) - (let ((select-enable-clipboard t)) - (kill-new ""))) - 'eshell-clipboard-append) t)) + (when (eq mode 'overwrite) + (let ((select-enable-clipboard t)) + (kill-new ""))) + #'eshell-clipboard-append) + t)) "Map virtual devices name to Emacs Lisp functions. If the user specifies any of the filenames above as a redirection target, the function in the second element will be called. @@ -138,10 +144,8 @@ function. The output function is then called repeatedly with single strings, which represents successive pieces of the output of the command, until nil -is passed, meaning EOF. - -NOTE: /dev/null is handled specially as a virtual target, and should -not be added to this variable." +is passed, meaning EOF." + :version "30.1" :type '(repeat (list (string :tag "Target") function @@ -357,21 +361,17 @@ the value already set in `eshell-last-command-result'." "Set handle INDEX for the current HANDLES to point to TARGET using MODE. If HANDLES is nil, use `eshell-current-handles'." (when target - (let ((handles (or handles eshell-current-handles))) - (if (and (stringp target) - (string= target (null-device))) - (aset handles index nil) - (let* ((where (eshell-get-target target mode)) - (handle (or (aref handles index) - (aset handles index (list nil nil 1)))) - (current (car handle)) - (defaultp (cadr handle))) - (if (not defaultp) - (unless (member where current) - (setq current (append current (list where)))) - (setq current (list where))) - (setcar handle current) - (setcar (cdr handle) nil)))))) + (let* ((handles (or handles eshell-current-handles)) + (handle (or (aref handles index) + (aset handles index (list nil nil 1)))) + (defaultp (cadr handle)) + (current (unless defaultp (car handle)))) + (catch 'eshell-null-device + (let ((where (eshell-get-target target mode))) + (unless (member where current) + (setq current (append current (list where)))))) + (setcar handle current) + (setcar (cdr handle) nil)))) (defun eshell-copy-output-handle (index index-to-copy &optional handles) "Copy the handle INDEX-TO-COPY to INDEX for the current HANDLES. -- cgit v1.2.1 From baaa9f42e574aa5eceeb4b9354a42ccb8ff1969a Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 20 Dec 2022 15:53:19 -0700 Subject: vc-git-checkin: Don't try to apply an empty patch * lisp/vc/vc-git.el (vc-git-checkin): Don't try to apply an empty patch to the index, because in that case 'git apply' fails. (cherry picked from commit 1424342225ef5b18c630364dd88e004f4ebb1c7f) --- lisp/vc/vc-git.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index b5959d535c0..afaaa44e908 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1041,12 +1041,13 @@ It is based on `log-edit-mode', and has Git-specific extensions." (string-replace file-diff "" vc-git-patch-string)) (user-error "Index not empty")) (setq pos (point)))))) - (let ((patch-file (make-nearby-temp-file "git-patch"))) - (with-temp-file patch-file - (insert vc-git-patch-string)) - (unwind-protect - (vc-git-command nil 0 patch-file "apply" "--cached") - (delete-file patch-file)))) + (unless (string-empty-p vc-git-patch-string) + (let ((patch-file (make-nearby-temp-file "git-patch"))) + (with-temp-file patch-file + (insert vc-git-patch-string)) + (unwind-protect + (vc-git-command nil 0 patch-file "apply" "--cached") + (delete-file patch-file))))) (cl-flet ((boolean-arg-fn (argument) (lambda (value) (when (equal value "yes") (list argument))))) -- cgit v1.2.1 From 6dda2106ece7c307ed5c0a6cb892e736516effeb Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 23 Dec 2022 14:37:04 +0200 Subject: ; Improve documentation of "C-x @" * doc/emacs/custom.texi (Modifier Keys): Document how to enter Shift, Control, and Meta using "C-x @". * lisp/simple.el (function-key-map): Add commentary to "C-x @" bindings to make them easier to discover. --- lisp/simple.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/simple.el b/lisp/simple.el index f85428ca740..4551b749d56 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10053,6 +10053,8 @@ PREFIX is the string that represents this modifier in an event type symbol." event-type (cons event-type (cdr event))))))) +;; This is what makes "C-x @" followed by [hsmaSc] work even though +;; you won't find any (define-key ctl-x-map "@" ...) binding. (define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier) (define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier) (define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier) -- cgit v1.2.1 From eccb813a943f4b6898cbe241c636c2ba5e63d271 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 23 Dec 2022 16:41:08 +0200 Subject: Fix "C-h k" in recursive minibuffers * lisp/subr.el (event--posn-at-point): Leave POSN alone if it doesn't have at least 6 members. This follows more faithfully what 'event-start' and 'event-end' did before they started using this function, see commit c1cead89f5f. Call posn-at-point with the minibuffer-window when in the minibuffer. (Bug#60252) --- lisp/subr.el | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/subr.el b/lisp/subr.el index e142eaa8104..a5e66de27de 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1576,16 +1576,18 @@ in the current Emacs session, then this function may return nil." ;; Use `window-point' for the case when the current buffer ;; is temporarily switched to some other buffer (bug#50256) (let* ((pos (window-point)) - (posn (posn-at-point pos))) - (if (null posn) ;; `pos' is "out of sight". - (list (selected-window) pos '(0 . 0) 0) - ;; If `pos' is inside a chunk of text hidden by an `invisible' - ;; or `display' property, `posn-at-point' returns the position - ;; that *is* visible, whereas `event--posn-at-point' is used - ;; when we have a keyboard event, whose position is `point' even - ;; if that position is invisible. - (setf (nth 5 posn) pos) - posn))) + (posn (posn-at-point pos (if (minibufferp (current-buffer)) + (minibuffer-window))))) + (cond ((null posn) ;; `pos' is "out of sight". + (setq posn (list (selected-window) pos '(0 . 0) 0))) + ;; If `pos' is inside a chunk of text hidden by an `invisible' + ;; or `display' property, `posn-at-point' returns the position + ;; that *is* visible, whereas `event--posn-at-point' is used + ;; when we have a keyboard event, whose position is `point' even + ;; if that position is invisible. + ((> (length posn) 5) + (setf (nth 5 posn) pos))) + posn)) (defun event-start (event) "Return the starting position of EVENT. -- cgit v1.2.1 From a5d39e11443fa30c8e8bc58254a1a59550dcd99e Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 23 Dec 2022 18:21:10 +0100 Subject: ; Fix typos --- lisp/ChangeLog.14 | 4 ++-- lisp/ChangeLog.7 | 2 +- lisp/cedet/ChangeLog.1 | 2 +- lisp/gnus/ChangeLog.3 | 2 +- lisp/mail/rmailsum.el | 2 +- lisp/mh-e/mh-search.el | 2 +- lisp/net/tramp-sh.el | 2 +- lisp/org/ChangeLog.1 | 8 ++++---- lisp/org/org-element.el | 6 +++--- lisp/org/org-faces.el | 2 +- lisp/org/org-fold-core.el | 8 ++++---- lisp/progmodes/cc-engine.el | 2 +- lisp/progmodes/idlw-help.el | 2 +- lisp/progmodes/python.el | 2 +- lisp/replace.el | 2 +- lisp/sort.el | 2 +- 16 files changed, 25 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index eae47fe1985..1ce11c11adf 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -6299,7 +6299,7 @@ 2008-10-22 Vinicius Jose Latorre - * ps-print.el: Deal with page sizes for label printes. Suggested by + * ps-print.el: Deal with page sizes for label printers. Suggested by Friedrich Delgado Friedrichs . (ps-print-version): New version 7.3.3. (ps-page-dimensions-database): New page sizes for label printers. @@ -6371,7 +6371,7 @@ * replace.el (query-replace, query-replace-regexp) (replace-string, replace-regexp, perform-replace): Add "word" - indicatiors to the prompt for word delimited replacements. + indicators to the prompt for word delimited replacements. * replace.el (read-regexp): Rename arg `default' to `default-value'. Doc fix. diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7 index 91b8d474224..83143f73360 100644 --- a/lisp/ChangeLog.7 +++ b/lisp/ChangeLog.7 @@ -14679,7 +14679,7 @@ * simple.el (current-word): Ignore text properties. * edebug.el (edebug-sit-for-seconds): New variable. - (edebug-display): Use that variable to control amt of time. + (edebug-display): Use that variable to control amount of time. 1997-06-22 Morten Welinder diff --git a/lisp/cedet/ChangeLog.1 b/lisp/cedet/ChangeLog.1 index 78275f4db3a..a3a1034e089 100644 --- a/lisp/cedet/ChangeLog.1 +++ b/lisp/cedet/ChangeLog.1 @@ -1446,7 +1446,7 @@ modes, and merge the tables together in :tables from :modetables. (srecode-make-mode-table): Init :modetables. (srecode-mode-table-find): Search in modetables. - (srecode-mode-table-new): Merge the differet files into the + (srecode-mode-table-new): Merge the different files into the modetables slot. 2012-10-01 David Engster diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3 index 8c1073dc8db..bf64780799d 100644 --- a/lisp/gnus/ChangeLog.3 +++ b/lisp/gnus/ChangeLog.3 @@ -11763,7 +11763,7 @@ 2010-08-29 Lars Magne Ingebrigtsen * gnus-start.el (gnus-dribble-read-file): Ensure that the directory - where the dribbel file lives exists. + where the dribble file lives exists. * message.el (message-send-mail-partially-limit): Change the default to nil, since most people don't want this. diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index d63e05f5fa2..20362d39d10 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -339,7 +339,7 @@ First element is ignored.") (split-string header "[ \f\t\n\r\v,;]+")))) (defun rmail-summary-fill-message-parents-and-descs-vectors () - "Fill parents and descendats vectors for messages. + "Fill parents and descendants vectors for messages. This populates `rmail-summary-message-parents-vector' and `rmail-summary-message-descendants-vector'." (with-current-buffer rmail-buffer diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index 058ea4499fd..1b28509dd12 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -292,7 +292,7 @@ folder containing the index search results." (cons folder msg))))) folder-results-map) - ;; Vist the results folder. + ;; Visit the results folder. (mh-visit-folder index-folder () (list folder-results-map origin-map)) (goto-char (point-min)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 19c160f4d6d..a5327e428ac 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2820,7 +2820,7 @@ the result will be a local, non-Tramp, file name." (when (zerop (length name)) (setq name ".")) ;; On MS Windows, some special file names are not returned properly ;; by `file-name-absolute-p'. If `tramp-syntax' is `simplified', - ;; there could be the falso positive "/:". + ;; there could be the false positive "/:". (if (or (and (eq system-type 'windows-nt) (string-match-p (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device) eol))) diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1 index 4f51c6a1ebb..e72526c3edc 100644 --- a/lisp/org/ChangeLog.1 +++ b/lisp/org/ChangeLog.1 @@ -10418,7 +10418,7 @@ * org.el (org-adaptive-fill-function): Remove occasional spurious space character when auto-filling. - * org.el (org-mode): Call external initalizers. Now both filling + * org.el (org-mode): Call external initializers. Now both filling code and comments code have their own independent part in org.el. (org-setup-filling): Rename from `org-set-autofill-regexps'. (org-setup-comments-handling): New function. @@ -15589,7 +15589,7 @@ * ob-python.el (org-babel-python-evaluate-session): Introduced a new local function for sending input with a slight delay to allow - pythong to re-draw the prompt. No longer removing newlines inside + python to re-draw the prompt. No longer removing newlines inside code block bodies (was due to a defective regexp). 2011-07-28 Bastien Guerry @@ -17320,7 +17320,7 @@ * ob-lisp.el (org-babel-execute:lisp): Turn vectors into lists before reading by elisp. - (org-bable-lisp-vector-to-list): Stub of a vector->list function, + (org-babel-lisp-vector-to-list): Stub of a vector->list function, should be replaced with a cl-vector->el-vector function. 2011-07-28 Eric Schulte @@ -29935,7 +29935,7 @@ inserted at the correct position. * org-publish.el (org-publish-project-alist) - (org-publish-projects, org-publish-org-index): Change default anme + (org-publish-projects, org-publish-org-index): Change default name for the index of file names to "sitemap.org". * org-latex.el (org-export-latex-tables): diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index 71c242ea658..230937c4e60 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -7260,18 +7260,18 @@ Each element indicates the latest `org-element--cache-change-tic' when change did not contain gaps.") ;;;###autoload -(defun org-element-cache-reset (&optional all no-persistance) +(defun org-element-cache-reset (&optional all no-persistence) "Reset cache in current buffer. When optional argument ALL is non-nil, reset cache in all Org buffers. -When optional argument NO-PERSISTANCE is non-nil, do not try to update +When optional argument NO-PERSISTENCE is non-nil, do not try to update the cache persistence in the buffer." (interactive "P") (dolist (buffer (if all (buffer-list) (list (current-buffer)))) (org-with-base-buffer buffer (when (and org-element-use-cache (derived-mode-p 'org-mode)) ;; Only persist cache in file buffers. - (when (and (buffer-file-name) (not no-persistance)) + (when (and (buffer-file-name) (not no-persistence)) (when (not org-element-cache-persistent) (org-persist-unregister 'org-element--headline-cache (current-buffer)) (org-persist-unregister 'org-element--cache (current-buffer))) diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index 0effa13a1d6..b3ee17ccdf6 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -517,7 +517,7 @@ content of these blocks will still be treated as Org syntax." (defface org-agenda-structure-filter '((t (:inherit (org-warning org-agenda-structure)))) "Face used for the current type of task filter in the agenda. It inherits from `org-agenda-structure' so it can adapt to -it (e.g. if that is assigned a diffent font height or family)." +it (e.g. if that is assigned a different font height or family)." :group 'org-faces) (defface org-agenda-date '((t (:inherit org-agenda-structure))) diff --git a/lisp/org/org-fold-core.el b/lisp/org/org-fold-core.el index ffa689d4fa1..c4d78496e55 100644 --- a/lisp/org/org-fold-core.el +++ b/lisp/org/org-fold-core.el @@ -145,7 +145,7 @@ ;; All the folding specs can be specified by symbol representing their ;; name. However, this is not always convenient, especially if the -;; same spec can be used for fold different syntaxical structures. +;; same spec can be used for fold different syntactical structures. ;; Any folding spec can be additionally referenced by a symbol listed ;; in the spec's `:alias' folding spec property. For example, Org ;; mode's `org-fold-outline' folding spec can be referenced as any @@ -189,9 +189,9 @@ ;; all the processing related to buffer modifications. ;; The library also provides a way to unfold the text after some -;; destructive changes breaking syntaxical structure of the buffer. +;; destructive changes breaking syntactical structure of the buffer. ;; For example, Org mode automatically reveals folded drawers when the -;; drawer becomes syntaxically incorrect: +;; drawer becomes syntactically incorrect: ;; ------- before modification ------- ;; :DRAWER: ;; Some folded text inside drawer @@ -321,7 +321,7 @@ following symbols: functions relying on this package might not be able to unfold the edited text. For example, removed leading stars from a folded headline in Org mode will break visibility cycling since Org mode - will not be avare that the following folded text belonged to + will not be aware that the following folded text belonged to headline. - `ignore-modification-checks': Do not try to detect insertions in the diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index edb873f5a62..2198f3115a5 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -7757,7 +7757,7 @@ multi-line strings (but not C++, for example)." (1- (match-end 1)) ; 1- For the inserted ". eoll)))) - ;; ...and clear `syntax-table' text propertes from the + ;; ...and clear `syntax-table' text properties from the ;; following raw strings. (c-depropertize-ml-strings-in-region (point) (1+ eoll))) ;; Remove the temporary string delimiter. diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index a19abf77e5f..51afb7e4850 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -269,7 +269,7 @@ Scrolling: SPC DEL RET Text Searches: Inside Topic: Use Emacs search functions Exit: [q]uit or mouse button 3 will kill the frame -When the hep text is a source file, the following commands are available +When the help text is a source file, the following commands are available Fontification: [F]ontify the buffer like source code Jump: [h] to function doclib header diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index bdc9e6fa78c..86bfafe2716 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4540,7 +4540,7 @@ Commands that must finish the tracking session are listed in (when (and python-pdbtrack-tracked-buffer ;; Empty input is sent by C-d or `comint-send-eof' (or (string-empty-p input) - ;; "n some text" is "n" command for pdb. Split input and get firs part + ;; "n some text" is "n" command for pdb. Split input and get first part (let* ((command (car (split-string (string-trim input) " ")))) (setq python-pdbtrack-prev-command-continue (or (member command python-pdbtrack-continue-command) diff --git a/lisp/replace.el b/lisp/replace.el index 302cb65543b..cebe779ae4c 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1692,7 +1692,7 @@ contents of the line; it normally shows the line number. \(For multiline matches, the prefix column shows the line number for the first line and whitespace for the rest of the lines.\) If this face will display the same as the default face, the prefix -column will not be highlighted speciall." +column will not be highlighted specially." :type 'face :group 'matching :version "24.4") diff --git a/lisp/sort.el b/lisp/sort.el index d04f075abd1..b66d6453d21 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -86,7 +86,7 @@ second key. If PREDICATE is nil, comparison is done with `<' if the keys are numbers, with `compare-buffer-substrings' if the keys are cons cells (the car and cdr of each cons cell are taken as start and end positions), and with `string<' otherwise." - ;; Heuristically try to avoid messages if sorting a small amt of text. + ;; Heuristically try to avoid messages if sorting a small amount of text. (let ((messages (> (- (point-max) (point-min)) 50000))) (save-excursion (if messages (message "Finding sort keys...")) -- cgit v1.2.1 From 9a3b08061feea14d6f37685ca1ab8801758bfd1c Mon Sep 17 00:00:00 2001 From: Xi Lu Date: Fri, 23 Dec 2022 12:52:48 +0800 Subject: Fix ruby-mode.el local command injection vulnerability (bug#60268) * lisp/progmodes/ruby-mode.el (ruby-find-library-file): Fix local command injection vulnerability. --- lisp/progmodes/ruby-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 1f3e9b6ae7b..a4aa61905e4 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1899,7 +1899,7 @@ or `gem' statement around point." (setq feature-name (read-string "Feature name: " init)))) (let ((out (substring - (shell-command-to-string (concat "gem which " feature-name)) + (shell-command-to-string (concat "gem which " (shell-quote-argument feature-name))) 0 -1))) (if (string-match-p "\\`ERROR" out) (user-error "%s" out) -- cgit v1.2.1 From 666c24a6269c35f27145350206cbbc057863e557 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 22 Dec 2022 20:54:08 -0700 Subject: vc-git-checkin: Stash other staged changes * lisp/vc/vc-git.el (vc-git--stash-staged-changes): New function. (vc-git-checkin): Use new function to avoid needing to unstage changes unrelated to the patch we want to commit (bug#60126). --- lisp/vc/vc-git.el | 97 +++++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 83 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 0a4e9caa614..671be66bbef 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1020,22 +1020,36 @@ It is based on `log-edit-mode', and has Git-specific extensions." ;; message. Handle also remote files. (if (eq system-type 'windows-nt) (let ((default-directory (file-name-directory file1))) - (make-nearby-temp-file "git-msg"))))) + (make-nearby-temp-file "git-msg")))) + to-stash) (when vc-git-patch-string (unless (zerop (vc-git-command nil t nil "diff" "--cached" "--quiet")) - ;; Check that all staged changes also exist in the patch. - ;; This is needed to allow adding/removing files that are - ;; currently staged to the index. So remove the whole file diff - ;; from the patch because commit will take it from the index. + ;; Check that what's already staged is compatible with what + ;; we want to commit (bug#60126). + ;; + ;; 1. If the changes to a file in the index are identical to + ;; the changes to that file we want to commit, remove the + ;; changes from our patch, and let the commit take them + ;; from the index. This is necessary for adding and + ;; removing files to work. + ;; + ;; 2. If the changes to a file in the index are different to + ;; changes to that file we want to commit, then we have to + ;; unstage the changes or abort. + ;; + ;; 3. If there are changes to a file in the index but we don't + ;; want to commit any changes to that file, we need to + ;; stash those changes before committing. (with-temp-buffer (vc-git-command (current-buffer) t nil "diff" "--cached") (goto-char (point-min)) - (let ((pos (point)) file-name file-diff file-beg) + (let ((pos (point)) file-name file-header file-diff file-beg) (while (not (eobp)) (when (and (looking-at "^diff --git a/\\(.+\\) b/\\(.+\\)") (string= (match-string 1) (match-string 2))) (setq file-name (match-string 1))) (forward-line 1) ; skip current "diff --git" line + (setq file-header (buffer-substring pos (point))) (search-forward "diff --git" nil 'move) (move-beginning-of-line 1) (setq file-diff (buffer-substring pos (point))) @@ -1049,12 +1063,15 @@ It is based on `log-edit-mode', and has Git-specific extensions." (+ file-beg (length file-diff))))) (setq vc-git-patch-string (string-replace file-diff "" vc-git-patch-string))) - ((and file-name - (yes-or-no-p - (format "Unstage already-staged changes to %s?" - file-name))) - (vc-git-command nil 0 file-name "reset" "-q" "--")) - (t (user-error "Index not empty"))) + ((string-match (format "^%s" (regexp-quote file-header)) + vc-git-patch-string) + (if (and file-name + (yes-or-no-p + (format "Unstage already-staged changes to %s?" + file-name))) + (vc-git-command nil 0 file-name "reset" "-q" "--") + (user-error "Index not empty"))) + (t (push file-name to-stash))) (setq pos (point)))))) (unless (string-empty-p vc-git-patch-string) (let ((patch-file (make-nearby-temp-file "git-patch"))) @@ -1062,7 +1079,8 @@ It is based on `log-edit-mode', and has Git-specific extensions." (insert vc-git-patch-string)) (unwind-protect (vc-git-command nil 0 patch-file "apply" "--cached") - (delete-file patch-file))))) + (delete-file patch-file)))) + (when to-stash (vc-git--stash-staged-changes files))) (cl-flet ((boolean-arg-fn (argument) (lambda (value) (when (equal value "yes") (list argument))))) @@ -1088,7 +1106,58 @@ It is based on `log-edit-mode', and has Git-specific extensions." args) (unless vc-git-patch-string (if only (list "--only" "--") '("-a")))))) - (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file)))) + (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file)) + (when to-stash + (let ((cached (make-nearby-temp-file "git-cached"))) + (unwind-protect + (progn (with-temp-file cached + (vc-git-command t 0 nil "stash" "show" "-p")) + (vc-git-command nil 0 cached "apply" "--cached")) + (delete-file cached)) + (vc-git-command nil 0 nil "stash" "drop"))))) + +(defun vc-git--stash-staged-changes (files) + "Stash only the staged changes to FILES." + ;; This is necessary because even if you pass a list of file names + ;; to 'git stash push', it will stash any and all staged changes. + (unless (zerop + (vc-git-command nil t files "diff" "--cached" "--quiet")) + (cl-flet + ((git-string (&rest args) + (string-trim-right + (with-output-to-string + (apply #'vc-git-command standard-output 0 nil args))))) + (let ((cached (make-nearby-temp-file "git-cached")) + (message "Previously staged changes") + tree) + ;; Use a temporary index to create a tree object corresponding + ;; to the staged changes to FILES. + (unwind-protect + (progn + (with-temp-file cached + (vc-git-command t 0 files "diff" "--cached" "--")) + (let* ((index (make-nearby-temp-file "git-index")) + (process-environment + (cons (format "GIT_INDEX_FILE=%s" index) + process-environment))) + (unwind-protect + (progn + (vc-git-command nil 0 nil "read-tree" "HEAD") + (vc-git-command nil 0 cached "apply" "--cached") + (setq tree (git-string "write-tree"))) + (delete-file index)))) + (delete-file cached)) + ;; Prepare stash commit object, which has a special structure. + (let* ((tree-commit (git-string "commit-tree" "-m" message + "-p" "HEAD" tree)) + (stash-commit (git-string "commit-tree" "-m" message + "-p" "HEAD" "-p" tree-commit + tree))) + ;; Push the new stash entry. + (vc-git-command nil 0 nil "update-ref" "--create-reflog" + "-m" message "refs/stash" stash-commit) + ;; Unstage the changes we've now stashed. + (vc-git-command nil 0 files "reset" "--")))))) (defun vc-git-find-revision (file rev buffer) (let* (process-file-side-effects -- cgit v1.2.1 From 823c49cea851158bc4db5ab133ecd9bf3d0791d7 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Sat, 17 Dec 2022 18:18:39 -0500 Subject: ; ert-x: Simplify `ert-with-test-buffer-selected' * lisp/emacs-lisp/ert-x.el (ert-with-test-buffer-selected): Simplify using 'ert-with-test-buffer'. (Bug#60189) --- lisp/emacs-lisp/ert-x.el | 28 +++++----------------------- 1 file changed, 5 insertions(+), 23 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 49f2a1d6965..5f1c5c26acd 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -115,29 +115,11 @@ of BODY, which makes it easier to use `execute-kbd-macro' to simulate user interaction. The window configuration is restored before returning, even if BODY exits nonlocally. The return value is the last form in BODY." - (declare (debug ((":name" form) def-body)) - (indent 1)) - (let ((ret (make-symbol "ert--with-test-buffer-selected-ret"))) - `(save-window-excursion - (let (,ret) - (ert-with-test-buffer (:name ,name) - (with-current-buffer-window (current-buffer) - `(display-buffer-below-selected - (body-function - . ,(lambda (window) - (select-window window t) - ;; body-function is intended to initialize the - ;; contents of a temporary read-only buffer, so - ;; it is executed with some convenience - ;; changes. Undo those changes so that the - ;; test buffer behaves more like an ordinary - ;; buffer while the body executes. - (let ((inhibit-modification-hooks nil) - (inhibit-read-only nil) - (buffer-read-only nil)) - (setq ,ret (progn ,@body)))))) - nil)) - ,ret)))) + (declare (debug ((":name" form) body)) (indent 1)) + `(ert-with-test-buffer (:name ,name) + (save-window-excursion + (with-selected-window (display-buffer (current-buffer)) + ,@body)))) ;;;###autoload (defun ert-kill-all-test-buffers () -- cgit v1.2.1 From 286c48137f69fa96b80d197da90c69a42df604a3 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Sat, 17 Dec 2022 18:51:33 -0500 Subject: ert-x: Move window selection logic to its own macro * lisp/emacs-lisp/ert-x.el (ert-with-buffer-selected): New macro to temporarily display a buffer in a selected window and evaluate a body. (ert-with-test-buffer-selected): Use the new macro. * test/lisp/whitespace-tests.el (ert-test-with-buffer-selected/current) (ert-test-with-buffer-selected/selected) (ert-test-with-buffer-selected/nil-buffer) (ert-test-with-buffer-selected/modification-hooks) (ert-test-with-buffer-selected/read-only) (ert-test-with-buffer-selected/return-value): Add tests. (Bug#60189) --- lisp/emacs-lisp/ert-x.el | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 5f1c5c26acd..0614313809c 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -102,25 +102,36 @@ the name of the test and the result of NAME-FORM." (indent 1)) `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) -(cl-defmacro ert-with-test-buffer-selected ((&key name) - &body body) - "Create a test buffer, switch to it, and run BODY. +(cl-defmacro ert-with-buffer-selected (buffer-or-name &body body) + "Display a buffer in a temporary selected window and run BODY. + +If BUFFER-OR-NAME is nil, the current buffer is used. -This extends `ert-with-test-buffer' by displaying the test -buffer (whose name is derived from NAME) in a temporary window. -The temporary window becomes the `selected-window' before BODY is -evaluated. The modification hooks `before-change-functions' and +The buffer is made the current buffer, and the temporary window +becomes the `selected-window', before BODY is evaluated. The +modification hooks `before-change-functions' and `after-change-functions' are not inhibited during the evaluation of BODY, which makes it easier to use `execute-kbd-macro' to simulate user interaction. The window configuration is restored before returning, even if BODY exits nonlocally. The return value is the last form in BODY." - (declare (debug ((":name" form) body)) (indent 1)) - `(ert-with-test-buffer (:name ,name) - (save-window-excursion + (declare (debug (form body)) (indent 1)) + `(save-window-excursion + (with-current-buffer (or ,buffer-or-name (current-buffer)) (with-selected-window (display-buffer (current-buffer)) ,@body)))) +(cl-defmacro ert-with-test-buffer-selected ((&key name) &body body) + "Create a test buffer, switch to it, and run BODY. + +This combines `ert-with-test-buffer' and +`ert-with-buffer-selected'. The return value is the last form in +BODY." + (declare (debug ((":name" form) body)) (indent 1)) + `(ert-with-test-buffer (:name ,name) + (ert-with-buffer-selected (current-buffer) + ,@body))) + ;;;###autoload (defun ert-kill-all-test-buffers () "Kill all test buffers that are still live." -- cgit v1.2.1 From c90f97d4e5d56ba7cad0205c3f60854ca575f180 Mon Sep 17 00:00:00 2001 From: Yaraslau Tamashevich Date: Fri, 23 Dec 2022 11:39:25 +0200 Subject: Make the Contour terminal an alias of xterm-256color * lisp/faces.el (term-file-aliases): Make the Contour terminal an alias of xterm-256color. (Bug#60278) Copyright-paperwork-exempt: yes --- lisp/faces.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/faces.el b/lisp/faces.el index c69339e2fdc..29e26e4c651 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -47,7 +47,8 @@ the terminal-initialization file to be loaded." ("vt400" . "vt200") ("vt420" . "vt200") ("alacritty" . "xterm") - ("foot" . "xterm")) + ("foot" . "xterm") + ("contour" . "xterm")) "Alist of terminal type aliases. Entries are of the form (TYPE . ALIAS), where both elements are strings. This means to treat a terminal of type TYPE as if it were of type ALIAS." -- cgit v1.2.1 From 84888080eea51a150a87075ff1612209b46eda45 Mon Sep 17 00:00:00 2001 From: Xi Lu Date: Fri, 23 Dec 2022 23:50:39 +0800 Subject: Add more functions to "string" shortdoc * lisp/emacs-lisp/shortdoc.el: Add 'string-or-null-p', 'char-or-string-p', 'char-uppercase-p'. (Bug#60279) --- lisp/emacs-lisp/shortdoc.el | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 6704db3cc57..90f81d740f2 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -263,6 +263,12 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (stringp "a") :eval (stringp 'a) :eval "(stringp ?a)") + (string-or-null-p + :eval (string-or-null-p "a") + :eval (string-or-null-p nil)) + (char-or-string-p + :eval "(char-or-string-p ?a)" + :eval (char-or-string-p "a")) (string-empty-p :no-manual t :eval (string-empty-p "")) @@ -300,6 +306,9 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (string-to-number "2.5e+03")) (number-to-string :eval (number-to-string 42)) + (char-uppercase-p + :eval "(char-uppercase-p ?A)" + :eval "(char-uppercase-p ?a)") "Data About Strings" (length :eval (length "foo") -- cgit v1.2.1 From 6a43af58802d46555d692d0934d85d22711e0b56 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Fri, 23 Dec 2022 17:12:32 -0800 Subject: Fix block comment indent and filling for c-ts-mode (bug#59763) Now indent and filling works like in c-mode. The only noticeable missing piece is that the "*/" is not attached to the last sentence when filling. c-mode does it by replacing whitespaces between the "*/" and the end of the last sentence with xxx, fill it, then change the xxx back. I don't know if we should do that in c-ts-mode's filling. * doc/lispref/modes.texi (Parser-based Indentation): Add new preset. * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Add new indent rule. (c-ts-mode--fill-paragraph): New function. (c-ts-base-mode): Setup paragraph-start, adaptive-fill, etc. * lisp/treesit.el (treesit-simple-indent-presets): Add new preset. --- lisp/progmodes/c-ts-mode.el | 96 +++++++++++++++++++++++++++++++++++++++++++++ lisp/treesit.el | 25 +++++++++++- 2 files changed, 120 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index ea9891f3345..901b22e3c01 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -103,6 +103,7 @@ MODE is either `c' or `cpp'." ((node-is "case") parent-bol 0) ((node-is "preproc_arg") no-indent) ((and (parent-is "comment") comment-end) comment-start -1) + ((parent-is "comment") prev-adaptive-prefix 0) ((node-is "labeled_statement") parent-bol 0) ((parent-is "labeled_statement") parent-bol c-ts-mode-indent-offset) ((match "preproc_ifdef" "compound_statement") point-min 0) @@ -562,6 +563,70 @@ the semicolon. This function skips the semicolon." (treesit-node-end node)) (goto-char orig-point))) +(defun c-ts-mode--fill-paragraph (&optional arg) + "Fillling function for `c-ts-mode'. +ARG is passed to `fill-paragraph'." + (interactive "*P") + (save-restriction + (widen) + (let* ((node (treesit-node-at (point))) + (start (treesit-node-start node)) + (end (treesit-node-end node)) + ;; Bind to nil to avoid infinite recursion. + (fill-paragraph-function nil) + (orig-point (point-marker)) + (start-marker nil) + (end-marker nil) + (end-len 0)) + (when (equal (treesit-node-type node) "comment") + ;; We mask "/*" and the space before "*/" like + ;; `c-fill-paragraph' does. + (atomic-change-group + ;; Mask "/*". + (goto-char start) + (when (looking-at (rx (* (syntax whitespace)) + (group "/") "*")) + (goto-char (match-beginning 1)) + (setq start-marker (point-marker)) + (replace-match " " nil nil nil 1)) + ;; Mask spaces before "*/" if it is attached at the end + ;; of a sentence rather than on its own line. + (goto-char end) + (when (looking-back (rx (not (syntax whitespace)) + (group (+ (syntax whitespace))) + "*/") + (line-beginning-position)) + (goto-char (match-beginning 1)) + (setq end-marker (point-marker)) + (setq end-len (- (match-end 1) (match-beginning 1))) + (replace-match (make-string end-len ?x) + nil nil nil 1)) + ;; If "*/" is on its own line, don't included it in the + ;; filling region. + (when (not end-marker) + (goto-char end) + (when (looking-back "*/" 2) + (backward-char 2) + (skip-syntax-backward "-") + (setq end (point)))) + ;; Let `fill-paragraph' do its thing. + (goto-char orig-point) + (narrow-to-region start end) + (funcall #'fill-paragraph arg) + ;; Unmask. + (when start-marker + (goto-char start-marker) + (delete-char 1) + (insert "/")) + (when end-marker + (goto-char end-marker) + (delete-region (point) (+ end-len (point))) + (insert (make-string end-len ?\s)))) + (goto-char orig-point)) + ;; Return t so `fill-paragraph' doesn't attempt to fill by + ;; itself. + t))) + (defvar-keymap c-ts-mode-map :doc "Keymap for the C language with tree-sitter" :parent prog-mode-map @@ -593,6 +658,37 @@ the semicolon. This function skips the semicolon." (when (eq c-ts-mode-indent-style 'linux) (setq-local indent-tabs-mode t)) + (setq-local adaptive-fill-mode t) + ;; This matches (1) empty spaces (the default), (2) "//", (3) "*", + ;; but do not match "/*", because we don't want to use "/*" as + ;; prefix when filling. (Actually, it doesn't matter, because + ;; `comment-start-skip' matches "/*" which will cause + ;; `fill-context-prefix' to use "/*" as a prefix for filling, that's + ;; why we mask the "/*" in `c-ts-mode--fill-paragraph'.) + (setq-local adaptive-fill-regexp + (concat (rx (* (syntax whitespace)) + (group (or (seq "/" (+ "/")) (* "*")))) + adaptive-fill-regexp)) + ;; Same as `adaptive-fill-regexp'. + (setq-local adaptive-fill-first-line-regexp + (rx bos + (seq (* (syntax whitespace)) + (group (or (seq "/" (+ "/")) (* "*"))) + (* (syntax whitespace))) + eos)) + ;; Same as `adaptive-fill-regexp'. + (setq-local paragraph-start + (rx (or (seq (* (syntax whitespace)) + (group (or (seq "/" (+ "/")) (* "*"))) + (* (syntax whitespace)) + ;; Add this eol so that in + ;; `fill-context-prefix', `paragraph-start' + ;; doesn't match the prefix. + eol) + "\f"))) + (setq-local paragraph-separate paragraph-start) + (setq-local fill-paragraph-function #'c-ts-mode--fill-paragraph) + ;; Electric (setq-local electric-indent-chars (append "{}():;," electric-indent-chars)) diff --git a/lisp/treesit.el b/lisp/treesit.el index ec5b3e399f9..845e6ab3883 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1107,6 +1107,22 @@ See `treesit-simple-indent-presets'.") (re-search-forward comment-start-skip) (skip-syntax-backward "-") (point)))) + (cons 'prev-adaptive-prefix + (lambda (_n parent &rest _) + (save-excursion + (re-search-backward + (rx (not (or " " "\t" "\n"))) nil t) + (beginning-of-line) + (and (>= (point) (treesit-node-start parent)) + ;; `adaptive-fill-regexp' will not match "/*", + ;; so we need to also try `comment-start-skip'. + (or (and adaptive-fill-regexp + (looking-at adaptive-fill-regexp) + (> (- (match-end 0) (match-beginning 0)) 0) + (match-end 0)) + (and comment-start-skip + (looking-at comment-start-skip) + (match-end 0))))))) ;; TODO: Document. (cons 'grand-parent (lambda (_n parent &rest _) @@ -1229,7 +1245,14 @@ comment-start Goes to the position that `comment-start-skip' would return, skips whitespace backwards, and returns the resulting - position. Assumes PARENT is a comment node.") + position. Assumes PARENT is a comment node. + +prev-adaptive-prefix + + Goes to the beginning of previous non-empty line, and tries + to match `adaptive-fill-regexp'. If it matches, return the + end of the match, otherwise return nil. This is useful for a + `indent-relative'-like indent behavior for block comments.") (defun treesit--simple-indent-eval (exp) "Evaluate EXP. -- cgit v1.2.1 From e4e3634539920d14395b19121715c50b3f022909 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 24 Dec 2022 00:15:48 -0800 Subject: Improve c-ts-mode block comment indent (bug#60270) Now it handles stuff like /** * @some_func: * @arg1: */ * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Use new matcher and anchor. (c-ts-mode--looking-at-star): New matcher. (c-ts-mode--comment-start-after-first-star): New anchor. --- lisp/progmodes/c-ts-mode.el | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 901b22e3c01..10f7bf58403 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -102,7 +102,8 @@ MODE is either `c' or `cpp'." ((node-is "else") parent-bol 0) ((node-is "case") parent-bol 0) ((node-is "preproc_arg") no-indent) - ((and (parent-is "comment") comment-end) comment-start -1) + ((and (parent-is "comment") c-ts-mode--looking-at-star) + c-ts-mode--comment-start-after-first-star -1) ((parent-is "comment") prev-adaptive-prefix 0) ((node-is "labeled_statement") parent-bol 0) ((parent-is "labeled_statement") parent-bol c-ts-mode-indent-offset) @@ -168,6 +169,24 @@ MODE is either `c' or `cpp'." ('linux (alist-get 'linux (c-ts-mode--indent-styles mode))))))) `((,mode ,@style)))) +(defun c-ts-mode--looking-at-star (&rest _) + "A tree-sitter simple indent matcher. +Matches if there is a \"*\" after point (ignoring whitespace in +between)." + (looking-at (rx (* (syntax whitespace)) "*"))) + +(defun c-ts-mode--comment-start-after-first-star (_n parent &rest _) + "A tree-sitter simple indent anchor. +Finds the \"/*\" and returns the point after the \"*\". +Assumes PARENT is a comment node." + (save-excursion + (goto-char (treesit-node-start parent)) + (if (looking-at (rx "/*")) + (match-end 0) + (point)))) + +;;; Font-lock + (defvar c-ts-mode--preproc-keywords '("#define" "#if" "#ifdef" "#ifndef" "#else" "#elif" "#endif" "#include") -- cgit v1.2.1 From a42b20dd95e4ca522c090f9edf110dcd132b616f Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 24 Dec 2022 00:16:45 -0800 Subject: ; * lisp/progmodes/c-ts-mode.el: Add outline section headers. --- lisp/progmodes/c-ts-mode.el | 14 ++++++++++++++ 1 file changed, 14 insertions(+) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 10f7bf58403..471d9a3dec0 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -39,6 +39,8 @@ (declare-function treesit-node-child-by-field-name "treesit.c") (declare-function treesit-node-type "treesit.c") +;;; Custom variables + (defcustom c-ts-mode-indent-offset 2 "Number of spaces for each indentation step in `c-ts-mode'." :version "29.1" @@ -91,6 +93,8 @@ follows the form of `treesit-simple-indent-rules'." table) "Syntax table for `c++-ts-mode'.") +;;; Indent + (defun c-ts-mode--indent-styles (mode) "Indent rules supported by `c-ts-mode'. MODE is either `c' or `cpp'." @@ -381,6 +385,8 @@ MODE is either `c' or `cpp'." @c-ts-mode--fontify-defun) (:match "^DEFUN$" @fn))))) +;;; Font-lock helpers + (defun c-ts-mode--fontify-declarator (node override start end &rest args) "Fontify a declarator (whatever under the \"declarator\" field). For NODE, OVERRIDE, START, END, and ARGS, see @@ -473,6 +479,8 @@ For NODE, OVERRIDE, START, and END, see (t 'font-lock-warning-face)) override start end))) +;;; Imenu + (defun c-ts-mode--imenu-1 (node) "Helper for `c-ts-mode--imenu'. Find string representation for NODE and set marker, then recurse @@ -537,6 +545,8 @@ the subtrees." (when var-index `(("Variable" . ,var-index))) (when func-index `(("Function" . ,func-index)))))) +;;; Defun navigation + (defun c-ts-mode--end-of-defun () "`end-of-defun-function' of `c-ts-mode'." ;; A struct/enum/union_specifier node doesn't include the ; at the @@ -582,6 +592,8 @@ the semicolon. This function skips the semicolon." (treesit-node-end node)) (goto-char orig-point))) +;;; Filling + (defun c-ts-mode--fill-paragraph (&optional arg) "Fillling function for `c-ts-mode'. ARG is passed to `fill-paragraph'." @@ -646,6 +658,8 @@ ARG is passed to `fill-paragraph'." ;; itself. t))) +;;; Modes + (defvar-keymap c-ts-mode-map :doc "Keymap for the C language with tree-sitter" :parent prog-mode-map -- cgit v1.2.1 From cc2cc0c2971bf867283d1478bd0d99c2f420f982 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 24 Dec 2022 01:08:21 -0800 Subject: Assume make-directory handler follows new API Suggested by Michael Albinus (Bug#58919#56). * lisp/files.el (files--ensure-directory): Omit recently-added arg MKDIR, since it is now always make-directory again. All uses changed. (make-directory): Assume the make-directory handler follows the new API where it yields non-nil if DIR already exists. This reverts some of the recent changes in this area, and simplifies this funciton. --- lisp/files.el | 53 ++++++++++++++++++++++++----------------------------- 1 file changed, 24 insertions(+), 29 deletions(-) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index f352d3a9a7e..0fb080b53c0 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6193,11 +6193,11 @@ instance of such commands." (rename-buffer (generate-new-buffer-name base-name)) (force-mode-line-update)))) -(defun files--ensure-directory (mkdir dir) - "Use function MKDIR to make directory DIR if it is not already a directory. +(defun files--ensure-directory (dir) + "Make directory DIR if it is not already a directory. Return non-nil if DIR is already a directory." (condition-case err - (funcall mkdir dir) + (make-directory-internal dir) (error (or (file-directory-p dir) (signal (car err) (cdr err)))))) @@ -6223,32 +6223,27 @@ Signal an error if unsuccessful." ;; If default-directory is a remote directory, ;; make sure we find its make-directory handler. (setq dir (expand-file-name dir)) - (let ((mkdir (if-let ((handler (find-file-name-handler dir 'make-directory))) - #'(lambda (dir) - ;; Use 'ignore' since the handler might be designed for - ;; Emacs 28-, so it might return an (undocumented) - ;; non-nil value, whereas the Emacs 29+ convention is - ;; to return nil here. - (ignore (funcall handler 'make-directory dir))) - #'make-directory-internal))) - (if (not parents) - (funcall mkdir dir) - (let ((dir (directory-file-name (expand-file-name dir))) - already-dir create-list parent) - (while (progn - (setq parent (directory-file-name - (file-name-directory dir))) - (condition-case () - (ignore (setq already-dir - (files--ensure-directory mkdir dir))) - (error - ;; Do not loop if root does not exist (Bug#2309). - (not (string= dir parent))))) - (setq create-list (cons dir create-list) - dir parent)) - (dolist (dir create-list) - (setq already-dir (files--ensure-directory mkdir dir))) - already-dir)))) + (let ((handler (find-file-name-handler dir 'make-directory))) + (if handler + (funcall handler 'make-directory dir parents) + (if (not parents) + (make-directory-internal dir) + (let ((dir (directory-file-name (expand-file-name dir))) + already-dir create-list parent) + (while (progn + (setq parent (directory-file-name + (file-name-directory dir))) + (condition-case () + (ignore (setq already-dir + (files--ensure-directory dir))) + (error + ;; Do not loop if root does not exist (Bug#2309). + (not (string= dir parent))))) + (setq create-list (cons dir create-list) + dir parent)) + (dolist (dir create-list) + (setq already-dir (files--ensure-directory dir))) + already-dir))))) (defun make-empty-file (filename &optional parents) "Create an empty file FILENAME. -- cgit v1.2.1 From a825aa0b135b206682bd7f84baa0fd7a7b8f3845 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Dec 2022 12:08:43 +0200 Subject: Fix definition of CNS 11643-15 charset * lisp/international/mule-conf.el (chinese-cns11643-15): Fix :code-offset value. (Bug#60275) * lisp/international/characters.el: Add chinese-cns11643-15 to charsets whose characters have categories c and C. --- lisp/international/characters.el | 2 +- lisp/international/mule-conf.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 9dcae187f21..42344d499cf 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -184,7 +184,7 @@ with L, LRE, or LRO Unicode bidi character type.") (dolist (c '(chinese-cns11643-1 chinese-cns11643-2 chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6 - chinese-cns11643-7)) + chinese-cns11643-7 chinese-cns11643-15)) (map-charset-chars #'modify-category-entry c ?c) (if (eq c 'chinese-cns11643-1) (map-charset-chars #'modify-category-entry c ?C #x4421 #x7E7E) diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index 3f3ac6064ae..65ba2370fcf 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -1268,7 +1268,7 @@ :short-name "CNS11643-15" :long-name "CNS11643-15 (Chinese traditional)" :code-space [33 126 33 126] - :code-offset #x27A000 + :code-offset #x28083A ; Right after 'big5-hkscs. :unify-map "CNS-F") (unify-charset 'chinese-gb2312) -- cgit v1.2.1 From 8bb8cc5b49a0cb681327ce9abe38266d5e26d19c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 23 Dec 2022 20:04:22 +0100 Subject: Fix condition-case body for-effect miscompilation (condition-case x A (:success B)) should not compile A for-effect even if the entire form is in for-effect context. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't optimise the condition-case body form for effect (potentially discarding its value) if there is a success handler and a variable. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): Add test cases. --- lisp/emacs-lisp/byte-opt.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 898dfffef63..ab35b0dde8f 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -410,7 +410,10 @@ for speeding up processing.") (`(condition-case ,var ,exp . ,clauses) `(,fn ,var ;Not evaluated. - ,(byte-optimize-form exp for-effect) + ,(byte-optimize-form exp + (if (assq :success clauses) + (null var) + for-effect)) ,@(mapcar (lambda (clause) (let ((byte-optimize--lexvars (and lexical-binding -- cgit v1.2.1 From 7723af5e4aa8304e244c285d489ca733b8a6cac3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 24 Dec 2022 17:01:36 +0100 Subject: ; * lisp/progmodes/c-ts-mode.el: quote literal string in regexp --- lisp/progmodes/c-ts-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 471d9a3dec0..d3291722331 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -636,7 +636,7 @@ ARG is passed to `fill-paragraph'." ;; filling region. (when (not end-marker) (goto-char end) - (when (looking-back "*/" 2) + (when (looking-back (rx "*/") 2) (backward-char 2) (skip-syntax-backward "-") (setq end (point)))) -- cgit v1.2.1 From 4dc5bee98d5734b4f7113b961bafead1eb091bd0 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 24 Dec 2022 20:04:56 +0200 Subject: * lisp/tab-bar.el: Fix the recent removal of substring as a gv-place. (tab-bar-auto-width): Copy more logic from 'cl--set-substring' (bug#60297). --- lisp/tab-bar.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 0bab3aba801..7433f5c8e51 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1116,7 +1116,8 @@ tab bar might wrap to the second line when it shouldn't.") (del-pos2 (if close-p -1 nil))) (while continue (setq name (concat (substring name 0 del-pos1) - (substring name del-pos2))) + (and del-pos2 + (substring name del-pos2)))) (setq curr-width (string-pixel-width name)) (if (and (> curr-width width) (< curr-width prev-width)) -- cgit v1.2.1 From 7f7def2ae62c80fa2fd0c73087b59060b303c230 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 24 Dec 2022 14:48:50 -0800 Subject: ; Add treesit-no-parser error * lisp/treesit.el (treesit-no-parser): New error. (treesit-buffer-root-node): Use the new error. --- lisp/treesit.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 845e6ab3883..3d9c61b9dc9 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -141,6 +141,9 @@ parser in `treesit-parser-list', or nil if there is no parser." ;;; Node API supplement +(define-error 'treesit-no-parser "No available parser for this buffer" + 'treesit-error) + (defun treesit-node-buffer (node) "Return the buffer in which NODE belongs." (treesit-parser-buffer @@ -248,11 +251,10 @@ Use the first parser in `treesit-parser-list'. If optional argument LANGUAGE is non-nil, use the first parser for LANGUAGE." (if-let ((parser - (or (if language - (treesit-parser-create language) - (or (car (treesit-parser-list)) - (signal 'treesit-error - '("Buffer has no parser"))))))) + (if language + (treesit-parser-create language) + (or (car (treesit-parser-list)) + (signal 'treesit-no-parser (list (current-buffer))))))) (treesit-parser-root-node parser))) (defun treesit-filter-child (node pred &optional named) -- cgit v1.2.1 From 35c2ca2ca64070f6ebc75011e5e6e2d688124bec Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 24 Dec 2022 15:31:03 -0800 Subject: Make treesit-node-at/on guess language at point If PARSER-OR-LANG is nil, it makes more sense to guess the language at point by treesit-language-at than to simply use the first parser in the parser list. * doc/lispref/parsing.texi (Retrieving Nodes): Update manual. * lisp/treesit.el (treesit-node-at) (treesit-node-on): Guess language at point. Update docstring. (treesit-buffer-root-node): Update docstring. --- lisp/treesit.el | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 3d9c61b9dc9..2b30da4be7a 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -171,13 +171,15 @@ before POS. Return nil if no leaf node can be returned. If NAMED is non-nil, only look for named nodes. -If PARSER-OR-LANG is nil, use the first parser in -`treesit-parser-list'; if PARSER-OR-LANG is a parser, use -that parser; if PARSER-OR-LANG is a language, find a parser using -that language in the current buffer, and use that." +If PARSER-OR-LANG is a parser, use that parser; if PARSER-OR-LANG +is a language, find the first parser for that language in the +current buffer, or create one if none exists; If PARSER-OR-LANG +is nil, try to guess the language at POS by +`treesit-language-at'." (let* ((root (if (treesit-parser-p parser-or-lang) (treesit-parser-root-node parser-or-lang) - (treesit-buffer-root-node parser-or-lang))) + (treesit-buffer-root-node + (or parser-or-lang (treesit-language-at pos))))) (node root) (node-before root) (pos-1 (max (1- pos) (point-min))) @@ -219,13 +221,15 @@ to use `treesit-node-at' instead. Return nil if none was found. If NAMED is non-nil, only look for named node. -If PARSER-OR-LANG is nil, use the first parser in -`treesit-parser-list'; if PARSER-OR-LANG is a parser, use -that parser; if PARSER-OR-LANG is a language, find a parser using -that language in the current buffer, and use that." +If PARSER-OR-LANG is a parser, use that parser; if PARSER-OR-LANG +is a language, find the first parser for that language in the +current buffer, or create one if none exists; If PARSER-OR-LANG +is nil, try to guess the language at BEG by +`treesit-language-at'." (let ((root (if (treesit-parser-p parser-or-lang) (treesit-parser-root-node parser-or-lang) - (treesit-buffer-root-node parser-or-lang)))) + (treesit-buffer-root-node + (or parser-or-lang (treesit-language-at beg)))))) (treesit-node-descendant-for-range root beg (or end beg) named))) (defun treesit-node-top-level (node &optional type) @@ -246,10 +250,10 @@ regexp, rather than using NODE's type." (defun treesit-buffer-root-node (&optional language) "Return the root node of the current buffer. -Use the first parser in `treesit-parser-list'. -If optional argument LANGUAGE is non-nil, use the first parser -for LANGUAGE." +Use the first parser in the parser list if LANGUAGE is omitted. +If LANGUAGE is non-nil, use the first parser for LANGUAGE in the +parser list, or create one if none exists." (if-let ((parser (if language (treesit-parser-create language) -- cgit v1.2.1 From f8e219ebfaa286f4e7240640799020bb5b6e07b3 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 24 Dec 2022 16:33:35 -0800 Subject: Add treesit-defun-name and friends 1. We now have treesit-defun-name, powered by treesit-defun-name-function. 2. We now have treesit-add-log-current-defun, which powers add-log-current-defun. 3. c-ts-mode updates its code to take advantage of these new features. 4. Manual updates. * doc/lispref/parsing.texi (Tree-sitter major modes): Add manual for new functions. * lisp/progmodes/c-ts-mode.el (c-ts-mode--defun-name): New function. (c-ts-mode--imenu-1): Extract out into c-ts-mode--defun-name. (c-ts-base-mode): Setup treesit-defun-name-function. * lisp/treesit.el (treesit-defun-name-function) (treesit-add-log-defun-delimiter): New variables. (treesit-defun-at-point) (treesit-defun-name): New functions. (treesit-major-mode-setup): Setup add-log-current-defun-function. --- lisp/progmodes/c-ts-mode.el | 37 +++++++++++++++++++++---------------- lisp/treesit.el | 45 ++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 65 insertions(+), 17 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index d3291722331..28e99732fe2 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -481,6 +481,25 @@ For NODE, OVERRIDE, START, and END, see ;;; Imenu +(defun c-ts-mode--defun-name (node) + "Return the name of the defun NODE. +Return nil if NODE is not a defun node, return an empty string if +NODE doesn't have a name." + (treesit-node-text + (pcase (treesit-node-type node) + ("function_definition" + (treesit-node-child-by-field-name + (treesit-node-child-by-field-name node "declarator") + "declarator")) + ("declaration" + (let ((child (treesit-node-child node -1 t))) + (pcase (treesit-node-type child) + ("identifier" child) + (_ (treesit-node-child-by-field-name child "declarator"))))) + ("struct_specifier" + (treesit-node-child-by-field-name node "name"))) + t)) + (defun c-ts-mode--imenu-1 (node) "Helper for `c-ts-mode--imenu'. Find string representation for NODE and set marker, then recurse @@ -488,22 +507,7 @@ the subtrees." (let* ((ts-node (car node)) (subtrees (mapcan #'c-ts-mode--imenu-1 (cdr node))) (name (when ts-node - (treesit-node-text - (pcase (treesit-node-type ts-node) - ("function_definition" - (treesit-node-child-by-field-name - (treesit-node-child-by-field-name - ts-node "declarator") - "declarator")) - ("declaration" - (let ((child (treesit-node-child ts-node -1 t))) - (pcase (treesit-node-type child) - ("identifier" child) - (_ (treesit-node-child-by-field-name - child "declarator"))))) - ("struct_specifier" - (treesit-node-child-by-field-name - ts-node "name")))))) + (treesit-defun-name ts-node))) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -682,6 +686,7 @@ ARG is passed to `fill-paragraph'." "class_specifier")) #'c-ts-mode--defun-valid-p)) (setq-local treesit-defun-skipper #'c-ts-mode--defun-skipper) + (setq-local treesit-defun-name-function #'c-ts-mode--defun-name) ;; Nodes like struct/enum/union_specifier can appear in ;; function_definitions, so we need to find the top-level node. diff --git a/lisp/treesit.el b/lisp/treesit.el index 2b30da4be7a..355c6b6b99a 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1612,6 +1612,17 @@ newline after a defun, or the beginning of a defun. If the value is nil, no skipping is performed.") +(defvar-local treesit-defun-name-function nil + "A function called with a node and returns the name of it. +If the node is a defun node, return the defun name. E.g., the +function name of a function. If the node is not a defun node, or +the defun node doesn't have a name, or the node is nil, return +nil.") + +(defvar-local treesit-add-log-defun-delimiter "." + "The delimiter used to connect several defun names. +This is used in `treesit-add-log-current-defun'.") + (defun treesit-beginning-of-defun (&optional arg) "Move backward to the beginning of a defun. @@ -1885,6 +1896,34 @@ is `top-level', return the immediate parent defun if it is (if (eq treesit-defun-tactic 'top-level) (treesit--top-level-defun node regexp pred) node))) +(defun treesit-defun-name (node) + "Return the defun name of NODE. + +Return nil if there is no name, or if NODE is not a defun node, +or if NODE is nil. + +If `treesit-defun-name-function' is nil, always return nil." + (when treesit-defun-name-function + (funcall treesit-defun-name-function node))) + +(defun treesit-add-log-current-defun () + "Return the name of the defun at point. + +Used for `add-log-current-defun-function'. + +The delimiter between nested defun names is controlled by +`treesit-add-log-defun-delimiter'." + (let ((node (treesit-defun-at-point)) + (name nil)) + (while node + (when-let ((new-name (treesit-defun-name node))) + (if name + (setq name (concat new-name + treesit-add-log-defun-delimiter + name)) + (setq name new-name))) + (setq node (treesit-node-parent node))) + name)) ;;; Activating tree-sitter @@ -1979,7 +2018,11 @@ before calling this function." ;; the variables. In future we should update `end-of-defun' to ;; work with nested defuns. (setq-local beginning-of-defun-function #'treesit-beginning-of-defun) - (setq-local end-of-defun-function #'treesit-end-of-defun))) + (setq-local end-of-defun-function #'treesit-end-of-defun)) + ;; Defun name. + (when treesit-defun-name-function + (setq-local add-log-current-defun-function + #'treesit-add-log-current-defun))) ;;; Debugging -- cgit v1.2.1 From 6253184afc2e53c6782a41ec1b59779449152172 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 24 Dec 2022 16:40:00 -0800 Subject: ; * lisp/treesit.el (treesit-defun-at-point): Guard against nil. --- lisp/treesit.el | 42 ++++++++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 18 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 355c6b6b99a..09483acaa7d 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1690,7 +1690,9 @@ previous and next sibling defuns around POS, and PARENT is the parent defun surrounding POS. All of three could be nil if no sound defun exists. -REGEXP and PRED are the same as in `treesit-defun-type-regexp'." +REGEXP and PRED are the same as in `treesit-defun-type-regexp'. + +Assumes `treesit-defun-type-regexp' is set." (let* ((node (treesit-node-at pos)) ;; NODE-BEFORE/AFTER = NODE when POS is completely in NODE, ;; but if not, that means point could be in between two @@ -1876,26 +1878,30 @@ function is called recursively." ;; TODO: In corporate into thing-at-point. (defun treesit-defun-at-point () - "Return the defun at point or nil if none is found. + "Return the defun node at point or nil if none is found. Respects `treesit-defun-tactic': return the top-level defun if it is `top-level', return the immediate parent defun if it is -`nested'." - (pcase-let* ((`(,regexp . ,pred) - (if (consp treesit-defun-type-regexp) - treesit-defun-type-regexp - (cons treesit-defun-type-regexp nil))) - (`(,_ ,next ,parent) - (treesit--defuns-around (point) regexp pred)) - ;; If point is at the beginning of a defun, we - ;; prioritize that defun over the parent in nested - ;; mode. - (node (or (and (eq (treesit-node-start next) (point)) - next) - parent))) - (if (eq treesit-defun-tactic 'top-level) - (treesit--top-level-defun node regexp pred) - node))) +`nested'. + +Return nil if `treesit-defun-type-regexp' is not set." + (when treesit-defun-type-regexp + (pcase-let* ((`(,regexp . ,pred) + (if (consp treesit-defun-type-regexp) + treesit-defun-type-regexp + (cons treesit-defun-type-regexp nil))) + (`(,_ ,next ,parent) + (treesit--defuns-around (point) regexp pred)) + ;; If point is at the beginning of a defun, we + ;; prioritize that defun over the parent in nested + ;; mode. + (node (or (and (eq (treesit-node-start next) (point)) + next) + parent))) + (if (eq treesit-defun-tactic 'top-level) + (treesit--top-level-defun node regexp pred) + node)))) + (defun treesit-defun-name (node) "Return the defun name of NODE. -- cgit v1.2.1 From fbb4eb919b4c91dd8517a06934bf1f897eaa34bb Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 24 Dec 2022 18:24:01 -0800 Subject: Support treesit-defun-name in tree-sitter major modes * lisp/progmodes/csharp-mode.el (csharp-ts-mode--defun-name): New function. (csharp-ts-mode--imenu-1): Extract into new function. (csharp-ts-mode): Setup treesit-defun-name-function. * lisp/progmodes/java-ts-mode.el (java-ts-mode--defun-name): New function. (java-ts-mode--imenu-1): Extract into new function. (java-ts-mode): Setup treesit-defun-name-function. * lisp/progmodes/js.el (js-treesit-current-defun): Remove function. This function is not used (for a while already). (js--treesit-defun-name): New function. (js--treesit-imenu-1): Extract into new function. (js-ts-mode): Setup treesit-defun-name-function. * lisp/progmodes/json-ts-mode.el (json-ts-mode--defun-name): New function. (json-ts-mode--imenu-1): Extract into new function. (json-ts-mode): Setup treesit-defun-name-function. * lisp/progmodes/python.el (python--treesit-defun-name): New function. (python--imenu-treesit-create-index-1): Extract into new function. (python-ts-mode): Setup treesit-defun-name-function. * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--defun-name): New function. (rust-ts-mode--imenu-1): Extract into new function. (rust-ts-mode): Setup treesit-defun-name-function. * lisp/textmodes/css-mode.el (css--treesit-defun-name): New function. (css--treesit-imenu-1): Extract into new function. (css-ts-mode): Setup treesit-defun-name-function. * lisp/textmodes/toml-ts-mode.el (toml-ts-mode--get-table-name): Remove function. (toml-ts-mode--defun-name): New function. (toml-ts-mode--imenu-1): Extract into new function. (toml-ts-mode): Setup treesit-defun-name-function. --- lisp/progmodes/csharp-mode.el | 22 ++++++++++++++--- lisp/progmodes/java-ts-mode.el | 22 ++++++++++++++--- lisp/progmodes/js.el | 42 ++++++++++++-------------------- lisp/progmodes/json-ts-mode.el | 17 ++++++++++--- lisp/progmodes/python.el | 17 ++++++++++--- lisp/progmodes/rust-ts-mode.el | 55 +++++++++++++++++++++++------------------- lisp/textmodes/css-mode.el | 25 ++++++++++++------- lisp/textmodes/toml-ts-mode.el | 16 ++++++------ 8 files changed, 133 insertions(+), 83 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 2d13ae6930c..985e2e7b0bf 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -837,6 +837,22 @@ compilation and evaluation time conflicts." ;;;###autoload (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) +(defun csharp-ts-mode--defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (pcase (treesit-node-type node) + ((or "method_declaration" + "record_declaration" + "struct_declaration" + "enum_declaration" + "interface_declaration" + "class_declaration" + "class_declaration") + (treesit-node-text + (treesit-node-child-by-field-name + node "name") + t)))) + (defun csharp-ts-mode--imenu-1 (node) "Helper for `csharp-ts-mode--imenu'. Find string representation for NODE and set marker, then recurse @@ -844,10 +860,7 @@ the subtrees." (let* ((ts-node (car node)) (subtrees (mapcan #'csharp-ts-mode--imenu-1 (cdr node))) (name (when ts-node - (or (treesit-node-text - (or (treesit-node-child-by-field-name - ts-node "name")) - t) + (or (treesit-defun-name ts-node) "Unnamed node"))) (marker (when ts-node (set-marker (make-marker) @@ -935,6 +948,7 @@ Key bindings: ;; Navigation. (setq-local treesit-defun-type-regexp "declaration") + (setq-local treesit-defun-name-function #'csharp-ts-mode--defun-name) ;; Font-lock. (setq-local treesit-font-lock-settings csharp-ts-mode--font-lock-settings) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 9da2c254f87..3e0439ddf54 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -248,6 +248,22 @@ '((["," ":" ";"]) @font-lock-delimiter-face)) "Tree-sitter font-lock settings for `java-ts-mode'.") +(defun java-ts-mode--defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (pcase (treesit-node-type node) + ((or "method_declaration" + "class_declaration" + "record_declaration" + "interface_declaration" + "enum_declaration" + "import_declaration" + "package_declaration" + "module_declaration") + (treesit-node-text + (treesit-node-child-by-field-name node "name") + t)))) + (defun java-ts-mode--imenu-1 (node) "Helper for `java-ts-mode--imenu'. Find string representation for NODE and set marker, then recurse @@ -255,10 +271,7 @@ the subtrees." (let* ((ts-node (car node)) (subtrees (mapcan #'java-ts-mode--imenu-1 (cdr node))) (name (when ts-node - (or (treesit-node-text - (or (treesit-node-child-by-field-name - ts-node "name")) - t) + (or (treesit-defun-name ts-node) "Unnamed node"))) (marker (when ts-node (set-marker (make-marker) @@ -334,6 +347,7 @@ the subtrees." "import_declaration" "package_declaration" "module_declaration"))) + (setq-local treesit-defun-name-function #'java-ts-mode--defun-name) ;; Font-lock. (setq-local treesit-font-lock-settings java-ts-mode--font-lock-settings) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 1b34c0de418..14feed221fb 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3656,24 +3656,18 @@ OVERRIDE is the override flag described in (setq font-beg (treesit-node-end child) child (treesit-node-next-sibling child))))) -(defun js-treesit-current-defun () - "Return name of surrounding function. -This function can be used as a value in `which-func-functions'" - (let ((node (treesit-node-at (point))) - (name-list ())) - (cl-loop while node - if (pcase (treesit-node-type node) - ("function_declaration" t) - ("method_definition" t) - ("class_declaration" t) - ("variable_declarator" t) - (_ nil)) - do (push (treesit-node-text - (treesit-node-child-by-field-name node "name") - t) - name-list) - do (setq node (treesit-node-parent node)) - finally return (string-join name-list ".")))) +(defun js--treesit-defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (treesit-node-text + (treesit-node-child-by-field-name + (pcase (treesit-node-type node) + ("lexical_declaration" + (treesit-search-subtree node "variable_declarator" nil nil 1)) + ((or "function_declaration" "method_definition" "class_declaration") + node)) + "name") + t)) (defun js--treesit-imenu-1 (node) "Given a sparse tree, create an imenu alist. @@ -3702,15 +3696,8 @@ definition*\"." ("function_declaration" 'function))) ;; The root of the tree could have a nil ts-node. (name (when ts-node - (let ((ts-node-1 - (if (eq type 'variable) - (treesit-search-subtree - ts-node "variable_declarator" nil nil 1) - ts-node))) - (treesit-node-text - (treesit-node-child-by-field-name - ts-node-1 "name") - t)))) + (or (treesit-defun-name ts-node) + "Anonymous"))) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -3885,6 +3872,7 @@ Currently there are `js-mode' and `js-ts-mode'." "method_definition" "function_declaration" "lexical_declaration"))) + (setq-local treesit-defun-name-function #'js--treesit-defun-name) ;; Fontification. (setq-local treesit-font-lock-settings js--treesit-font-lock-settings) (setq-local treesit-font-lock-feature-list diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index 6c2f3805872..6725c5f2270 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -107,6 +107,16 @@ '((ERROR) @font-lock-warning-face)) "Font-lock settings for JSON.") +(defun json-ts-mode--defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (pcase (treesit-node-type node) + ((or "pair" "object") + (treesit-node-text + (treesit-node-child-by-field-name + node "key") + t)))) + (defun json-ts-mode--imenu-1 (node) "Helper for `json-ts-mode--imenu'. Find string representation for NODE and set marker, then recurse @@ -114,10 +124,8 @@ the subtrees." (let* ((ts-node (car node)) (subtrees (mapcan #'json-ts-mode--imenu-1 (cdr node))) (name (when ts-node - (treesit-node-text - (treesit-node-child-by-field-name - ts-node "key") - t))) + (or (treesit-defun-name ts-node) + "Anonymous"))) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -161,6 +169,7 @@ the subtrees." ;; Navigation. (setq-local treesit-defun-type-regexp (rx (or "pair" "object"))) + (setq-local treesit-defun-name-function #'json-ts-mode--defun-name) ;; Font-lock. (setq-local treesit-font-lock-settings json-ts-mode--font-lock-settings) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index bdc9e6fa78c..d383fa57c04 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5448,6 +5448,16 @@ To this: ;;; Tree-sitter imenu +(defun python--treesit-defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (pcase (treesit-node-type node) + ((or "function_definition" "class_definition") + (treesit-node-text + (treesit-node-child-by-field-name + node "name") + t)))) + (defun python--imenu-treesit-create-index-1 (node) "Given a sparse tree, create an imenu alist. @@ -5473,9 +5483,8 @@ definition*\"." ("class_definition" 'class))) ;; The root of the tree could have a nil ts-node. (name (when ts-node - (treesit-node-text - (treesit-node-child-by-field-name - ts-node "name") t))) + (or (treesit-defun-name ts-node) + "Anonymous"))) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -6643,6 +6652,8 @@ implementations: `python-mode' and `python-ts-mode'." #'python-imenu-treesit-create-index) (setq-local treesit-defun-type-regexp (rx (or "function" "class") "_definition")) + (setq-local treesit-defun-name-function + #'python--treesit-defun-name) (treesit-major-mode-setup) (when python-indent-guess-indent-offset diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 8b2ed191019..81f5b8765f1 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -273,6 +273,33 @@ (when struct-index `(("Struct" . ,struct-index))) (when func-index `(("Fn" . ,func-index)))))) +(defun rust-ts-mode--defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (pcase (treesit-node-type node) + ("enum_item" + (treesit-node-text + (treesit-node-child-by-field-name node "name") t)) + ("function_item" + (treesit-node-text + (treesit-node-child-by-field-name node "name") t)) + ("impl_item" + (let ((trait-node (treesit-node-child-by-field-name node "trait"))) + (concat + (treesit-node-text trait-node t) + (when trait-node " for ") + (treesit-node-text + (treesit-node-child-by-field-name node "type") t)))) + ("mod_item" + (treesit-node-text + (treesit-node-child-by-field-name node "name") t)) + ("struct_item" + (treesit-node-text + (treesit-node-child-by-field-name node "name") t)) + ("type_item" + (treesit-node-text + (treesit-node-child-by-field-name node "name") t)))) + (defun rust-ts-mode--imenu-1 (node) "Helper for `rust-ts-mode--imenu'. Find string representation for NODE and set marker, then recurse @@ -282,31 +309,8 @@ the subtrees." (subtrees (mapcan #'rust-ts-mode--imenu-1 children)) (name (when ts-node - (pcase (treesit-node-type ts-node) - ("enum_item" - (treesit-node-text - (treesit-node-child-by-field-name ts-node "name") t)) - ("function_item" - (treesit-node-text - (treesit-node-child-by-field-name ts-node "name") t)) - ("impl_item" - (let ((trait-node (treesit-node-child-by-field-name ts-node "trait"))) - (concat - (treesit-node-text - trait-node t) - (when trait-node - " for ") - (treesit-node-text - (treesit-node-child-by-field-name ts-node "type") t)))) - ("mod_item" - (treesit-node-text - (treesit-node-child-by-field-name ts-node "name") t)) - ("struct_item" - (treesit-node-text - (treesit-node-child-by-field-name ts-node "name") t)) - ("type_item" - (treesit-node-text - (treesit-node-child-by-field-name ts-node "name") t))))) + (or (treesit-defun-name ts-node) + "Anonymous"))) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -363,6 +367,7 @@ the subtrees." "function_item" "impl_item" "struct_item"))) + (setq-local treesit-defun-name-function #'rust-ts-mode--defun-name) (treesit-major-mode-setup))) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 822097a86d8..99ef4f10a06 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1412,6 +1412,19 @@ for determining whether point is within a selector." '((ERROR) @error)) "Tree-sitter font-lock settings for `css-ts-mode'.") +(defun css--treesit-defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (pcase (treesit-node-type node) + ("rule_set" (treesit-node-text + (treesit-node-child node 0) t)) + ("media_statement" + (let ((block (treesit-node-child node -1))) + (string-trim + (buffer-substring-no-properties + (treesit-node-start node) + (treesit-node-start block))))))) + (defun css--treesit-imenu-1 (node) "Helper for `css--treesit-imenu'. Find string representation for NODE and set marker, then recurse @@ -1419,15 +1432,8 @@ the subtrees." (let* ((ts-node (car node)) (subtrees (mapcan #'css--treesit-imenu-1 (cdr node))) (name (when ts-node - (pcase (treesit-node-type ts-node) - ("rule_set" (treesit-node-text - (treesit-node-child ts-node 0) t)) - ("media_statement" - (let ((block (treesit-node-child ts-node -1))) - (string-trim - (buffer-substring-no-properties - (treesit-node-start ts-node) - (treesit-node-start block)))))))) + (or (treesit-defun-name ts-node) + "Anonymous"))) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -1835,6 +1841,7 @@ can also be used to fill comments. (treesit-parser-create 'css) (setq-local treesit-simple-indent-rules css--treesit-indent-rules) (setq-local treesit-defun-type-regexp "rule_set") + (setq-local treesit-defun-name-function #'css--treesit-defun-name) (setq-local treesit-font-lock-settings css--treesit-settings) (setq-local treesit-font-lock-feature-list '((selector comment query keyword) diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el index bca6a5e81ad..790de2133e8 100644 --- a/lisp/textmodes/toml-ts-mode.el +++ b/lisp/textmodes/toml-ts-mode.el @@ -107,12 +107,12 @@ '((ERROR) @font-lock-warning-face)) "Font-lock settings for TOML.") -(defun toml-ts-mode--get-table-name (node) - "Obtains the header-name for the associated tree-sitter `NODE'." - (if node - (treesit-node-text - (car (cdr (treesit-node-children node)))) - "Root table")) +(defun toml-ts-mode--defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (pcase (treesit-node-type node) + ((or "table" "table_array_element") + (car (cdr (treesit-node-children node)))))) (defun toml-ts-mode--imenu-1 (node) "Helper for `toml-ts-mode--imenu'. @@ -120,7 +120,8 @@ Find string representation for NODE and set marker, then recurse the subtrees." (let* ((ts-node (car node)) (subtrees (mapcan #'toml-ts-mode--imenu-1 (cdr node))) - (name (toml-ts-mode--get-table-name ts-node)) + (name (or (treesit-defun-name ts-node) + "Root table")) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -167,6 +168,7 @@ the subtrees." ;; Navigation. (setq-local treesit-defun-type-regexp (rx (or "table" "table_array_element"))) + (setq-local treesit-defun-name-function #'toml-ts-mode--defun-name) ;; Font-lock. (setq-local treesit-font-lock-settings toml-ts-mode--font-lock-settings) -- cgit v1.2.1 From a24e350170e84d564e510739c8ddf02a7b08f276 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 24 Dec 2022 18:45:36 -0800 Subject: Fix treesit--children-covering-range-recurse (bug#60301) * lisp/treesit.el (treesit--children-covering-range-recurse): Always return a list of node. --- lisp/treesit.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 09483acaa7d..0eacd4075f8 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -865,7 +865,7 @@ LIMIT is the recursion limit, which defaults to 100." (push child result)) (setq child (treesit-node-next-sibling child))) ;; If NODE has no child, keep NODE. - (or result node))) + (or result (list node)))) (defsubst treesit--node-length (node) "Return the length of the text of NODE." -- cgit v1.2.1 From c36fe3df17b37a705299239d6ef0185ad55b1d3a Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 24 Dec 2022 18:59:39 -0800 Subject: Fix c-ts-mode imenu defun name (bug#60296) Extract out c-ts-mode--declarator-identifier from c-ts-mode--fontify-declarator. * lisp/progmodes/c-ts-mode.el (c-ts-mode--declarator-identifier): New function. (c-ts-mode--fontify-defun): Extract out. (c-ts-mode--defun-name): Use the new function. --- lisp/progmodes/c-ts-mode.el | 50 ++++++++++++++++++++++----------------------- 1 file changed, 24 insertions(+), 26 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 28e99732fe2..5fc44b11e14 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -387,28 +387,32 @@ MODE is either `c' or `cpp'." ;;; Font-lock helpers -(defun c-ts-mode--fontify-declarator (node override start end &rest args) - "Fontify a declarator (whatever under the \"declarator\" field). -For NODE, OVERRIDE, START, END, and ARGS, see -`treesit-font-lock-rules'." +(defun c-ts-mode--declarator-identifier (node) + "Return the identifier of the declarator node NODE." (pcase (treesit-node-type node) + ;; Recurse. ((or "attributed_declarator" "parenthesized_declarator") - (apply #'c-ts-mode--fontify-declarator - (treesit-node-child node 0 t) override start end args)) + (c-ts-mode--declarator-identifier (treesit-node-child node 0 t))) ("pointer_declarator" - (apply #'c-ts-mode--fontify-declarator - (treesit-node-child node -1) override start end args)) + (c-ts-mode--declarator-identifier (treesit-node-child node -1))) ((or "function_declarator" "array_declarator" "init_declarator") - (apply #'c-ts-mode--fontify-declarator - (treesit-node-child-by-field-name node "declarator") - override start end args)) + (c-ts-mode--declarator-identifier + (treesit-node-child-by-field-name node "declarator"))) + ;; Terminal case. ((or "identifier" "field_identifier") - (treesit-fontify-with-override - (treesit-node-start node) (treesit-node-end node) - (pcase (treesit-node-type (treesit-node-parent node)) - ("function_declarator" 'font-lock-function-name-face) - (_ 'font-lock-variable-name-face)) - override start end)))) + node))) + +(defun c-ts-mode--fontify-declarator (node override start end &rest args) + "Fontify a declarator (whatever under the \"declarator\" field). +For NODE, OVERRIDE, START, END, and ARGS, see +`treesit-font-lock-rules'." + (let* ((identifier (c-ts-mode--declarator-identifier node)) + (face (pcase (treesit-node-type (treesit-node-parent identifier)) + ("function_declarator" 'font-lock-function-name-face) + (_ 'font-lock-variable-name-face)))) + (treesit-fontify-with-override + (treesit-node-start identifier) (treesit-node-end identifier) + face override start end))) (defun c-ts-mode--fontify-variable (node override start end &rest _) "Fontify an identifier node if it is a variable. @@ -487,15 +491,9 @@ Return nil if NODE is not a defun node, return an empty string if NODE doesn't have a name." (treesit-node-text (pcase (treesit-node-type node) - ("function_definition" - (treesit-node-child-by-field-name - (treesit-node-child-by-field-name node "declarator") - "declarator")) - ("declaration" - (let ((child (treesit-node-child node -1 t))) - (pcase (treesit-node-type child) - ("identifier" child) - (_ (treesit-node-child-by-field-name child "declarator"))))) + ((or "function_definition" "declaration") + (c-ts-mode--declarator-identifier + (treesit-node-child-by-field-name node "declarator"))) ("struct_specifier" (treesit-node-child-by-field-name node "name"))) t)) -- cgit v1.2.1 From ecee3bd4209811118bb3d8ad90e6d1a5acfccc85 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 25 Dec 2022 09:29:47 +0200 Subject: ; Fix recent changes in treesit documentation * lisp/treesit.el (treesit-defun-name-function, treesit-node-at) (treesit-node-on): Doc fixes. * doc/lispref/parsing.texi (Tree-sitter major modes): Fix wording, punctuation, and indexing. (Retrieving Nodes): Fix wording and add cross-references. --- lisp/treesit.el | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 0eacd4075f8..5ec6f90afa3 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -174,8 +174,7 @@ only look for named nodes. If PARSER-OR-LANG is a parser, use that parser; if PARSER-OR-LANG is a language, find the first parser for that language in the current buffer, or create one if none exists; If PARSER-OR-LANG -is nil, try to guess the language at POS by -`treesit-language-at'." +is nil, try to guess the language at POS using `treesit-language-at'." (let* ((root (if (treesit-parser-p parser-or-lang) (treesit-parser-root-node parser-or-lang) (treesit-buffer-root-node @@ -224,8 +223,7 @@ named node. If PARSER-OR-LANG is a parser, use that parser; if PARSER-OR-LANG is a language, find the first parser for that language in the current buffer, or create one if none exists; If PARSER-OR-LANG -is nil, try to guess the language at BEG by -`treesit-language-at'." +is nil, try to guess the language at BEG using `treesit-language-at'." (let ((root (if (treesit-parser-p parser-or-lang) (treesit-parser-root-node parser-or-lang) (treesit-buffer-root-node @@ -1613,8 +1611,8 @@ newline after a defun, or the beginning of a defun. If the value is nil, no skipping is performed.") (defvar-local treesit-defun-name-function nil - "A function called with a node and returns the name of it. -If the node is a defun node, return the defun name. E.g., the + "A function that is called with a node and returns its defun name or nil. +If the node is a defun node, return the defun name, e.g., the function name of a function. If the node is not a defun node, or the defun node doesn't have a name, or the node is nil, return nil.") -- cgit v1.2.1 From 7bc7b6b4dd9dde10d08eb421a98f6d19fcfbfa1a Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Mon, 19 Dec 2022 17:00:36 +0100 Subject: ; Partial revert of f3e7820b * lisp/emacs-lisp/package.el (package-install-from-archive): Check if a package is a directory package, not a VC package --- lisp/emacs-lisp/package.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 4d33311cb74..73c4f896a49 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2094,7 +2094,7 @@ if all the in-between dependencies are also in PACKAGE-LIST." (defun package-install-from-archive (pkg-desc) "Download and install a package defined by PKG-DESC." ;; This won't happen, unless the archive is doing something wrong. - (when (package-vc-p pkg-desc) + (when (eq (package-desc-kind pkg-desc) 'dir) (error "Can't install directory package from archive")) (let* ((location (package-archive-base pkg-desc)) (file (concat (package-desc-full-name pkg-desc) -- cgit v1.2.1 From b38e56d8a98d9488ed6ae16521334c25304153ca Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 25 Dec 2022 09:35:36 +0100 Subject: Handle missing dependencies for source packages * lisp/emacs-lisp/package-vc.el (package-vc-install-dependencies): Add new function. (package-vc--unpack-1): Call 'package-vc-install-dependencies' instead of 'package-compute-transaction' and 'package-download-transaction'. It is unreasonable to abort the installation, since we cannot expect all dependencies to be available in the regular archives. Instead we note which packages couldn't be found, and warn the user that these will be missing. --- lisp/emacs-lisp/package-vc.el | 231 ++++++++++++++++++++++++++---------------- 1 file changed, 144 insertions(+), 87 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index 8f0eedd2f88..17c37aa5172 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -406,99 +406,156 @@ otherwise it's assumed to be an Info file." (when clean-up (delete-file file)))) +(defun package-vc-install-dependencies (requirements) + "Install missing dependencies, and return missing ones. +The return value will be nil if everything was found, or a list +of (NAME VERSION) pairs of all packages that couldn't be found. + +REQUIREMENTS should be a list of additional requirements; each +element in this list should have the form (PACKAGE VERSION-LIST), +where PACKAGE is a package name and VERSION-LIST is the required +version of that package." + (let ((to-install '()) (missing '())) + (cl-labels ((search (pkg) + "Attempt to find all dependencies for PKG." + (cond + ((assq (car pkg) to-install)) ;inhibit cycles + ((package-installed-p (car pkg))) + ((let* ((pac package-archive-contents) + (desc (cadr (assoc (car pkg) pac)))) + (if desc + (let ((reqs (package-desc-reqs pkg))) + (push pkg to-install) + (mapc #'search reqs)) + (push pkg missing)))))) + (version-order (a b) + "Predicate to sort packages in order." + (version-list-< (cadr b) (cadr a))) + (duplicate-p (a b) + "Are A and B the same package?" + (eq (car a) (car b))) + (depends-on-p (target package) + "Does PACKAGE depend on TARGET?" + (or (eq target package) + (let* ((pac package-archive-contents) + (desc (cadr (assoc package pac)))) + (seq-some + (apply-partially #'depends-on-p target) + (package-desc-reqs desc))))) + (dependent-order (a b) + (or (not (depends-on-p (car b) (car a))) + (depends-on-p (car a) (car b))))) + (mapc #'search requirements) + (cl-callf sort to-install #'version-order) + (cl-callf seq-uniq to-install #'duplicate-p) + (cl-callf sort to-install #'dependent-order)) + (mapc #'package-install-from-archive to-install) + missing)) + (defun package-vc--unpack-1 (pkg-desc pkg-dir) "Prepare PKG-DESC that is already checked-out in PKG-DIR. This includes downloading missing dependencies, generating autoloads, generating a package description file (used to identify a package as a VC package later on), building documentation and marking the package as installed." - ;; Remove any previous instance of PKG-DESC from `package-alist' - (let ((pkgs (assq (package-desc-name pkg-desc) package-alist))) - (when pkgs - (setf (cdr pkgs) (seq-remove #'package-vc-p (cdr pkgs))))) - - ;; In case the package was installed directly from source, the - ;; dependency list wasn't know beforehand, and they might have - ;; to be installed explicitly. - (let ((deps '())) - (dolist (file (directory-files pkg-dir t "\\.el\\'" t)) - (with-temp-buffer - (insert-file-contents file) - (when-let* ((require-lines (lm-header-multiline "package-requires"))) - (thread-last - (mapconcat #'identity require-lines " ") - package-read-from-string - package--prepare-dependencies - (nconc deps) - (setq deps))))) - (dolist (dep deps) - (cl-callf version-to-list (cadr dep))) - (package-download-transaction - (package-compute-transaction nil (delete-dups deps)))) - - (let ((default-directory (file-name-as-directory pkg-dir)) - (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir))) - ;; Generate autoloads - (let* ((name (package-desc-name pkg-desc)) - (auto-name (format "%s-autoloads.el" name)) - (extras (package-desc-extras pkg-desc)) - (lisp-dir (alist-get :lisp-dir extras))) - (package-generate-autoloads - name (file-name-concat pkg-dir lisp-dir)) - (when lisp-dir - (write-region - (with-temp-buffer - (insert ";; Autoload indirection for package-vc\n\n") - (prin1 `(load (expand-file-name - ,(file-name-concat lisp-dir auto-name) - (or (and load-file-name - (file-name-directory load-file-name)) - (car load-path)))) - (current-buffer)) - (buffer-string)) - nil (expand-file-name auto-name pkg-dir)))) - - ;; Generate package file - (package-vc--generate-description-file pkg-desc pkg-file) - - ;; Detect a manual - (when-let ((pkg-spec (package-vc--desc->spec pkg-desc)) - ((executable-find "install-info"))) - (dolist (doc-file (ensure-list (plist-get pkg-spec :doc))) - (package-vc--build-documentation pkg-desc doc-file)))) - - ;; Update package-alist. - (let ((new-desc (package-load-descriptor pkg-dir))) - ;; Activation has to be done before compilation, so that if we're - ;; upgrading and macros have changed we load the new definitions - ;; before compiling. - (when (package-activate-1 new-desc :reload :deps) - ;; FIXME: Compilation should be done as a separate, optional, step. - ;; E.g. for multi-package installs, we should first install all packages - ;; and then compile them. - (package--compile new-desc) - (when package-native-compile - (package--native-compile-async new-desc)) - ;; After compilation, load again any files loaded by - ;; `activate-1', so that we use the byte-compiled definitions. - (package--reload-previously-loaded new-desc))) - - ;; Mark package as selected - (package--save-selected-packages - (cons (package-desc-name pkg-desc) - package-selected-packages)) - (package--quickstart-maybe-refresh) - - ;; Confirm that the installation was successful - (let ((main-file (package-vc--main-file pkg-desc))) - (message "VC package `%s' installed (Version %s, Revision %S)." - (package-desc-name pkg-desc) - (lm-with-file main-file - (package-strip-rcs-id - (or (lm-header "package-version") - (lm-header "version")))) - (vc-working-revision main-file))) - t) + (let (missing) + ;; Remove any previous instance of PKG-DESC from `package-alist' + (let ((pkgs (assq (package-desc-name pkg-desc) package-alist))) + (when pkgs + (setf (cdr pkgs) (seq-remove #'package-vc-p (cdr pkgs))))) + + ;; In case the package was installed directly from source, the + ;; dependency list wasn't know beforehand, and they might have + ;; to be installed explicitly. + (let ((deps '())) + (dolist (file (directory-files pkg-dir t "\\.el\\'" t)) + (with-temp-buffer + (insert-file-contents file) + (when-let* ((require-lines (lm-header-multiline "package-requires"))) + (thread-last + (mapconcat #'identity require-lines " ") + package-read-from-string + package--prepare-dependencies + (nconc deps) + (setq deps))))) + (dolist (dep deps) + (cl-callf version-to-list (cadr dep))) + (setf missing (package-vc-install-dependencies (delete-dups deps))) + (setf missing (delq (assq (package-desc-name pkg-desc) + missing) + missing))) + + (let ((default-directory (file-name-as-directory pkg-dir)) + (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir))) + ;; Generate autoloads + (let* ((name (package-desc-name pkg-desc)) + (auto-name (format "%s-autoloads.el" name)) + (extras (package-desc-extras pkg-desc)) + (lisp-dir (alist-get :lisp-dir extras))) + (package-generate-autoloads + name (file-name-concat pkg-dir lisp-dir)) + (when lisp-dir + (write-region + (with-temp-buffer + (insert ";; Autoload indirection for package-vc\n\n") + (prin1 `(load (expand-file-name + ,(file-name-concat lisp-dir auto-name) + (or (and load-file-name + (file-name-directory load-file-name)) + (car load-path)))) + (current-buffer)) + (buffer-string)) + nil (expand-file-name auto-name pkg-dir)))) + + ;; Generate package file + (package-vc--generate-description-file pkg-desc pkg-file) + + ;; Detect a manual + (when-let ((pkg-spec (package-vc--desc->spec pkg-desc)) + ((executable-find "install-info"))) + (dolist (doc-file (ensure-list (plist-get pkg-spec :doc))) + (package-vc--build-documentation pkg-desc doc-file)))) + + ;; Update package-alist. + (let ((new-desc (package-load-descriptor pkg-dir))) + ;; Activation has to be done before compilation, so that if we're + ;; upgrading and macros have changed we load the new definitions + ;; before compiling. + (when (package-activate-1 new-desc :reload :deps) + ;; FIXME: Compilation should be done as a separate, optional, step. + ;; E.g. for multi-package installs, we should first install all packages + ;; and then compile them. + (package--compile new-desc) + (when package-native-compile + (package--native-compile-async new-desc)) + ;; After compilation, load again any files loaded by + ;; `activate-1', so that we use the byte-compiled definitions. + (package--reload-previously-loaded new-desc))) + + ;; Mark package as selected + (package--save-selected-packages + (cons (package-desc-name pkg-desc) + package-selected-packages)) + (package--quickstart-maybe-refresh) + + ;; Confirm that the installation was successful + (let ((main-file (package-vc--main-file pkg-desc))) + (message "VC package `%s' installed (Version %s, Revision %S).%s" + (package-desc-name pkg-desc) + (lm-with-file main-file + (package-strip-rcs-id + (or (lm-header "package-version") + (lm-header "version")))) + (vc-working-revision main-file) + (if missing + (format + " Failed to install the following dependencies: %s" + (mapconcat + (lambda (p) + (format "%s (%s)" (car p) (cadr p))) + missing ", ")) + ""))) + t)) (defun package-vc--guess-backend (url) "Guess the VC backend for URL. -- cgit v1.2.1 From e8b34109eeb136bdab5b970600214cf1fc92ca0c Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 25 Dec 2022 09:53:07 +0100 Subject: Reorder optional arguments to 'package-vc-install' * lisp/emacs-lisp/package-vc.el (package-vc-install-selected-packages): Update 'package-vc-install' invocation. (package-vc-install): Reorder and update documentation. --- lisp/emacs-lisp/package-vc.el | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index 17c37aa5172..bf6c822a2b5 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -131,7 +131,7 @@ the `clone' function." ((null spec) (package-vc-install name)) ((stringp spec) - (package-vc-install name nil spec)) + (package-vc-install name spec)) ((listp spec) (package-vc--archives-initialize) (package-vc--unpack (cadr pkg-descs) spec))))))) @@ -718,7 +718,7 @@ If no such revision can be found, return nil." (line-number-at-pos nil t)))))))) ;;;###autoload -(defun package-vc-install (package &optional name rev backend) +(defun package-vc-install (package &optional rev backend name) "Fetch a PACKAGE and set it up for using with Emacs. If PACKAGE is a string containing an URL, download the package @@ -742,7 +742,9 @@ the package's repository; this is only possible if NAME-OR-URL is a URL, a string. If BACKEND is omitted or nil, the function uses `package-vc-heuristic-alist' to guess the backend. Note that by default, a VC package will be prioritized over a -regular package, but it will not remove a VC package." +regular package, but it will not remove a VC package. + +\(fn PACKAGE &optional REV BACKEND)" (interactive (progn ;; Initialize the package system to get the list of package @@ -751,8 +753,10 @@ regular package, but it will not remove a VC package." (let* ((name-or-url (package-vc--read-package-name "Fetch and install package: " t)) (name (file-name-base name-or-url))) - (list name-or-url (intern (string-remove-prefix "emacs-" name)) - (and current-prefix-arg :last-release))))) + (list name-or-url + (and current-prefix-arg :last-release) + nil + (intern (string-remove-prefix "emacs-" name)))))) (package-vc--archives-initialize) (cond ((null package) -- cgit v1.2.1 From a819ca5a93c56f7647940f6e8ef05503eecf4e9e Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 24 Dec 2022 20:17:08 -0800 Subject: Generalize treesit-defun functions to "things" Change the "defun" in some functions (e.g. treesit--defuns-around) to "thing". Add a function treesit-thing-at-point. * lisp/treesit.el (treesit--thing-unpack-pattern): New subroutine. (treesit-beginning-of-defun) (treesit-end-of-defun): Use new function treesit--navigate-thing. (treesit--defuns-around): Generalize into treesit--thing-around. (treesit--top-level-defun): Generalize into treesit--top-level-thing. (treesit--navigate-defun): Generalize into treesit--navigate-thing. (treesit-thing-at-point): Generalized from treesit-defun-at-point. (treesit-defun-at-point): Use treesit-thing-at-point to do tht work. --- lisp/treesit.el | 128 ++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 77 insertions(+), 51 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 5ec6f90afa3..40e70f47f59 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1621,6 +1621,17 @@ nil.") "The delimiter used to connect several defun names. This is used in `treesit-add-log-current-defun'.") +(defsubst treesit--thing-unpack-pattern (pattern) + "Unpack PATTERN in the shape of `treesit-defun-type-regexp'. + +Basically, + + (unpack REGEXP) = (REGEXP . nil) + (unpack (REGEXP . PRED)) = (REGEXP . PRED)" + (if (consp pattern) + pattern + (cons pattern nil))) + (defun treesit-beginning-of-defun (&optional arg) "Move backward to the beginning of a defun. @@ -1633,12 +1644,16 @@ This is a tree-sitter equivalent of `beginning-of-defun'. Behavior of this function depends on `treesit-defun-type-regexp' and `treesit-defun-skipper'." (interactive "^p") - (when-let* ((arg (or arg 1)) - (dest (treesit--navigate-defun (point) (- arg) 'beg))) - (goto-char dest) - (when treesit-defun-skipper - (funcall treesit-defun-skipper)) - t)) + (pcase-let* ((arg (or arg 1)) + (`(,regexp . ,pred) + (treesit--thing-unpack-pattern treesit-defun-type-regexp)) + (dest (treesit--navigate-thing + (point) (- arg) 'beg regexp pred))) + (when dest + (goto-char dest) + (when treesit-defun-skipper + (funcall treesit-defun-skipper)) + t))) (defun treesit-end-of-defun (&optional arg _) "Move forward to next end of defun. @@ -1650,11 +1665,15 @@ This is a tree-sitter equivalent of `end-of-defun'. Behavior of this function depends on `treesit-defun-type-regexp' and `treesit-defun-skipper'." (interactive "^p\nd") - (when-let* ((arg (or arg 1)) - (dest (treesit--navigate-defun (point) arg 'end))) - (goto-char dest) - (when treesit-defun-skipper - (funcall treesit-defun-skipper)))) + (pcase-let* ((arg (or arg 1)) + (`(,regexp . ,pred) + (treesit--thing-unpack-pattern treesit-defun-type-regexp)) + (dest (treesit--navigate-thing + (point) arg 'end regexp pred))) + (when dest + (goto-char dest) + (when treesit-defun-skipper + (funcall treesit-defun-skipper))))) (defun treesit-default-defun-skipper () "Skips spaces after navigating a defun. @@ -1680,17 +1699,15 @@ the current line if the beginning of the defun is indented." ;; parent: ;; 1. node covers pos ;; 2. smallest such node -(defun treesit--defuns-around (pos regexp &optional pred) - "Return the previous, next, and parent defun around POS. +(defun treesit--things-around (pos regexp &optional pred) + "Return the previous, next, and parent thing around POS. Return a list of (PREV NEXT PARENT), where PREV and NEXT are -previous and next sibling defuns around POS, and PARENT is the -parent defun surrounding POS. All of three could be nil if no -sound defun exists. +previous and next sibling things around POS, and PARENT is the +parent thing surrounding POS. All of three could be nil if no +sound things exists. -REGEXP and PRED are the same as in `treesit-defun-type-regexp'. - -Assumes `treesit-defun-type-regexp' is set." +REGEXP and PRED are the same as in `treesit-thing-at-point'." (let* ((node (treesit-node-at pos)) ;; NODE-BEFORE/AFTER = NODE when POS is completely in NODE, ;; but if not, that means point could be in between two @@ -1750,9 +1767,9 @@ Assumes `treesit-defun-type-regexp' is set." return cursor)) result)) -(defun treesit--top-level-defun (node regexp &optional pred) - "Return the top-level parent defun of NODE. -REGEXP and PRED are the same as in `treesit-defun-type-regexp'." +(defun treesit--top-level-thing (node regexp &optional pred) + "Return the top-level parent thing of NODE. +REGEXP and PRED are the same as in `treesit-thing-at-point'." (let* ((pred (or pred (lambda (_) t)))) ;; `treesit-search-forward-goto' will make sure the matched node ;; is before POS. @@ -1792,25 +1809,23 @@ REGEXP and PRED are the same as in `treesit-defun-type-regexp'." ;; -> Obviously we don't want to go to parent's end, instead, we ;; want to go to parent's prev-sibling's end. Again, we recurse ;; in the function to do that. -(defun treesit--navigate-defun (pos arg side &optional recursing) - "Navigate defun ARG steps from POS. +(defun treesit--navigate-thing (pos arg side regexp &optional pred recursing) + "Navigate thing ARG steps from POS. If ARG is positive, move forward that many steps, if negative, move backward. If SIDE is `beg', stop at the beginning of a -defun, if SIDE is `end', stop at the end. +thing, if SIDE is `end', stop at the end. This function doesn't actually move point, it just returns the -position it would move to. If there aren't enough defuns to move +position it would move to. If there aren't enough things to move across, return nil. +REGEXP and PRED are the same as in `treesit-thing-at-point'. + RECURSING is an internal parameter, if non-nil, it means this function is called recursively." (pcase-let* ((counter (abs arg)) - (`(,regexp . ,pred) - (if (consp treesit-defun-type-regexp) - treesit-defun-type-regexp - (cons treesit-defun-type-regexp nil))) ;; Move POS to the beg/end of NODE. If NODE is nil, terminate. ;; Return the position we moved to. (advance (lambda (node) @@ -1824,13 +1839,13 @@ function is called recursively." (while (> counter 0) (pcase-let ((`(,prev ,next ,parent) - (treesit--defuns-around pos regexp pred))) + (treesit--things-around pos regexp pred))) ;; When PARENT is nil, nested and top-level are the same, if ;; there is a PARENT, make PARENT to be the top-level parent ;; and pretend there is no nested PREV and NEXT. (when (and (eq treesit-defun-tactic 'top-level) parent) - (setq parent (treesit--top-level-defun + (setq parent (treesit--top-level-thing parent regexp pred) prev nil next nil)) @@ -1851,9 +1866,9 @@ function is called recursively." ;; (recursing) until we got out of the parents until ;; (1) there is a next sibling defun, or (2) no more ;; parents [2]. - (setq pos (or (treesit--navigate-defun + (setq pos (or (treesit--navigate-thing (treesit-node-end (or next parent)) - 1 'beg t) + 1 'beg regexp pred t) (throw 'term nil))) ;; Normal case. (setq pos (funcall advance (or next parent)))) @@ -1863,9 +1878,9 @@ function is called recursively." (parent t) (t nil))) ;; Special case: go to prev end-of-defun. - (setq pos (or (treesit--navigate-defun + (setq pos (or (treesit--navigate-thing (treesit-node-start (or prev parent)) - -1 'end t) + -1 'end regexp pred t) (throw 'term nil))) ;; Normal case. (setq pos (funcall advance (or prev parent))))) @@ -1875,6 +1890,28 @@ function is called recursively." (if (eq counter 0) pos nil))) ;; TODO: In corporate into thing-at-point. +(defun treesit-thing-at-point (regexp tactic &optional pred) + "Return the thing node at point or nil if none is found. + +\"Thing\" is defined by REGEXP: if a node's type matches REGEXP, +it is a thing. The \"thing\" could be further restricted by +PRED: if non-nil, PRED should be a function that takes a node and +returns t if the node is a \"thing\", and nil if not. + +Return the top-level defun if TACTIC is `top-level', return the +immediate parent thing if TACTIC is `nested'." + (pcase-let* ((`(,_ ,next ,parent) + (treesit--things-around (point) regexp pred)) + ;; If point is at the beginning of a thing, we + ;; prioritize that thing over the parent in nested + ;; mode. + (node (or (and (eq (treesit-node-start next) (point)) + next) + parent))) + (if (eq tactic 'top-level) + (treesit--top-level-thing node regexp pred) + node))) + (defun treesit-defun-at-point () "Return the defun node at point or nil if none is found. @@ -1884,21 +1921,10 @@ is `top-level', return the immediate parent defun if it is Return nil if `treesit-defun-type-regexp' is not set." (when treesit-defun-type-regexp - (pcase-let* ((`(,regexp . ,pred) - (if (consp treesit-defun-type-regexp) - treesit-defun-type-regexp - (cons treesit-defun-type-regexp nil))) - (`(,_ ,next ,parent) - (treesit--defuns-around (point) regexp pred)) - ;; If point is at the beginning of a defun, we - ;; prioritize that defun over the parent in nested - ;; mode. - (node (or (and (eq (treesit-node-start next) (point)) - next) - parent))) - (if (eq treesit-defun-tactic 'top-level) - (treesit--top-level-defun node regexp pred) - node)))) + (pcase-let ((`(,regexp . ,pred) + (treesit--thing-unpack-pattern + treesit-defun-type-regexp))) + (treesit-thing-at-point regexp treesit-defun-tactic pred)))) (defun treesit-defun-name (node) "Return the defun name of NODE. -- cgit v1.2.1 From 79584a206b9b36e4937c32845464bfc9b438dade Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 24 Dec 2022 22:08:17 -0800 Subject: Further generalize treesit-defun functions Two new functions, treesit-beginning/end-of-thing. And treesit-thing-at-point's signature changes. * lisp/treesit.el (treesit-block-type-regexp): New variable. (treesit-beginning-of-thing) (treesit-end-of-thing): Generalized from treesit-beginning/end-of-defun. (treesit-beginning-of-defun) (treesit-end-of-defun): Use the new functions. (treesit-thing-at-point): Accept PATTERN rather than REGEXP and PRED. (treesit-defun-at-point): Adjust for the new signature of treesit-thing-at-point. --- lisp/treesit.el | 82 ++++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 52 insertions(+), 30 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 40e70f47f59..e8e93d09de4 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1582,7 +1582,7 @@ BACKWARD and ALL are the same as in `treesit-search-forward'." (goto-char current-pos))) node)) -;;; Navigation +;;; Navigation, defun, things (defvar-local treesit-defun-type-regexp nil "A regexp that matches the node type of defun nodes. @@ -1596,6 +1596,9 @@ for invalid node. This is used by `treesit-beginning-of-defun' and friends.") +(defvar-local treesit-block-type-regexp nil + "Like `treesit-defun-type-regexp', but for blocks.") + (defvar-local treesit-defun-tactic 'nested "Determines how does Emacs treat nested defuns. If the value is `top-level', Emacs only moves across top-level @@ -1632,6 +1635,36 @@ Basically, pattern (cons pattern nil))) +(defun treesit-beginning-of-thing (pattern &optional arg) + "Like `beginning-of-defun', but generalized into things. + +PATTERN is like `treesit-defun-type-regexp', ARG +is the same as in `beginning-of-defun'. + +Return non-nil if successfully moved, nil otherwise." + (pcase-let* ((arg (or arg 1)) + (`(,regexp . ,pred) (treesit--thing-unpack-pattern + pattern)) + (dest (treesit--navigate-thing + (point) (- arg) 'beg regexp pred))) + (when dest + (goto-char dest)))) + +(defun treesit-end-of-thing (pattern &optional arg) + "Like `end-of-defun', but generalized into things. + +PATTERN is like `treesit-defun-type-regexp', ARG is the same as +in `end-of-defun'. + +Return non-nil if successfully moved, nil otherwise." + (pcase-let* ((arg (or arg 1)) + (`(,regexp . ,pred) (treesit--thing-unpack-pattern + pattern)) + (dest (treesit--navigate-thing + (point) arg 'end regexp pred))) + (when dest + (goto-char dest)))) + (defun treesit-beginning-of-defun (&optional arg) "Move backward to the beginning of a defun. @@ -1644,16 +1677,10 @@ This is a tree-sitter equivalent of `beginning-of-defun'. Behavior of this function depends on `treesit-defun-type-regexp' and `treesit-defun-skipper'." (interactive "^p") - (pcase-let* ((arg (or arg 1)) - (`(,regexp . ,pred) - (treesit--thing-unpack-pattern treesit-defun-type-regexp)) - (dest (treesit--navigate-thing - (point) (- arg) 'beg regexp pred))) - (when dest - (goto-char dest) - (when treesit-defun-skipper - (funcall treesit-defun-skipper)) - t))) + (when (treesit-beginning-of-thing treesit-defun-type-regexp arg) + (when treesit-defun-skipper + (funcall treesit-defun-skipper)) + t)) (defun treesit-end-of-defun (&optional arg _) "Move forward to next end of defun. @@ -1665,15 +1692,9 @@ This is a tree-sitter equivalent of `end-of-defun'. Behavior of this function depends on `treesit-defun-type-regexp' and `treesit-defun-skipper'." (interactive "^p\nd") - (pcase-let* ((arg (or arg 1)) - (`(,regexp . ,pred) - (treesit--thing-unpack-pattern treesit-defun-type-regexp)) - (dest (treesit--navigate-thing - (point) arg 'end regexp pred))) - (when dest - (goto-char dest) - (when treesit-defun-skipper - (funcall treesit-defun-skipper))))) + (when (treesit-end-of-thing treesit-defun-type-regexp arg) + (when treesit-defun-skipper + (funcall treesit-defun-skipper)))) (defun treesit-default-defun-skipper () "Skips spaces after navigating a defun. @@ -1890,17 +1911,20 @@ function is called recursively." (if (eq counter 0) pos nil))) ;; TODO: In corporate into thing-at-point. -(defun treesit-thing-at-point (regexp tactic &optional pred) +(defun treesit-thing-at-point (pattern tactic) "Return the thing node at point or nil if none is found. -\"Thing\" is defined by REGEXP: if a node's type matches REGEXP, -it is a thing. The \"thing\" could be further restricted by -PRED: if non-nil, PRED should be a function that takes a node and -returns t if the node is a \"thing\", and nil if not. +\"Thing\" is defined by PATTERN, which can be either a string +REGEXP or a cons cell (REGEXP . PRED): if a node's type matches +REGEXP, it is a thing. The \"thing\" could be further restricted +by PRED: if non-nil, PRED should be a function that takes a node +and returns t if the node is a \"thing\", and nil if not. Return the top-level defun if TACTIC is `top-level', return the immediate parent thing if TACTIC is `nested'." - (pcase-let* ((`(,_ ,next ,parent) + (pcase-let* ((`(,regexp . ,pred) + (treesit--thing-unpack-pattern pattern)) + (`(,_ ,next ,parent) (treesit--things-around (point) regexp pred)) ;; If point is at the beginning of a thing, we ;; prioritize that thing over the parent in nested @@ -1921,10 +1945,8 @@ is `top-level', return the immediate parent defun if it is Return nil if `treesit-defun-type-regexp' is not set." (when treesit-defun-type-regexp - (pcase-let ((`(,regexp . ,pred) - (treesit--thing-unpack-pattern - treesit-defun-type-regexp))) - (treesit-thing-at-point regexp treesit-defun-tactic pred)))) + (treesit-thing-at-point + treesit-defun-type-regexp treesit-defun-tactic))) (defun treesit-defun-name (node) "Return the defun name of NODE. -- cgit v1.2.1 From 4234033a47ae06d6aa7db41d36dbc3dcbfcf897e Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sat, 24 Dec 2022 23:46:19 -0800 Subject: ; * lisp/treesit.el: Add some comments. --- lisp/treesit.el | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index e8e93d09de4..24fb316fab9 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1583,6 +1583,34 @@ BACKWARD and ALL are the same as in `treesit-search-forward'." node)) ;;; Navigation, defun, things +;; +;; Emacs lets you define "things" by a regexp that matches the type of +;; a node, and here are some functions that lets you find the "things" +;; at/around point, navigate backward/forward a "thing", etc. +;; +;; The most obvious "thing" is a defun, and there are thin wrappers +;; around thing functions for defun for convenience. +;; +;; We have more command-like functions like: +;; - treesit-beginning-of-thing/defun +;; - treesit-end-of-thing/defun +;; - treesit-thing/defun-at-point +;; +;; And more generic functions like: +;; - treesit--things-around +;; - treesit--top-level-thing +;; - treesit--navigate-thing +;; +;; There are also some defun-specific functions, like +;; treesit-defun-name, treesit-add-log-current-defun. +;; +;; TODO: I'm not entirely sure how would this go, so I only documented +;; the "defun" functions and didn't document any "thing" functions. +;; We should also document `treesit-block-type-regexp' and support it +;; in major modes if we can meaningfully intergrate hideshow: I tried +;; and failed, we need SomeOne that understands hideshow to look at +;; it. (BTW, hideshow should use its own +;; `treesit-hideshow-block-type-regexp'.) (defvar-local treesit-defun-type-regexp nil "A regexp that matches the node type of defun nodes. -- cgit v1.2.1 From e6c49c0454eff3fbf9247fc19aa4a0aac8f9388f Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 25 Dec 2022 00:29:15 -0800 Subject: ; Fix byte-copmiler warning in c-ts-mode--fontify-declarator * lisp/progmodes/c-ts-mode.el (c-ts-mode--fontify-declarator): Ignore the rest args. --- lisp/progmodes/c-ts-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 5fc44b11e14..42621371ff1 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -402,7 +402,7 @@ MODE is either `c' or `cpp'." ((or "identifier" "field_identifier") node))) -(defun c-ts-mode--fontify-declarator (node override start end &rest args) +(defun c-ts-mode--fontify-declarator (node override start end &rest _) "Fontify a declarator (whatever under the \"declarator\" field). For NODE, OVERRIDE, START, END, and ARGS, see `treesit-font-lock-rules'." -- cgit v1.2.1 From 9ab98cd42aa7ee7f23f05138beee1f69e7ce5fcc Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 25 Dec 2022 11:18:51 +0100 Subject: Add heuristic to locate lisp code in source packages * lisp/emacs-lisp/package-vc.el (package-vc--unpack): Check if a "lisp" directory exists and use that instead of PKG-DIR. (Bug#60155) --- lisp/emacs-lisp/package-vc.el | 14 ++++++++++++++ 1 file changed, 14 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index bf6c822a2b5..549b6e95cdb 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -609,6 +609,20 @@ checkout. This overrides the `:branch' attribute in PKG-SPEC." (error "There already exists a checkout for %s" name))) (package-vc--clone pkg-desc pkg-spec pkg-dir rev) + ;; When nothing is specified about a `lisp-dir', then should + ;; heuristically check if there is a sub-directory with lisp + ;; files. These are conventionally just called "lisp". If this + ;; directory exists and contains non-zero number of lisp files, we + ;; will use that instead of `pkg-dir'. + (when-let* (((null lisp-dir)) + (dir (expand-file-name "lisp" pkg-dir)) + ((file-directory-p dir)) + ((directory-files dir nil "\\`[^.].+\\.el\\'" t 1))) + ;; We won't use `dir', since dir is an absolute path and we + ;; don't want `lisp-dir' to depend on the current location of + ;; the package installation, ie. to break if moved around the + ;; file system or between installations. + (setq lisp-dir "lisp")) (when lisp-dir (push (cons :lisp-dir lisp-dir) (package-desc-extras pkg-desc))) -- cgit v1.2.1 From 940ab2423ca7c7a12aef069804435559d11f68e8 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 25 Dec 2022 11:20:30 +0100 Subject: ; Always consider :lisp-dir when locating main file of VC packages * lisp/emacs-lisp/package-vc.el (package-vc--main-file): Check the :lisp-dir entry in the "extras" of a package description to find the directory with a main file. --- lisp/emacs-lisp/package-vc.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index 549b6e95cdb..b01f87d0494 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -306,7 +306,9 @@ asynchronously." (directory (file-name-concat (or (package-desc-dir pkg-desc) (expand-file-name name package-user-dir)) - (plist-get pkg-spec :lisp-dir))) + (plist-get pkg-spec :lisp-dir) + (and-let* ((extras (package-desc-extras pkg-desc))) + (alist-get :lisp-dir extras)))) (file (or (plist-get pkg-spec :main-file) (expand-file-name (concat name ".el") -- cgit v1.2.1 From 72786ae237e66ff42385a2ac36f422ebb21072df Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Sun, 25 Dec 2022 12:59:06 +0100 Subject: ; Restore ARGS argument in c-ts-mode--fontify-declarator * lisp/progmodes/c-ts-mode.el (c-ts-mode--fontify-declarator): Restore argument name referenced in the docstring. --- lisp/progmodes/c-ts-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 42621371ff1..1d211da1765 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -402,7 +402,7 @@ MODE is either `c' or `cpp'." ((or "identifier" "field_identifier") node))) -(defun c-ts-mode--fontify-declarator (node override start end &rest _) +(defun c-ts-mode--fontify-declarator (node override start end &rest _args) "Fontify a declarator (whatever under the \"declarator\" field). For NODE, OVERRIDE, START, END, and ARGS, see `treesit-font-lock-rules'." -- cgit v1.2.1 From dad73e4de194f6f652c22fcd542d8796926d4ec6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 25 Dec 2022 14:54:33 +0200 Subject: ; Review and fix NEWS and related documentation * etc/NEWS: Fix wording, punctuation, and markup. * lisp/emacs-lisp/subr-x.el (string-glyph-split): Doc fix. * doc/lispref/display.texi (Displaying Messages): Document 'set-message-functions'. --- lisp/emacs-lisp/subr-x.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 4896f4c2937..415f8db52ca 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -333,7 +333,10 @@ as the new values of the bound variables in the recursive invocation." ;;;###autoload (defun string-glyph-split (string) "Split STRING into a list of strings representing separate glyphs. -This takes into account combining characters and grapheme clusters." +This takes into account combining characters and grapheme clusters: +if compositions are enbaled, each sequence of characters composed +on display into a single grapheme cluster is treated as a single +indivisible unit." (let ((result nil) (start 0) comp) -- cgit v1.2.1 From b1e68a33d89de34b432d6f39464f31a565604f3f Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sun, 25 Dec 2022 11:36:36 -0500 Subject: Update to Org 9.6-61-g63e073f --- lisp/org/ob-core.el | 10 +++++++--- lisp/org/ob-tangle.el | 3 ++- lisp/org/oc-basic.el | 18 +++++++++--------- lisp/org/org-element.el | 16 ++++++++++++++-- lisp/org/org-persist.el | 46 ++++++++++++++++++++++++++++++++++------------ lisp/org/org-version.el | 2 +- lisp/org/org.el | 5 ++++- lisp/org/ox-html.el | 2 +- 8 files changed, 72 insertions(+), 30 deletions(-) (limited to 'lisp') diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index f69538f78c9..c2a3673752e 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -2464,7 +2464,11 @@ INFO may provide the values of these header arguments (in the (cons 'unordered (mapcar (lambda (e) - (list (if (stringp e) e (format "%S" e)))) + (cond + ((stringp e) (list e)) + ((listp e) + (mapcar (lambda (x) (format "%S" x)) e)) + (t (list (format "%S" e))))) (if (listp result) result (split-string result "\n" t)))) '(:splicep nil :istart "- " :iend "\n"))) @@ -3183,8 +3187,8 @@ situations in which is it not appropriate." (if (and (memq (string-to-char cell) '(?\( ?`)) (not (org-babel-confirm-evaluate ;; See `org-babel-get-src-block-info'. - (list "emacs-lisp" (format "%S" cell) - '((:eval . yes)) nil (format "%S" cell) + (list "emacs-lisp" cell + '((:eval . yes)) nil (format "%s" cell) nil nil)))) ;; Not allowed. (user-error "Evaluation of elisp code %S aborted." cell) diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index bd17bda32ba..fd6b6f3b943 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -500,7 +500,8 @@ The PARAMS are the 3rd element of the info for the same src block." (cl-letf (((symbol-function 'org-store-link-functions) (lambda () nil))) (org-store-link nil)))) - (bare (and (string-match org-link-bracket-re l) + (bare (and l + (string-match org-link-bracket-re l) (match-string 1 l)))) (when bare (if (and org-babel-tangle-use-relative-file-links diff --git a/lisp/org/oc-basic.el b/lisp/org/oc-basic.el index 3ef7a37e3b3..01e314bfdba 100644 --- a/lisp/org/oc-basic.el +++ b/lisp/org/oc-basic.el @@ -162,17 +162,17 @@ Return a hash table with citation references as keys and fields alist as values. (puthash (cdr (assq 'id item)) (mapcar (pcase-lambda (`(,field . ,value)) (pcase field - ('author - ;; Author is an array of objects, each - ;; of them designing a person. These - ;; objects may contain multiple - ;; properties, but for this basic - ;; processor, we'll focus on `given' and - ;; `family'. + ((or 'author 'editors) + ;; Author and editors are arrays of + ;; objects, each of them designing a + ;; person. These objects may contain + ;; multiple properties, but for this + ;; basic processor, we'll focus on + ;; `given' and `family'. ;; ;; For compatibility with BibTeX, add - ;; "and" between authors. - (cons 'author + ;; "and" between authors and editors. + (cons field (mapconcat (lambda (alist) (concat (alist-get 'family alist) diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index 71c242ea658..e049c65d6bf 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -1365,7 +1365,16 @@ Assume point is at beginning of the inline task." (priority (and (looking-at "\\[#.\\][ \t]*") (progn (goto-char (match-end 0)) (aref (match-string 0) 2)))) - (title-start (point)) + (commentedp + (and (let ((case-fold-search nil)) + (looking-at org-element-comment-string)) + (goto-char (match-end 0)) + (when (looking-at-p "\\(?:[ \t]\\|$\\)") + (point)))) + (title-start (prog1 (point) + (unless (or todo priority commentedp) + ;; Headline like "* :tag:" + (skip-chars-backward " \t")))) (tags (when (re-search-forward "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" (line-end-position) @@ -1375,6 +1384,7 @@ Assume point is at beginning of the inline task." (title-end (point)) (raw-value (org-trim (buffer-substring-no-properties title-start title-end))) + (archivedp (member org-element-archive-tag tags)) (task-end (save-excursion (end-of-line) (and (re-search-forward org-element-headline-re limit t) @@ -1410,7 +1420,9 @@ Assume point is at beginning of the inline task." :todo-keyword todo :todo-type todo-type :post-blank (1- (count-lines (or task-end begin) end)) - :post-affiliated begin) + :post-affiliated begin + :archivedp archivedp + :commentedp commentedp) time-props standard-props)))) (org-element-put-property diff --git a/lisp/org/org-persist.el b/lisp/org/org-persist.el index 6ccf357784e..60291e5187f 100644 --- a/lisp/org/org-persist.el +++ b/lisp/org/org-persist.el @@ -874,15 +874,21 @@ When IGNORE-RETURN is non-nil, just return t on success without calling When ASSOCIATED is non-nil, only save the matching data." (unless org-persist--index (org-persist--load-index)) (setq associated (org-persist--normalize-associated associated)) - (unless + (if (and (equal 1 (length org-persist--index)) ;; The single collection only contains a single container ;; in the container list. (equal 1 (length (plist-get (car org-persist--index) :container))) ;; The container is an `index' container. (eq 'index (caar (plist-get (car org-persist--index) :container))) - ;; No `org-persist-directory' exists yet. - (not (file-exists-p org-persist-directory))) + (or (not (file-exists-p org-persist-directory)) + (org-directory-empty-p org-persist-directory))) + ;; Do not write anything, and clear up `org-persist-directory' to reduce + ;; clutter. + (when (and (file-exists-p org-persist-directory) + (org-directory-empty-p org-persist-directory)) + (delete-directory org-persist-directory)) + ;; Write the data. (let (all-containers) (dolist (collection org-persist--index) (if associated @@ -963,6 +969,30 @@ Also, remove containers associated with non-existing files." (push collection new-index))))) (setq org-persist--index (nreverse new-index)))) +(defun org-persist-clear-storage-maybe () + "Clear `org-persist-directory' according to `org-persist--disable-when-emacs-Q'. + +When `org-persist--disable-when-emacs-Q' is non-nil and Emacs is called with -Q +command line argument, `org-persist-directory' is created in potentially public +system temporary directory. Remove everything upon existing Emacs in +such scenario." + (when (and org-persist--disable-when-emacs-Q + ;; FIXME: This is relying on undocumented fact that + ;; Emacs sets `user-init-file' to nil when loaded with + ;; "-Q" argument. + (not user-init-file) + (file-exists-p org-persist-directory)) + (delete-directory org-persist-directory 'recursive))) + +;; Point to temp directory when `org-persist--disable-when-emacs-Q' is set. +(when (and org-persist--disable-when-emacs-Q + ;; FIXME: This is relying on undocumented fact that + ;; Emacs sets `user-init-file' to nil when loaded with + ;; "-Q" argument. + (not user-init-file)) + (setq org-persist-directory + (make-temp-file "org-persist-" 'dir))) + ;; Automatically write the data, but only when we have write access. (let ((dir (directory-file-name (file-name-as-directory org-persist-directory)))) @@ -972,20 +1002,12 @@ Also, remove containers associated with non-existing files." (if (not (file-writable-p dir)) (message "Missing write access rights to org-persist-directory: %S" org-persist-directory) + (add-hook 'kill-emacs-hook #'org-persist-clear-storage-maybe) ; Run last. (add-hook 'kill-emacs-hook #'org-persist-write-all) ;; `org-persist-gc' should run before `org-persist-write-all'. ;; So we are adding the hook after `org-persist-write-all'. (add-hook 'kill-emacs-hook #'org-persist-gc))) -;; Point to temp directory when `org-persist--disable-when-emacs-Q' is set. -(if (and org-persist--disable-when-emacs-Q - ;; FIXME: This is relying on undocumented fact that - ;; Emacs sets `user-init-file' to nil when loaded with - ;; "-Q" argument. - (not user-init-file)) - (setq org-persist-directory - (make-temp-file "org-persist-" 'dir))) - (add-hook 'after-init-hook #'org-persist-load-all) (provide 'org-persist) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 8de0d1a4a97..a0016265f02 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made." (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.6-49-g47d129")) + (let ((org-git-version "release_9.6-61-g63e073f")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index 6aa2a16219d..ab8b76b926a 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -20213,7 +20213,10 @@ interactive command with similar behavior." (defun org-back-to-heading (&optional invisible-ok) "Go back to beginning of heading." (beginning-of-line) - (or (org-at-heading-p (not invisible-ok)) + (or (and (org-at-heading-p (not invisible-ok)) + (not (and (featurep 'org-inlinetask) + (fboundp 'org-inlinetask-end-p) + (org-inlinetask-end-p)))) (if (org-element--cache-active-p) (let ((heading (org-element-lineage (org-element-at-point) '(headline inlinetask) diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 86b10cbf785..19cdf4c5a26 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -3337,7 +3337,7 @@ INFO is a plist holding contextual information. See ((org-html-standalone-image-p destination info) (org-export-get-ordinal (org-element-map destination 'link #'identity info t) - info 'link 'org-html-standalone-image-p)) + info '(link) 'org-html-standalone-image-p)) (t (org-export-get-ordinal destination info nil counter-predicate)))) (desc -- cgit v1.2.1 From 6c00d126e7fe1f6e42a0c9454c2ab4a29dcd5989 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Mon, 26 Dec 2022 01:21:16 +0000 Subject: Remove remaining mentions of 'eval-current-buffer' * lisp/emacs-lisp/edebug.el (edebug-all-defs): * doc/lispref/eval.texi (Eval): * doc/lispref/edebug.texi (Instrumenting, Edebug Options): Remove remaining mentions of 'eval-current-buffer', obsoleted in Emacs 22 and removed in Emacs 26. --- lisp/emacs-lisp/edebug.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 67704bdb51c..9e792889c89 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -92,9 +92,9 @@ using, but only when you also use Edebug." ;;;###autoload (defcustom edebug-all-defs nil "If non-nil, evaluating defining forms instruments for Edebug. -This applies to `eval-defun', `eval-region', `eval-buffer', and -`eval-current-buffer'. `eval-region' is also called by -`eval-last-sexp', and `eval-print-last-sexp'. +This applies to `eval-defun', `eval-region' and `eval-buffer'. +`eval-region' is also called by `eval-last-sexp', and +`eval-print-last-sexp'. You can use the command `edebug-all-defs' to toggle the value of this variable. You may wish to make it local to each buffer with -- cgit v1.2.1 From 2608e5edcca5094b61b4ccebcef160cc2bfd7f83 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 23 Dec 2022 18:21:10 +0100 Subject: ; Fix typos (cherry picked from commit a5d39e11443fa30c8e8bc58254a1a59550dcd99e) --- lisp/ChangeLog.14 | 4 ++-- lisp/ChangeLog.7 | 2 +- lisp/cedet/ChangeLog.1 | 2 +- lisp/gnus/ChangeLog.3 | 2 +- lisp/mail/rmailsum.el | 2 +- lisp/mh-e/mh-search.el | 2 +- lisp/net/tramp-sh.el | 2 +- lisp/org/ChangeLog.1 | 8 ++++---- lisp/org/org-element.el | 6 +++--- lisp/org/org-faces.el | 2 +- lisp/org/org-fold-core.el | 8 ++++---- lisp/progmodes/cc-engine.el | 2 +- lisp/progmodes/idlw-help.el | 2 +- lisp/progmodes/python.el | 2 +- lisp/replace.el | 2 +- lisp/sort.el | 2 +- 16 files changed, 25 insertions(+), 25 deletions(-) (limited to 'lisp') diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index eae47fe1985..1ce11c11adf 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -6299,7 +6299,7 @@ 2008-10-22 Vinicius Jose Latorre - * ps-print.el: Deal with page sizes for label printes. Suggested by + * ps-print.el: Deal with page sizes for label printers. Suggested by Friedrich Delgado Friedrichs . (ps-print-version): New version 7.3.3. (ps-page-dimensions-database): New page sizes for label printers. @@ -6371,7 +6371,7 @@ * replace.el (query-replace, query-replace-regexp) (replace-string, replace-regexp, perform-replace): Add "word" - indicatiors to the prompt for word delimited replacements. + indicators to the prompt for word delimited replacements. * replace.el (read-regexp): Rename arg `default' to `default-value'. Doc fix. diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7 index 91b8d474224..83143f73360 100644 --- a/lisp/ChangeLog.7 +++ b/lisp/ChangeLog.7 @@ -14679,7 +14679,7 @@ * simple.el (current-word): Ignore text properties. * edebug.el (edebug-sit-for-seconds): New variable. - (edebug-display): Use that variable to control amt of time. + (edebug-display): Use that variable to control amount of time. 1997-06-22 Morten Welinder diff --git a/lisp/cedet/ChangeLog.1 b/lisp/cedet/ChangeLog.1 index 78275f4db3a..a3a1034e089 100644 --- a/lisp/cedet/ChangeLog.1 +++ b/lisp/cedet/ChangeLog.1 @@ -1446,7 +1446,7 @@ modes, and merge the tables together in :tables from :modetables. (srecode-make-mode-table): Init :modetables. (srecode-mode-table-find): Search in modetables. - (srecode-mode-table-new): Merge the differet files into the + (srecode-mode-table-new): Merge the different files into the modetables slot. 2012-10-01 David Engster diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3 index 8c1073dc8db..bf64780799d 100644 --- a/lisp/gnus/ChangeLog.3 +++ b/lisp/gnus/ChangeLog.3 @@ -11763,7 +11763,7 @@ 2010-08-29 Lars Magne Ingebrigtsen * gnus-start.el (gnus-dribble-read-file): Ensure that the directory - where the dribbel file lives exists. + where the dribble file lives exists. * message.el (message-send-mail-partially-limit): Change the default to nil, since most people don't want this. diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index d63e05f5fa2..20362d39d10 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -339,7 +339,7 @@ First element is ignored.") (split-string header "[ \f\t\n\r\v,;]+")))) (defun rmail-summary-fill-message-parents-and-descs-vectors () - "Fill parents and descendats vectors for messages. + "Fill parents and descendants vectors for messages. This populates `rmail-summary-message-parents-vector' and `rmail-summary-message-descendants-vector'." (with-current-buffer rmail-buffer diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index 058ea4499fd..1b28509dd12 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -292,7 +292,7 @@ folder containing the index search results." (cons folder msg))))) folder-results-map) - ;; Vist the results folder. + ;; Visit the results folder. (mh-visit-folder index-folder () (list folder-results-map origin-map)) (goto-char (point-min)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6087f16431e..ac5de22cb84 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2829,7 +2829,7 @@ the result will be a local, non-Tramp, file name." (when (zerop (length name)) (setq name ".")) ;; On MS Windows, some special file names are not returned properly ;; by `file-name-absolute-p'. If `tramp-syntax' is `simplified', - ;; there could be the falso positive "/:". + ;; there could be the false positive "/:". (if (or (and (eq system-type 'windows-nt) (string-match-p (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device) eol))) diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1 index 4f51c6a1ebb..e72526c3edc 100644 --- a/lisp/org/ChangeLog.1 +++ b/lisp/org/ChangeLog.1 @@ -10418,7 +10418,7 @@ * org.el (org-adaptive-fill-function): Remove occasional spurious space character when auto-filling. - * org.el (org-mode): Call external initalizers. Now both filling + * org.el (org-mode): Call external initializers. Now both filling code and comments code have their own independent part in org.el. (org-setup-filling): Rename from `org-set-autofill-regexps'. (org-setup-comments-handling): New function. @@ -15589,7 +15589,7 @@ * ob-python.el (org-babel-python-evaluate-session): Introduced a new local function for sending input with a slight delay to allow - pythong to re-draw the prompt. No longer removing newlines inside + python to re-draw the prompt. No longer removing newlines inside code block bodies (was due to a defective regexp). 2011-07-28 Bastien Guerry @@ -17320,7 +17320,7 @@ * ob-lisp.el (org-babel-execute:lisp): Turn vectors into lists before reading by elisp. - (org-bable-lisp-vector-to-list): Stub of a vector->list function, + (org-babel-lisp-vector-to-list): Stub of a vector->list function, should be replaced with a cl-vector->el-vector function. 2011-07-28 Eric Schulte @@ -29935,7 +29935,7 @@ inserted at the correct position. * org-publish.el (org-publish-project-alist) - (org-publish-projects, org-publish-org-index): Change default anme + (org-publish-projects, org-publish-org-index): Change default name for the index of file names to "sitemap.org". * org-latex.el (org-export-latex-tables): diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index e049c65d6bf..ace1cc1a984 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -7272,18 +7272,18 @@ Each element indicates the latest `org-element--cache-change-tic' when change did not contain gaps.") ;;;###autoload -(defun org-element-cache-reset (&optional all no-persistance) +(defun org-element-cache-reset (&optional all no-persistence) "Reset cache in current buffer. When optional argument ALL is non-nil, reset cache in all Org buffers. -When optional argument NO-PERSISTANCE is non-nil, do not try to update +When optional argument NO-PERSISTENCE is non-nil, do not try to update the cache persistence in the buffer." (interactive "P") (dolist (buffer (if all (buffer-list) (list (current-buffer)))) (org-with-base-buffer buffer (when (and org-element-use-cache (derived-mode-p 'org-mode)) ;; Only persist cache in file buffers. - (when (and (buffer-file-name) (not no-persistance)) + (when (and (buffer-file-name) (not no-persistence)) (when (not org-element-cache-persistent) (org-persist-unregister 'org-element--headline-cache (current-buffer)) (org-persist-unregister 'org-element--cache (current-buffer))) diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index 0effa13a1d6..b3ee17ccdf6 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -517,7 +517,7 @@ content of these blocks will still be treated as Org syntax." (defface org-agenda-structure-filter '((t (:inherit (org-warning org-agenda-structure)))) "Face used for the current type of task filter in the agenda. It inherits from `org-agenda-structure' so it can adapt to -it (e.g. if that is assigned a diffent font height or family)." +it (e.g. if that is assigned a different font height or family)." :group 'org-faces) (defface org-agenda-date '((t (:inherit org-agenda-structure))) diff --git a/lisp/org/org-fold-core.el b/lisp/org/org-fold-core.el index ffa689d4fa1..c4d78496e55 100644 --- a/lisp/org/org-fold-core.el +++ b/lisp/org/org-fold-core.el @@ -145,7 +145,7 @@ ;; All the folding specs can be specified by symbol representing their ;; name. However, this is not always convenient, especially if the -;; same spec can be used for fold different syntaxical structures. +;; same spec can be used for fold different syntactical structures. ;; Any folding spec can be additionally referenced by a symbol listed ;; in the spec's `:alias' folding spec property. For example, Org ;; mode's `org-fold-outline' folding spec can be referenced as any @@ -189,9 +189,9 @@ ;; all the processing related to buffer modifications. ;; The library also provides a way to unfold the text after some -;; destructive changes breaking syntaxical structure of the buffer. +;; destructive changes breaking syntactical structure of the buffer. ;; For example, Org mode automatically reveals folded drawers when the -;; drawer becomes syntaxically incorrect: +;; drawer becomes syntactically incorrect: ;; ------- before modification ------- ;; :DRAWER: ;; Some folded text inside drawer @@ -321,7 +321,7 @@ following symbols: functions relying on this package might not be able to unfold the edited text. For example, removed leading stars from a folded headline in Org mode will break visibility cycling since Org mode - will not be avare that the following folded text belonged to + will not be aware that the following folded text belonged to headline. - `ignore-modification-checks': Do not try to detect insertions in the diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index edb873f5a62..2198f3115a5 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -7757,7 +7757,7 @@ multi-line strings (but not C++, for example)." (1- (match-end 1)) ; 1- For the inserted ". eoll)))) - ;; ...and clear `syntax-table' text propertes from the + ;; ...and clear `syntax-table' text properties from the ;; following raw strings. (c-depropertize-ml-strings-in-region (point) (1+ eoll))) ;; Remove the temporary string delimiter. diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index a19abf77e5f..51afb7e4850 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -269,7 +269,7 @@ Scrolling: SPC DEL RET Text Searches: Inside Topic: Use Emacs search functions Exit: [q]uit or mouse button 3 will kill the frame -When the hep text is a source file, the following commands are available +When the help text is a source file, the following commands are available Fontification: [F]ontify the buffer like source code Jump: [h] to function doclib header diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d383fa57c04..0cd0c6c225a 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4540,7 +4540,7 @@ Commands that must finish the tracking session are listed in (when (and python-pdbtrack-tracked-buffer ;; Empty input is sent by C-d or `comint-send-eof' (or (string-empty-p input) - ;; "n some text" is "n" command for pdb. Split input and get firs part + ;; "n some text" is "n" command for pdb. Split input and get first part (let* ((command (car (split-string (string-trim input) " ")))) (setq python-pdbtrack-prev-command-continue (or (member command python-pdbtrack-continue-command) diff --git a/lisp/replace.el b/lisp/replace.el index 302cb65543b..cebe779ae4c 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1692,7 +1692,7 @@ contents of the line; it normally shows the line number. \(For multiline matches, the prefix column shows the line number for the first line and whitespace for the rest of the lines.\) If this face will display the same as the default face, the prefix -column will not be highlighted speciall." +column will not be highlighted specially." :type 'face :group 'matching :version "24.4") diff --git a/lisp/sort.el b/lisp/sort.el index d04f075abd1..b66d6453d21 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -86,7 +86,7 @@ second key. If PREDICATE is nil, comparison is done with `<' if the keys are numbers, with `compare-buffer-substrings' if the keys are cons cells (the car and cdr of each cons cell are taken as start and end positions), and with `string<' otherwise." - ;; Heuristically try to avoid messages if sorting a small amt of text. + ;; Heuristically try to avoid messages if sorting a small amount of text. (let ((messages (> (- (point-max) (point-min)) 50000))) (save-excursion (if messages (message "Finding sort keys...")) -- cgit v1.2.1 From 7c7950fe006fe19596011637610b934a786c1742 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 25 Dec 2022 10:22:40 -0800 Subject: Add maintainer stub for tree-sitter files * lisp/treesit.el: * src/treesit.c: Add maintainer. --- lisp/treesit.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 24fb316fab9..f3e1afd943e 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2,6 +2,10 @@ ;; Copyright (C) 2021-2022 Free Software Foundation, Inc. +;; Maintainer: 付禹安 (Yuan Fu) +;; Keywords: treesit, tree-sitter, languages +;; Package: emacs + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify -- cgit v1.2.1 From c6b02826450e3d40b4a2ea4e6026a813d3679d8d Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 25 Dec 2022 11:11:00 -0800 Subject: ; Remove unused function in c-ts-mode * lisp/progmodes/c-ts-mode.el (c-ts-mode--end-of-defun): Remove. (c-ts-mode) (c++-ts-mode): Remove setup. --- lisp/progmodes/c-ts-mode.el | 25 ++----------------------- 1 file changed, 2 insertions(+), 23 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 1d211da1765..8569f3107b7 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -549,19 +549,6 @@ the subtrees." ;;; Defun navigation -(defun c-ts-mode--end-of-defun () - "`end-of-defun-function' of `c-ts-mode'." - ;; A struct/enum/union_specifier node doesn't include the ; at the - ;; end, so we manually skip it. - (treesit-end-of-defun) - (when (looking-at (rx (* " ") ";")) - (goto-char (match-end 0)) - ;; This part is copied from `end-of-defun'. - (unless (bolp) - (skip-chars-forward " \t") - (if (looking-at "\\s<\\|\n") - (forward-line 1))))) - (defun c-ts-mode--defun-valid-p (node) (if (string-match-p (rx (or "struct_specifier" @@ -766,11 +753,7 @@ ARG is passed to `fill-paragraph'." ;; Font-lock. (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c)) - (treesit-major-mode-setup) - - ;; Override default value of end-of-defun-function set by - ;; `treesit-major-mode-setup'. - (setq-local end-of-defun-function #'c-ts-mode--end-of-defun)) + (treesit-major-mode-setup)) ;;;###autoload (define-derived-mode c++-ts-mode c-ts-base-mode "C++" @@ -800,11 +783,7 @@ ARG is passed to `fill-paragraph'." ;; Font-lock. (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'cpp)) - (treesit-major-mode-setup) - - ;; Override default value of end-of-defun-function set by - ;; `treesit-major-mode-setup'. - (setq-local end-of-defun-function #'c-ts-mode--end-of-defun)) + (treesit-major-mode-setup)) (provide 'c-ts-mode) -- cgit v1.2.1 From 28f26b11a1ebd46b9f599babf843f91871efb629 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Sun, 25 Dec 2022 11:21:50 -0800 Subject: Add comment indent and filling to other tree-sitter major modes Extract the setup into a function, and use it in other major modes. * lisp/progmodes/c-ts-mode.el (c-ts-mode-comment-setup): New function. (c-ts-base-mode): Extract out. (c-ts-mode) (c++-ts-mode): Remove old setup. * lisp/progmodes/csharp-mode.el (csharp-ts-mode--indent-rules): New indent rules. (csharp-ts-mode): Use new setup function. * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): New indent rules. (java-ts-mode): Use new setup function. * lisp/progmodes/js.el (js--treesit-indent-rules): New indent rules. (js-ts-mode): Use new setup function. * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--indent-rules): New indent rules. (rust-ts-mode): Use new setup function. * lisp/progmodes/typescript-ts-mode.el: (typescript-ts-mode--indent-rules): New indent rules. (typescript-ts-base-mode): Use new setup function. --- lisp/progmodes/c-ts-mode.el | 103 +++++++++++++++++++---------------- lisp/progmodes/csharp-mode.el | 14 ++--- lisp/progmodes/java-ts-mode.el | 16 ++---- lisp/progmodes/js.el | 17 ++---- lisp/progmodes/rust-ts-mode.el | 14 ++--- lisp/progmodes/typescript-ts-mode.el | 14 ++--- 6 files changed, 80 insertions(+), 98 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 8569f3107b7..1bd5036be25 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -647,6 +647,59 @@ ARG is passed to `fill-paragraph'." ;; itself. t))) +(defun c-ts-mode-comment-setup () + "Set up local variables for C-like comment. + +Set up: + - `comment-start' + - `comment-end' + - `comment-start-skip' + - `comment-end-skip' + - `adaptive-fill-mode' + - `adaptive-fill-first-line-regexp' + - `paragraph-start' + - `paragraph-separate' + - `fill-paragraph-function'" + (setq-local comment-start "// ") + (setq-local comment-end "") + (setq-local comment-start-skip (rx (or (seq "/" (+ "/")) + (seq "/" (+ "*"))) + (* (syntax whitespace)))) + (setq-local comment-end-skip + (rx (* (syntax whitespace)) + (group (or (syntax comment-end) + (seq (+ "*") "/"))))) + (setq-local adaptive-fill-mode t) + ;; This matches (1) empty spaces (the default), (2) "//", (3) "*", + ;; but do not match "/*", because we don't want to use "/*" as + ;; prefix when filling. (Actually, it doesn't matter, because + ;; `comment-start-skip' matches "/*" which will cause + ;; `fill-context-prefix' to use "/*" as a prefix for filling, that's + ;; why we mask the "/*" in `c-ts-mode--fill-paragraph'.) + (setq-local adaptive-fill-regexp + (concat (rx (* (syntax whitespace)) + (group (or (seq "/" (+ "/")) (* "*")))) + adaptive-fill-regexp)) + ;; Same as `adaptive-fill-regexp'. + (setq-local adaptive-fill-first-line-regexp + (rx bos + (seq (* (syntax whitespace)) + (group (or (seq "/" (+ "/")) (* "*"))) + (* (syntax whitespace))) + eos)) + ;; Same as `adaptive-fill-regexp'. + (setq-local paragraph-start + (rx (or (seq (* (syntax whitespace)) + (group (or (seq "/" (+ "/")) (* "*"))) + (* (syntax whitespace)) + ;; Add this eol so that in + ;; `fill-context-prefix', `paragraph-start' + ;; doesn't match the prefix. + eol) + "\f"))) + (setq-local paragraph-separate paragraph-start) + (setq-local fill-paragraph-function #'c-ts-mode--fill-paragraph)) + ;;; Modes (defvar-keymap c-ts-mode-map @@ -681,36 +734,8 @@ ARG is passed to `fill-paragraph'." (when (eq c-ts-mode-indent-style 'linux) (setq-local indent-tabs-mode t)) - (setq-local adaptive-fill-mode t) - ;; This matches (1) empty spaces (the default), (2) "//", (3) "*", - ;; but do not match "/*", because we don't want to use "/*" as - ;; prefix when filling. (Actually, it doesn't matter, because - ;; `comment-start-skip' matches "/*" which will cause - ;; `fill-context-prefix' to use "/*" as a prefix for filling, that's - ;; why we mask the "/*" in `c-ts-mode--fill-paragraph'.) - (setq-local adaptive-fill-regexp - (concat (rx (* (syntax whitespace)) - (group (or (seq "/" (+ "/")) (* "*")))) - adaptive-fill-regexp)) - ;; Same as `adaptive-fill-regexp'. - (setq-local adaptive-fill-first-line-regexp - (rx bos - (seq (* (syntax whitespace)) - (group (or (seq "/" (+ "/")) (* "*"))) - (* (syntax whitespace))) - eos)) - ;; Same as `adaptive-fill-regexp'. - (setq-local paragraph-start - (rx (or (seq (* (syntax whitespace)) - (group (or (seq "/" (+ "/")) (* "*"))) - (* (syntax whitespace)) - ;; Add this eol so that in - ;; `fill-context-prefix', `paragraph-start' - ;; doesn't match the prefix. - eol) - "\f"))) - (setq-local paragraph-separate paragraph-start) - (setq-local fill-paragraph-function #'c-ts-mode--fill-paragraph) + ;; Comment + (c-ts-mode-comment-setup) ;; Electric (setq-local electric-indent-chars @@ -739,13 +764,6 @@ ARG is passed to `fill-paragraph'." ;; Comments. (setq-local comment-start "/* ") (setq-local comment-end " */") - (setq-local comment-start-skip (rx (or (seq "/" (+ "/")) - (seq "/" (+ "*"))) - (* (syntax whitespace)))) - (setq-local comment-end-skip - (rx (* (syntax whitespace)) - (group (or (syntax comment-end) - (seq (+ "*") "/"))))) (setq-local treesit-simple-indent-rules (c-ts-mode--set-indent-style 'c)) @@ -764,17 +782,6 @@ ARG is passed to `fill-paragraph'." (unless (treesit-ready-p 'cpp) (error "Tree-sitter for C++ isn't available")) - ;; Comments. - (setq-local comment-start "// ") - (setq-local comment-end "") - (setq-local comment-start-skip (rx (or (seq "/" (+ "/")) - (seq "/" (+ "*"))) - (* (syntax whitespace)))) - (setq-local comment-end-skip - (rx (* (syntax whitespace)) - (group (or (syntax comment-end) - (seq (+ "*") "/"))))) - (treesit-parser-create 'cpp) (setq-local treesit-simple-indent-rules diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 985e2e7b0bf..13a6f6254f5 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -34,6 +34,7 @@ (require 'cc-mode) (require 'cc-langs) (require 'treesit) +(require 'c-ts-mode) ; For comment indenting and filling. (eval-when-compile (require 'cc-fonts) @@ -632,6 +633,9 @@ compilation and evaluation time conflicts." ((node-is "}") parent-bol 0) ((node-is ")") parent-bol 0) ((node-is "]") parent-bol 0) + ((and (parent-is "comment") c-ts-mode--looking-at-star) + c-ts-mode--comment-start-after-first-star -1) + ((parent-is "comment") prev-adaptive-prefix 0) ((parent-is "namespace_declaration") parent-bol 0) ((parent-is "class_declaration") parent-bol 0) ((parent-is "constructor_declaration") parent-bol 0) @@ -929,15 +933,7 @@ Key bindings: (treesit-parser-create 'c-sharp) ;; Comments. - (setq-local comment-start "// ") - (setq-local comment-end "") - (setq-local comment-start-skip (rx (or (seq "/" (+ "/")) - (seq "/" (+ "*"))) - (* (syntax whitespace)))) - (setq-local comment-end-skip - (rx (* (syntax whitespace)) - (group (or (syntax comment-end) - (seq (+ "*") "/"))))) + (c-ts-mode-comment-setup) ;; Indent. (setq-local treesit-simple-indent-rules csharp-ts-mode--indent-rules) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 3e0439ddf54..ddad8c7afb9 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -29,6 +29,7 @@ (require 'treesit) (eval-when-compile (require 'rx)) +(require 'c-ts-mode) ; For comment indent and filling. (declare-function treesit-parser-create "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") @@ -71,8 +72,9 @@ ((node-is "}") (and parent parent-bol) 0) ((node-is ")") parent-bol 0) ((node-is "]") parent-bol 0) - ((and (parent-is "comment") comment-end) comment-start -1) - ((parent-is "comment") comment-start-skip 0) + ((and (parent-is "comment") c-ts-mode--looking-at-star) + c-ts-mode--comment-start-after-first-star -1) + ((parent-is "comment") prev-adaptive-prefix 0) ((parent-is "text_block") no-indent) ((parent-is "class_body") parent-bol java-ts-mode-indent-offset) ((parent-is "interface_body") parent-bol java-ts-mode-indent-offset) @@ -320,15 +322,7 @@ the subtrees." (treesit-parser-create 'java) ;; Comments. - (setq-local comment-start "// ") - (setq-local comment-end "") - (setq-local comment-start-skip (rx (or (seq "/" (+ "/")) - (seq "/" (+ "*"))) - (* (syntax whitespace)))) - (setq-local comment-end-skip - (rx (* (syntax whitespace)) - (group (or (syntax comment-end) - (seq (+ "*") "/"))))) + (c-ts-mode-comment-setup) ;; Indent. (setq-local treesit-simple-indent-rules java-ts-mode--indent-rules) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 14feed221fb..a6e6dc05418 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -54,6 +54,7 @@ (require 'json) (require 'prog-mode) (require 'treesit) +(require 'c-ts-mode) ; For comment indent and filling. (eval-when-compile (require 'cl-lib) @@ -3425,9 +3426,9 @@ This function is intended for use in `after-change-functions'." ((node-is ")") parent-bol 0) ((node-is "]") parent-bol 0) ((node-is ">") parent-bol 0) - ((parent-is "comment") comment-start 0) - ((and (parent-is "comment") comment-end) comment-start -1) - ((parent-is "comment") comment-start-skip 0) + ((and (parent-is "comment") c-ts-mode--looking-at-star) + c-ts-mode--comment-start-after-first-star -1) + ((parent-is "comment") prev-adaptive-prefix 0) ((parent-is "ternary_expression") parent-bol js-indent-level) ((parent-is "member_expression") parent-bol js-indent-level) ((node-is ,switch-case) parent-bol 0) @@ -3845,15 +3846,7 @@ Currently there are `js-mode' and `js-ts-mode'." ;; Which-func. (setq-local which-func-imenu-joiner-function #'js--which-func-joiner) ;; Comment. - (setq-local comment-start "// ") - (setq-local comment-end "") - (setq-local comment-start-skip (rx (or (seq "/" (+ "/")) - (seq "/" (+ "*"))) - (* (syntax whitespace)))) - (setq-local comment-end-skip - (rx (* (syntax whitespace)) - (group (or (syntax comment-end) - (seq (+ "*") "/"))))) + (c-ts-mode-comment-setup) (setq-local comment-multi-line t) ;; Electric-indent. (setq-local electric-indent-chars diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 81f5b8765f1..d8cd2a195d2 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -29,6 +29,7 @@ (require 'treesit) (eval-when-compile (require 'rx)) +(require 'c-ts-mode) ; For comment indent and filling. (declare-function treesit-parser-create "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") @@ -70,6 +71,9 @@ ((node-is ")") parent-bol 0) ((node-is "]") parent-bol 0) ((node-is "}") (and parent parent-bol) 0) + ((and (parent-is "comment") c-ts-mode--looking-at-star) + c-ts-mode--comment-start-after-first-star -1) + ((parent-is "comment") prev-adaptive-prefix 0) ((parent-is "arguments") parent-bol rust-ts-mode-indent-offset) ((parent-is "await_expression") parent-bol rust-ts-mode-indent-offset) ((parent-is "array_expression") parent-bol rust-ts-mode-indent-offset) @@ -334,15 +338,7 @@ the subtrees." (treesit-parser-create 'rust) ;; Comments. - (setq-local comment-start "// ") - (setq-local comment-end "") - (setq-local comment-start-skip (rx (or (seq "/" (+ "/")) - (seq "/" (+ "*"))) - (* (syntax whitespace)))) - (setq-local comment-end-skip - (rx (* (syntax whitespace)) - (group (or (syntax comment-end) - (seq (+ "*") "/"))))) + (c-ts-mode-comment-setup) ;; Font-lock. (setq-local treesit-font-lock-settings rust-ts-mode--font-lock-settings) diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 69616351ce3..0bfdc81e22d 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -30,6 +30,7 @@ (require 'treesit) (require 'js) (eval-when-compile (require 'rx)) +(require 'c-ts-mode) ; For comment indent and filling. (declare-function treesit-parser-create "treesit.c") @@ -73,8 +74,9 @@ Argument LANGUAGE is either `typescript' or `tsx'." ((node-is ")") parent-bol 0) ((node-is "]") parent-bol 0) ((node-is ">") parent-bol 0) - ((and (parent-is "comment") comment-end) comment-start -1) - ((parent-is "comment") comment-start-skip 0) + ((and (parent-is "comment") c-ts-mode--looking-at-star) + c-ts-mode--comment-start-after-first-star -1) + ((parent-is "comment") prev-adaptive-prefix 0) ((parent-is "ternary_expression") parent-bol typescript-ts-mode-indent-offset) ((parent-is "member_expression") parent-bol typescript-ts-mode-indent-offset) ((parent-is "named_imports") parent-bol typescript-ts-mode-indent-offset) @@ -331,13 +333,7 @@ Argument LANGUAGE is either `typescript' or `tsx'." :syntax-table typescript-ts-mode--syntax-table ;; Comments. - (setq-local comment-start "// ") - (setq-local comment-end "") - (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *") - (setq-local comment-end-skip - (rx (* (syntax whitespace)) - (group (or (syntax comment-end) - (seq (+ "*") "/"))))) + (c-ts-mode-comment-setup) (setq-local treesit-defun-prefer-top-level t) -- cgit v1.2.1 From 8f68b6497ee17791c3a1084ebef164f11cb089c6 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 26 Dec 2022 00:43:42 -0800 Subject: Clean up python-ts-mode font-lock features * lisp/progmodes/python.el (python--treesit-settings): Remove unnecessary override flags, add function and variable feature, fix assignment feature. (python--treesit-variable-p) (python--treesit-fontify-variable): New functions. (python-ts-mode): Add function and variable feature. --- lisp/progmodes/python.el | 39 ++++++++++++++++++++++++++++++--------- 1 file changed, 30 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 0cd0c6c225a..9a6f807f4f2 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1080,7 +1080,6 @@ fontified." :feature 'string :language 'python - :override t '((string) @python--treesit-fontify-string) :feature 'string-interpolation @@ -1130,7 +1129,7 @@ fontified." @font-lock-variable-name-face) (assignment left: (attribute attribute: (identifier) - @font-lock-variable-name-face)) + @font-lock-property-face)) (pattern_list (identifier) @font-lock-variable-name-face) (tuple_pattern (identifier) @@ -1162,12 +1161,10 @@ fontified." :feature 'number :language 'python - :override t '([(integer) (float)] @font-lock-number-face) :feature 'property :language 'python - :override t '((attribute attribute: (identifier) @font-lock-property-face) (class_definition @@ -1178,20 +1175,44 @@ fontified." :feature 'operator :language 'python - :override t `([,@python--treesit-operators] @font-lock-operator-face) :feature 'bracket :language 'python - :override t '(["(" ")" "[" "]" "{" "}"] @font-lock-bracket-face) :feature 'delimiter :language 'python - :override t - '(["," "." ":" ";" (ellipsis)] @font-lock-delimiter-face)) + '(["," "." ":" ";" (ellipsis)] @font-lock-delimiter-face) + + :feature 'variable + :language 'python + '((identifier) @python--treesit-fontify-variable)) "Tree-sitter font-lock settings.") +(defun python--treesit-variable-p (node) + "Check whether NODE is a variable. +NODE's type should be \"identifier\"." + ;; An identifier can be a function/class name, a property, or a + ;; variables. This funtion filters out function/class names and + ;; properties. + (pcase (treesit-node-type (treesit-node-parent node)) + ((or "function_definition" "class_definition") nil) + ("attribute" + (pcase (treesit-node-field-name node) + ("object" t) + (_ nil))) + (_ t))) + +(defun python--treesit-fontify-variable (node override start end &rest _) + "Fontify an identifier node if it is a variable. +For NODE, OVERRIDE, START, END, and ARGS, see +`treesit-font-lock-rules'." + (when (python--treesit-variable-p node) + (treesit-fontify-with-override + (treesit-node-start node) (treesit-node-end node) + 'font-lock-variable-name-face override start end))) + ;;; Indentation @@ -6646,7 +6667,7 @@ implementations: `python-mode' and `python-ts-mode'." ( keyword string type) ( assignment builtin constant decorator escape-sequence number property string-interpolation ) - ( function bracket delimiter operator))) + ( bracket delimiter function operator variable))) (setq-local treesit-font-lock-settings python--treesit-settings) (setq-local imenu-create-index-function #'python-imenu-treesit-create-index) -- cgit v1.2.1 From eb268728376db081b61f47c635b7316938e63d5d Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 26 Dec 2022 01:01:41 -0800 Subject: Fix imenu for c-ts-mode (bug#60296) * lisp/progmodes/c-ts-mode.el (c-ts-mode--imenu-1): Use c-ts-mode--defun-valid-p to filter out nested matches. (c-ts-mode--defun-valid-p): Handle more types of nodes. --- lisp/progmodes/c-ts-mode.el | 51 ++++++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 24 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 1bd5036be25..2847d65daf4 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -510,21 +510,10 @@ the subtrees." (set-marker (make-marker) (treesit-node-start ts-node))))) (cond - ;; A struct_specifier could be inside a parameter list, another - ;; struct definition, a variable declaration, a function - ;; declaration. In those cases we don't include it. - ((string-match-p - (rx (or "parameter_declaration" "field_declaration" - "declaration" "function_definition")) - (or (treesit-node-type (treesit-node-parent ts-node)) - "")) + ((or (null ts-node) (null name)) + subtrees) + ((null (c-ts-mode--defun-valid-p ts-node)) nil) - ;; Ignore function local variable declarations. - ((and (equal (treesit-node-type ts-node) "declaration") - (not (equal (treesit-node-type (treesit-node-parent ts-node)) - "translation_unit"))) - nil) - ((or (null ts-node) (null name)) subtrees) (subtrees `((,name ,(cons name marker) ,@subtrees))) (t @@ -550,16 +539,30 @@ the subtrees." ;;; Defun navigation (defun c-ts-mode--defun-valid-p (node) - (if (string-match-p - (rx (or "struct_specifier" - "enum_specifier" - "union_specifier")) - (treesit-node-type node)) - (null - (treesit-node-top-level - node (rx (or "function_definition" - "type_definition")))) - t)) + "Return non-nil if NODE is a valid defun node. +Ie, NODE is not nested." + (not (or (and (member (treesit-node-type node) + '("struct_specifier" + "enum_specifier" + "union_specifier" + "declaration")) + ;; If NODE's type is one of the above, make sure it is + ;; top-level. + (treesit-node-top-level + node (rx (or "function_definition" + "type_definition" + "struct_specifier" + "enum_specifier" + "union_specifier" + "declaration")))) + + (and (equal (treesit-node-type node) "declaration") + ;; If NODE is a declaration, make sure it is not a + ;; function declaration. + (equal (treesit-node-type + (treesit-node-child-by-field-name + node "declarator")) + "function_declarator"))))) (defun c-ts-mode--defun-skipper () "Custom defun skipper for `c-ts-mode' and friends. -- cgit v1.2.1 From d90d7d15f2f78c37b9a5c775e617ab6f5cd5fb01 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 26 Dec 2022 01:39:02 -0800 Subject: ; Fix vindexes in parsing.texi * doc/lispref/parsing.texi (Tree-sitter major modes): Replace vindex with cross-reference to modes.texi. Add manual entry for treesit-defun-type-regexp. * lisp/treesit.el (treesit-defun-type-regexp): Use pred in docstring since we use pred everywhere else. --- lisp/treesit.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index f3e1afd943e..2130cd00616 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1622,7 +1622,7 @@ For example, \"(function|class)_definition\". Sometimes not all nodes matched by the regexp are valid defuns. In that case, set this variable to a cons cell of the -form (REGEXP . FILTER), where FILTER is a function that takes a +form (REGEXP . PRED), where PRED is a function that takes a node (the matched node) and returns t if node is valid, or nil for invalid node. -- cgit v1.2.1 From 6c86faec29e7e9f12b71886dc66b62e1da43cdf7 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sun, 25 Dec 2022 15:31:33 -0500 Subject: loaddefs-gen: Group results by absolute file name loaddefs-generate produced an incomplete output file if 1) it was called with a relative file name and 2) that same file was specified via a generated-autoload-file cookie in a subset of the input files. In that case, autoload entries were lost because loaddefs-generate writes the same output file twice: once for the relative name specified by the caller and once for the absolute name that loaddefs-generate--parse-file returns for the generated-autoload-file value. This has been fixed. (Bug#60318) * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Expand file names when grouping loaddef files. --- lisp/emacs-lisp/loaddefs-gen.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 2dd04174f54..460d8eca586 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -608,7 +608,8 @@ instead of just updating them with the new/changed autoloads." (write-region (point-min) (point-max) output-file nil 'silent)) ;; We have some data, so generate the loaddef files. First ;; group per output file. - (dolist (fdefs (seq-group-by #'car defs)) + (dolist (fdefs (seq-group-by (lambda (x) (expand-file-name (car x))) + defs)) (let ((loaddefs-file (car fdefs)) hash) (with-temp-buffer -- cgit v1.2.1 From 082fc6e3088354f16ab8293725cc727a9855359b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 25 Dec 2022 15:32:06 +0100 Subject: Fix 'json-available-p' on MS-Windows * src/json.c (json_available_p, ensure_json_available) (Fjson__available_p): New functions. (Fjson_serialize, Fjson_insert, Fjson_parse_string) (Fjson_parse_buffer): Use ensure_json_available. (syms_of_json): Defsubr json--available-p. * lisp/subr.el (json-available-p): Rewrite. --- lisp/subr.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/subr.el b/lisp/subr.el index a5e66de27de..701c26f8cd8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6911,11 +6911,11 @@ sentence (see Info node `(elisp) Documentation Tips')." (defun json-available-p () "Return non-nil if Emacs has libjansson support." - (and (fboundp 'json-serialize) - (condition-case nil - (json-serialize t) - (:success t) - (json-unavailable nil)))) + (declare (side-effect-free error-free)) + (and (eval-when-compile (fboundp 'json-serialize)) + ;; If `json--available-p' is present, we need to call it at run-time. + (or (not (eval-when-compile (fboundp 'json--available-p))) + (json--available-p)))) (defun ensure-list (object) "Return OBJECT as a list. -- cgit v1.2.1 From 26b2ec7cb8c81db7d8705cb87579b325901ed303 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 26 Dec 2022 15:26:48 +0200 Subject: Simplify last change (bug#60311) * src/json.c (json_available_p): Use original code. Always return true for !WINDOWSNT. (ensure_json_available): Now defined only on WINDOWSNT. (Fjson_serialize, Fjson_insert, Fjson_parse_string) (Fjson_parse_buffer): Call ensure_json_available only on WINDOWSNT. * lisp/subr.el (json-available-p): Simplify. --- lisp/subr.el | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/subr.el b/lisp/subr.el index 701c26f8cd8..2fcdc7addf1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6911,11 +6911,8 @@ sentence (see Info node `(elisp) Documentation Tips')." (defun json-available-p () "Return non-nil if Emacs has libjansson support." - (declare (side-effect-free error-free)) - (and (eval-when-compile (fboundp 'json-serialize)) - ;; If `json--available-p' is present, we need to call it at run-time. - (or (not (eval-when-compile (fboundp 'json--available-p))) - (json--available-p)))) + (and (fboundp 'json--available-p) + (json--available-p))) (defun ensure-list (object) "Return OBJECT as a list. -- cgit v1.2.1 From a14821d61511b53acb70c56765e71ff283b3e230 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 26 Dec 2022 21:22:42 +0100 Subject: Improve gnutls-min-prime-bits docstring * lisp/net/gnutls.el (gnutls-min-prime-bits): Doc fix: delete out-of-date and now misleading sentence, added back when Emacs' default minimum prime bits for a Diffie-Hellman handshake was only 256 bits. These days, the default is nil, which means to let GnuTLS decide the value. (See also `nsm-protocol-check--dhe-prime-kx`.) --- lisp/net/gnutls.el | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 6e3845aec1a..9f14df08a79 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -128,10 +128,7 @@ key exchange is against man-in-the-middle attacks.) A value of nil says to use the default GnuTLS value. -The default value of this variable is such that virtually any -connection can be established, whether this connection can be -considered cryptographically \"safe\" or not. However, Emacs -network security is handled at a higher level via +Emacs network security is handled at a higher level via `open-network-stream' and the Network Security Manager. See Info node `(emacs) Network Security'." :type '(choice (const :tag "Use default value" nil) -- cgit v1.2.1 From 1fe4b98b4d5e0fe3d9964bd1789d3ee5be61dd2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rudolf=20Adamkovi=C4=8D?= Date: Sat, 24 Dec 2022 01:00:32 +0100 Subject: Improve support for Scheme R6RS and R7RS libraries (bug#54704) * etc/NEWS (Scheme mode): Document improved file-type auto-detection and Imenu support for R6RS and R7RS Scheme libraries. * lisp/files.el (auto-mode-alist): Associate the '.sls' (R6RS Scheme Library Source) and '.sld' (R7RS Scheme Library Definition) file name extensions with the Scheme mode. * lisp/progmodes/scheme.el (scheme-imenu-generic-expression): Make Imenu recognize the members nested (and so indented) inside of 'library' (R6RS) or 'define-library' (R7RS) forms. --- lisp/files.el | 2 +- lisp/progmodes/scheme.el | 20 +++++++++++++------- 2 files changed, 14 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/files.el b/lisp/files.el index f352d3a9a7e..522e4fbf935 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2850,7 +2850,7 @@ since only a single case-insensitive search through the alist is made." ("\\.emacs-places\\'" . lisp-data-mode) ("\\.el\\'" . emacs-lisp-mode) ("Project\\.ede\\'" . emacs-lisp-mode) - ("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode) + ("\\.\\(scm\\|sls\\|sld\\|stk\\|ss\\|sch\\)\\'" . scheme-mode) ("\\.l\\'" . lisp-mode) ("\\.li?sp\\'" . lisp-mode) ("\\.[fF]\\'" . fortran-mode) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 8454f24356a..f45d7992524 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -115,7 +115,8 @@ (defvar scheme-imenu-generic-expression `((nil - ,(rx bol "(define" + ,(rx bol (zero-or-more space) + "(define" (zero-or-one "*") (zero-or-one "-public") (one-or-more space) @@ -123,36 +124,41 @@ (group (one-or-more (or word (syntax symbol))))) 1) ("Methods" - ,(rx bol "(define-" + ,(rx bol (zero-or-more space) + "(define-" (or "generic" "method" "accessor") (one-or-more space) (zero-or-one "(") (group (one-or-more (or word (syntax symbol))))) 1) ("Classes" - ,(rx bol "(define-class" + ,(rx bol (zero-or-more space) + "(define-class" (one-or-more space) (zero-or-one "(") (group (one-or-more (or word (syntax symbol))))) 1) ("Records" - ,(rx bol "(define-record-type" + ,(rx bol (zero-or-more space) + "(define-record-type" (zero-or-one "*") (one-or-more space) (group (one-or-more (or word (syntax symbol))))) 1) ("Conditions" - ,(rx bol "(define-condition-type" + ,(rx bol (zero-or-more space) + "(define-condition-type" (one-or-more space) (group (one-or-more (or word (syntax symbol))))) 1) ("Modules" - ,(rx bol "(define-module" + ,(rx bol (zero-or-more space) + "(define-module" (one-or-more space) (group "(" (one-or-more any) ")")) 1) ("Macros" - ,(rx bol "(" + ,(rx bol (zero-or-more space) "(" (or (and "defmacro" (zero-or-one "*") (zero-or-one "-public")) -- cgit v1.2.1 From 1b4dc4691c1f87fc970fbe568b43869a15ad0d4c Mon Sep 17 00:00:00 2001 From: Xi Lu Date: Sat, 24 Dec 2022 16:28:54 +0800 Subject: Fix htmlfontify.el command injection vulnerability. * lisp/htmlfontify.el (hfy-text-p): Fix command injection vulnerability. (Bug#60295) --- lisp/htmlfontify.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index df4c6ab079c..389b92939cc 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1850,7 +1850,7 @@ Hardly bombproof, but good enough in the context in which it is being used." (defun hfy-text-p (srcdir file) "Is SRCDIR/FILE text? Use `hfy-istext-command' to determine this." - (let* ((cmd (format hfy-istext-command (expand-file-name file srcdir))) + (let* ((cmd (format hfy-istext-command (shell-quote-argument (expand-file-name file srcdir)))) (rsp (shell-command-to-string cmd))) (string-match "text" rsp))) -- cgit v1.2.1 From e3b4cd0ac1df326034492bcf64a25d95a1ca7e38 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 27 Dec 2022 16:10:42 +0200 Subject: ; * lisp/htmlfontify.el (hfy-text-p): Fix whitespace. --- lisp/htmlfontify.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 389b92939cc..32bf0bf4d44 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1850,8 +1850,9 @@ Hardly bombproof, but good enough in the context in which it is being used." (defun hfy-text-p (srcdir file) "Is SRCDIR/FILE text? Use `hfy-istext-command' to determine this." - (let* ((cmd (format hfy-istext-command (shell-quote-argument (expand-file-name file srcdir)))) - (rsp (shell-command-to-string cmd))) + (let* ((cmd (format hfy-istext-command + (shell-quote-argument (expand-file-name file srcdir)))) + (rsp (shell-command-to-string cmd))) (string-match "text" rsp))) ;; open a file, check fontification, if fontified, write a fontified copy -- cgit v1.2.1 From 41f12e1019bb96e424e27c2290b285bf7899de80 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 27 Dec 2022 17:28:08 +0100 Subject: ; * lisp/elide-head.el (elide-head): Doc fix to silence checkdoc. --- lisp/elide-head.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/elide-head.el b/lisp/elide-head.el index 75a3612df91..e79b582cb14 100644 --- a/lisp/elide-head.el +++ b/lisp/elide-head.el @@ -147,10 +147,11 @@ mode hooks." (defun elide-head (&optional arg) "Hide header material in buffer according to `elide-head-headers-to-hide'. -The header is made invisible with an overlay. With a prefix arg, show -an elided material again. +The header is made invisible with an overlay. With a prefix +argument ARG, show an elided material again. -This is suitable as an entry on `find-file-hook' or appropriate mode hooks." +This is suitable as an entry on `find-file-hook' or appropriate +mode hooks." (declare (obsolete elide-head-mode "29.1")) (interactive "P") (if arg -- cgit v1.2.1 From 624e3822110a94ff6bee2ffaf43a04271b5d7305 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 27 Dec 2022 18:59:59 +0200 Subject: ; Improve doc strings of some new faces * lisp/font-lock.el (font-lock-punctuation-face) (font-lock-delimiter-face): Doc fix. --- lisp/font-lock.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 2dfbe3ad232..831e603239b 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -2110,7 +2110,7 @@ For example, the declaration and use of fields in a struct." (defface font-lock-punctuation-face '((t nil)) - "Font Lock mode face used to highlight punctuation." + "Font Lock mode face used to highlight punctuation characters." :group 'font-lock-faces :version "29.1") @@ -2122,7 +2122,9 @@ For example, the declaration and use of fields in a struct." (defface font-lock-delimiter-face '((t :inherit font-lock-punctuation-face)) - "Font Lock mode face used to highlight delimiters." + "Font Lock mode face used to highlight delimiters. +What exactly is a delimiter depends on the major mode, but usually +these are characters like comma, colon, and semi-colon." :group 'font-lock-faces :version "29.1") -- cgit v1.2.1 From fb0ff54eb45ba9fc939d07740c895ed2ef58c406 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 27 Dec 2022 17:24:18 +0100 Subject: Make elide-head-headers-to-hide more forgiving * lisp/elide-head.el (elide-head-headers-to-hide): Make regexp more forgiving of line breaks and comment characters in address. * test/lisp/elide-head-tests.el (gpl3-6): New test. --- lisp/elide-head.el | 49 +++++++++++++++++++++++++++++++------------------ 1 file changed, 31 insertions(+), 18 deletions(-) (limited to 'lisp') diff --git a/lisp/elide-head.el b/lisp/elide-head.el index 75a3612df91..7f565d346d4 100644 --- a/lisp/elide-head.el +++ b/lisp/elide-head.el @@ -50,24 +50,37 @@ :group 'tools) (defcustom elide-head-headers-to-hide - `(;; GNU GPL - ("is free software[:;] you can redistribute it" . - ,(rx (or (seq "If not, see " (? "<") - "http" (? "s") "://www.gnu.org/licenses" - (? "/") (? ">") (? " ")) - (seq "Boston, MA " (? " ") - "0211" (or "1-1307" "0-1301") - (or " " ", ") "USA") - "675 Mass Ave, Cambridge, MA 02139, USA") - (? "."))) - ;; FreeBSD license / Modified BSD license (3-clause) - (,(rx (or "The Regents of the University of California. All rights reserved." - "Redistribution and use in source and binary")) - . "POSSIBILITY OF SUCH DAMAGE\\.") - ;; X11 and Expat - ("Permission is hereby granted, free of charge" . - ,(rx (or "authorization from the X Consortium." ; X11 - "THE USE OR OTHER DEALINGS IN THE SOFTWARE.")))) ; Expat + (rx-let ((delim + ;; A line break could be in a non-standard place, and the + ;; license could be in a comment. + (or + ;; Either just some spaces: + (+ " ") + ;; Or a newline and some comment starter: + (: (* (in " \t")) + "\n" + (* (in " \t")) + (* (or (syntax comment-start) (in ";#*-"))) + (* (in " \t")))))) + `(;; GNU GPL + ("is free software[:;] you can redistribute it" . + ,(rx (or (seq "If not, see " (? "<") + "http" (? "s") "://www.gnu.org/licenses" + (? "/") (? ">") (? " ")) + (seq "Boston," delim "MA" delim + (or "02111-1307" "02110-1301" "02111-1301") + (? ",") delim + "USA") + "675 Mass Ave, Cambridge, MA 02139, USA") + (? "."))) + ;; FreeBSD license / Modified BSD license (3-clause) + (,(rx (or "The Regents of the University of California. All rights reserved." + "Redistribution and use in source and binary")) + . "POSSIBILITY OF SUCH DAMAGE\\.") + ;; X11 and Expat + ("Permission is hereby granted, free of charge" . + ,(rx (or "authorization from the X Consortium." ; X11 + "THE USE OR OTHER DEALINGS IN THE SOFTWARE."))))) ; Expat "Alist of regexps defining start and end of text to elide. The cars of elements of the list are searched for in order. Text is -- cgit v1.2.1 From efc44727daaee4d3f9aeb19864074472e99b296a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 27 Dec 2022 18:12:02 +0100 Subject: Support Apache License 2.0 in elide-head-mode * lisp/elide-head.el (elide-head-headers-to-hide): Add the Apache License, Version 2.0. * test/lisp/elide-head-tests.el (apache1-1): New test. --- lisp/elide-head.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/elide-head.el b/lisp/elide-head.el index 7f565d346d4..71e7e67e3f7 100644 --- a/lisp/elide-head.el +++ b/lisp/elide-head.el @@ -79,8 +79,12 @@ . "POSSIBILITY OF SUCH DAMAGE\\.") ;; X11 and Expat ("Permission is hereby granted, free of charge" . - ,(rx (or "authorization from the X Consortium." ; X11 - "THE USE OR OTHER DEALINGS IN THE SOFTWARE."))))) ; Expat + ,(rx (or "authorization from the X Consortium." ; X11 + "THE USE OR OTHER DEALINGS IN THE SOFTWARE."))) ; Expat + ;; Apache + ("Licensed under the Apache License, Version 2.0" . + "limitations under the License.") + )) "Alist of regexps defining start and end of text to elide. The cars of elements of the list are searched for in order. Text is @@ -91,7 +95,7 @@ cdr. This affects `elide-head-mode'." :type '(alist :key-type (regexp :tag "Start regexp") :value-type (regexp :tag "End regexp")) - :version "29.1") + :version "30.1") (defvar-local elide-head-overlay nil) -- cgit v1.2.1 From 8b8b79156798b4ffa791e9a9f0262a5ffdc867e8 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 27 Dec 2022 20:23:16 +0200 Subject: ; Improve documentation of TAB/SPC indentation * lisp/indent.el (tab-to-tab-stop): * src/indent.c (Findent_to): Mention 'indent-tabs-mode' in doc strings. --- lisp/indent.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/indent.el b/lisp/indent.el index c7ec5c9a3ed..6b575a86b5e 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -784,7 +784,8 @@ If PREV is non-nil, return the previous one instead." (defun tab-to-tab-stop () "Insert spaces or tabs to next defined tab-stop column. The variable `tab-stop-list' is a list of columns at which there are tab stops. -Use \\[edit-tab-stops] to edit them interactively." +Use \\[edit-tab-stops] to edit them interactively. +Whether this inserts tabs or spaces depends on `indent-tabs-mode'." (interactive) (and abbrev-mode (= (char-syntax (preceding-char)) ?w) (expand-abbrev)) -- cgit v1.2.1 From 8ab6df0c9fdcef11170163e68248092ef2742801 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 27 Dec 2022 13:46:40 +0100 Subject: ; * lisp/epa-ks.el (epa-ks-do-key-to-fetch): Fix 'when' usage --- lisp/epa-ks.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index bb64b61b8fa..668cdf9a618 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -135,9 +135,9 @@ Keys are marked using `epa-ks-mark-key-to-fetch'." keys)) (forward-line)) (when (yes-or-no-p (format "Proceed with fetching all %d key(s)? " - (length keys)))) - (dolist (id keys) - (epa-ks--fetch-key id)))) + (length keys))) + (dolist (id keys) + (epa-ks--fetch-key id))))) (tabulated-list-clear-all-tags)) (defun epa-ks--query-url (query exact) -- cgit v1.2.1 From 637f5b164f2dedad45bff6d881231a8f014c65bc Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 27 Dec 2022 20:28:05 +0100 Subject: ; Add "src" to the heuristic sub-directory heuristic * lisp/emacs-lisp/package-vc.el (package-vc--unpack): Check for "src" directories, next to "lisp". --- lisp/emacs-lisp/package-vc.el | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index b01f87d0494..a9fbdfea210 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -613,18 +613,21 @@ checkout. This overrides the `:branch' attribute in PKG-SPEC." ;; When nothing is specified about a `lisp-dir', then should ;; heuristically check if there is a sub-directory with lisp - ;; files. These are conventionally just called "lisp". If this - ;; directory exists and contains non-zero number of lisp files, we - ;; will use that instead of `pkg-dir'. - (when-let* (((null lisp-dir)) - (dir (expand-file-name "lisp" pkg-dir)) - ((file-directory-p dir)) - ((directory-files dir nil "\\`[^.].+\\.el\\'" t 1))) - ;; We won't use `dir', since dir is an absolute path and we - ;; don't want `lisp-dir' to depend on the current location of - ;; the package installation, ie. to break if moved around the - ;; file system or between installations. - (setq lisp-dir "lisp")) + ;; files. These are conventionally just called "lisp" or "src". + ;; If this directory exists and contains non-zero number of lisp + ;; files, we will use that instead of `pkg-dir'. + (catch 'done + (dolist (name '("lisp" "src")) + (when-let* (((null lisp-dir)) + (dir (expand-file-name name pkg-dir)) + ((file-directory-p dir)) + ((directory-files dir nil "\\`[^.].+\\.el\\'" t 1))) + ;; We won't use `dir', since dir is an absolute path and we + ;; don't want `lisp-dir' to depend on the current location of + ;; the package installation, ie. to break if moved around the + ;; file system or between installations. + (throw 'done (setq lisp-dir name))))) + (when lisp-dir (push (cons :lisp-dir lisp-dir) (package-desc-extras pkg-desc))) -- cgit v1.2.1 From 5326b041982287514522f7f7930ff243d8d5cc70 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Tue, 27 Dec 2022 15:07:03 -0800 Subject: Improve treesit-node-top-level and treesit-parent-until * lisp/treesit.el (treesit-node-top-level): Now it can accept a predicate function. Add an optional argument INCLUDE-NODE. (treesit-parent-until): Add an optional argument INCLUDE-NODE. --- lisp/treesit.el | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 2130cd00616..675ecd85b08 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -234,19 +234,27 @@ is nil, try to guess the language at BEG using `treesit-language-at'." (or parser-or-lang (treesit-language-at beg)))))) (treesit-node-descendant-for-range root beg (or end beg) named))) -(defun treesit-node-top-level (node &optional type) +(defun treesit-node-top-level (node &optional pred include-node) "Return the top-level equivalent of NODE. + Specifically, return the highest parent of NODE that has the same type as it. If no such parent exists, return nil. -If TYPE is non-nil, match each parent's type with TYPE as a -regexp, rather than using NODE's type." - (let ((type (or type (treesit-node-type node))) +If PRED is non-nil, match each parent's type with PRED as a +regexp, rather than using NODE's type. PRED can also be a +function that takes the node as an argument, and return +non-nil/nil for match/no match. + +If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED." + (let ((pred (or pred (treesit-node-type node))) (result nil)) - (cl-loop for cursor = (treesit-node-parent node) + (cl-loop for cursor = (if include-node node + (treesit-node-parent node)) then (treesit-node-parent cursor) while cursor - if (string-match-p type (treesit-node-type cursor)) + if (if (stringp pred) + (string-match-p pred (treesit-node-type cursor)) + (funcall pred cursor)) do (setq result cursor)) result)) @@ -290,11 +298,16 @@ properties." (treesit-node-start node) (treesit-node-end node)))))) -(defun treesit-parent-until (node pred) +(defun treesit-parent-until (node pred &optional include-node) "Return the closest parent of NODE that satisfies PRED. + Return nil if none was found. PRED should be a function that -takes one argument, the parent node." - (let ((node (treesit-node-parent node))) +takes one argument, the parent node, and return non-nil/nil for +match/no match. + +If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED." + (let ((node (if include-node node + (treesit-node-parent node)))) (while (and node (not (funcall pred node))) (setq node (treesit-node-parent node))) node)) -- cgit v1.2.1 From 7512b9025a152ea953918e1c0748b695b742b4b6 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Tue, 27 Dec 2022 15:08:07 -0800 Subject: ; * lisp/treesit.el (treesit-traverse-parent): Remove alias. It was added with treesit-traverse-xxx functions, since now they are gone, this alias doesn't make sense by itself anymore. --- lisp/treesit.el | 2 -- 1 file changed, 2 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 675ecd85b08..fd61cbb8600 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -322,8 +322,6 @@ takes one argument, the parent node." node (treesit-node-parent node))) last)) -(defalias 'treesit-traverse-parent #'treesit-parent-until) - (defun treesit-node-children (node &optional named) "Return a list of NODE's children. If NAMED is non-nil, collect named child only." -- cgit v1.2.1 From ba1ddea9dabf51c9c6e463d667bcce0b48294453 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Tue, 27 Dec 2022 17:02:03 -0800 Subject: Fix treesit--things-around (bug#60355) Current implementation of treesit--things-around only searches forward for REGEXP and go up the tree until it finds a valid thing, if nothing matches it gives up. This makes it sometimes miss defuns. The new implementation tries multiple times (of search forward + go up) until it exhausts all possible defun nodes. * lisp/treesit.el (treesit--things-around): New implementation. (treesit--navigate-defun): Refactor to use treesit-node-top-level to simplify code, and add some guards in the predicate function. * test/src/treesit-tests.el: (treesit--ert-defun-navigation-elixir-program): New variable. (treesit-defun-navigation-nested-4): New test. --- lisp/treesit.el | 109 +++++++++++++++++++++++++------------------------------- 1 file changed, 49 insertions(+), 60 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index fd61cbb8600..f3fdcfb652c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1773,78 +1773,67 @@ sound things exists. REGEXP and PRED are the same as in `treesit-thing-at-point'." (let* ((node (treesit-node-at pos)) - ;; NODE-BEFORE/AFTER = NODE when POS is completely in NODE, - ;; but if not, that means point could be in between two - ;; defun, in that case we want to use a node that's actually - ;; before/after point. - (node-before (if (>= (treesit-node-start node) pos) - (save-excursion - (treesit-search-forward-goto node "" t t t)) - node)) - (node-after (if (<= (treesit-node-end node) pos) - (save-excursion - (treesit-search-forward-goto - node "" nil nil t)) - node)) - (result (list nil nil nil)) - (pred (or pred (lambda (_) t)))) + (result (list nil nil nil))) ;; 1. Find previous and next sibling defuns. (cl-loop for idx from 0 to 1 - for node in (list node-before node-after) for backward in '(t nil) + ;; Make sure we go in the right direction, and the defun we find + ;; doesn't cover POS. for pos-pred in (list (lambda (n) (<= (treesit-node-end n) pos)) (lambda (n) (>= (treesit-node-start n) pos))) - ;; If point is inside a defun, our process below will never - ;; return a next/prev sibling outside of that defun, effectively - ;; any prev/next sibling is locked inside the smallest defun - ;; covering point, which is the correct behavior. That's because - ;; when there exists a defun that covers point, - ;; `treesit-search-forward' will first reach that defun, after - ;; that we only go upwards in the tree, so other defuns outside - ;; of the covering defun is never reached. (Don't use - ;; `treesit-search-forward-goto' as it breaks when NODE-AFTER is - ;; the last token of a parent defun: it will skip the parent - ;; defun because it wants to ensure progress.) - do (cl-loop for cursor = (when node - (save-excursion - (treesit-search-forward - node regexp backward backward))) - then (treesit-node-parent cursor) - while cursor - if (and (string-match-p - regexp (treesit-node-type cursor)) - (funcall pred cursor) - (funcall pos-pred cursor)) - do (setf (nth idx result) cursor))) + ;; We repeatedly find next defun candidate with + ;; `treesit-search-forward', and check if it is a valid defun, + ;; until the node we find covers POS, meaning we've gone through + ;; every possible sibling defuns. But there is a catch: + ;; `treesit-search-forward' searches bottom-up, so for each + ;; candidate we need to go up the tree and find the top-most + ;; valid sibling, this defun will be at the same level as POS. + ;; Don't use `treesit-search-forward-goto', it skips nodes in + ;; order to enforce progress. + when node + do (let ((cursor node) + (iter-pred (lambda (node) + (and (string-match-p + regexp (treesit-node-type node)) + (or (null pred) (funcall pred node)) + (funcall pos-pred node))))) + ;; Find the node just before/after POS to start searching. + (save-excursion + (while (and cursor (not (funcall pos-pred cursor))) + (setq cursor (treesit-search-forward-goto + cursor "" backward backward t)))) + ;; Keep searching until we run out of candidates. + (while (and cursor + (funcall pos-pred cursor) + (null (nth idx result))) + (setf (nth idx result) + (treesit-node-top-level cursor iter-pred t)) + (setq cursor (treesit-search-forward + cursor regexp backward backward))))) ;; 2. Find the parent defun. - (setf (nth 2 result) - (cl-loop for cursor = (or (nth 0 result) - (nth 1 result) - node) - then (treesit-node-parent cursor) - while cursor - if (and (string-match-p - regexp (treesit-node-type cursor)) - (funcall pred cursor) - (not (member cursor result))) - return cursor)) + (let ((cursor (or (nth 0 result) (nth 1 result) node)) + (iter-pred (lambda (node) + (and (string-match-p + regexp (treesit-node-type node)) + (or (null pred) (funcall pred node)) + (not (treesit-node-eq node (nth 0 result))) + (not (treesit-node-eq node (nth 1 result))) + (< (treesit-node-start node) + pos + (treesit-node-end node)))))) + (setf (nth 2 result) + (treesit-parent-until cursor iter-pred))) result)) (defun treesit--top-level-thing (node regexp &optional pred) "Return the top-level parent thing of NODE. REGEXP and PRED are the same as in `treesit-thing-at-point'." - (let* ((pred (or pred (lambda (_) t)))) - ;; `treesit-search-forward-goto' will make sure the matched node - ;; is before POS. - (cl-loop for cursor = node - then (treesit-node-parent cursor) - while cursor - if (and (string-match-p - regexp (treesit-node-type cursor)) - (funcall pred cursor)) - do (setq node cursor)) - node)) + (treesit-node-top-level + node (lambda (node) + (and (string-match-p regexp (treesit-node-type node)) + (or (null pred) (funcall pred node)))) + t)) ;; The basic idea for nested defun navigation is that we first try to ;; move across sibling defuns in the same level, if no more siblings -- cgit v1.2.1 From b39dc7ab27a696a8607ab859aeff3c71509231f5 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Tue, 27 Dec 2022 20:37:29 -0800 Subject: Add tree-sitter helper functions for Imenu We didn't add an integration for Imenu because we aren't sure what should it look like. Now we have a pretty good idea. All the major modes copy-paste the two Imenu functions and tweaks them in a standard way. With the addition of treesit-defun-type-regexp and treesit-defun-name-function, now is a good time to standardize Imenu integration. In the next commit we update all the major modes to use this integration. * doc/lispref/modes.texi (Imenu): Add manual. * doc/lispref/parsing.texi (Tree-sitter major modes): Update manual. * lisp/treesit.el (treesit-simple-imenu-settings): New varaible. (treesit--simple-imenu-1) (treesit-simple-imenu): New functions. (treesit-major-mode-setup): Setup Imenu. --- lisp/treesit.el | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 95 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index f3fdcfb652c..0aab0a12614 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2009,6 +2009,91 @@ The delimiter between nested defun names is controlled by (setq node (treesit-node-parent node))) name)) +;;; Imenu + +(defvar treesit-simple-imenu-settings nil + "Settings that configure `treesit-simple-imenu'. + +It should be a list of (CATEGORY REGEXP PRED NAME-FN). + +CATEGORY is the name of a category, like \"Function\", \"Class\", +etc. REGEXP should be a regexp matching the type of nodes that +belong to CATEGORY. PRED should be either nil or a function +that takes a node an the argument. It should return non-nil if +the node is a valid node for CATEGORY, or nil if not. + +CATEGORY could also be nil. In that case the entries matched by +REGEXP and PRED are not grouped under CATEGORY. + +NAME-FN should be either nil or a function that takes a defun +node and returns the name of that defun node. If NAME-FN is nil, +`treesit-defun-name' is used. + +`treesit-major-mode-setup' automatically sets up Imenu if this +variable is non-nil.") + +(defun treesit--simple-imenu-1 (node pred name-fn) + "Given a sparse tree, create an Imenu index. + +NODE is a node in the tree returned by +`treesit-induce-sparse-tree' (not a tree-sitter node, its car is +a tree-sitter node). Walk that tree and return an Imenu index. + +Return a list of ENTRYs where + +ENTRY := (NAME . MARKER) + | (NAME . ((\" \" . MARKER) + ENTRY + ...) + +PRED and NAME-FN are the same as described in +`treesit-simple-imenu-settings'. NAME-FN computes NAME in an +ENTRY. MARKER marks the start of each tree-sitter node." + (let* ((ts-node (car node)) + (children (cdr node)) + (subtrees (mapcan (lambda (node) + (treesit--simple-imenu-1 node pred name-fn)) + children)) + ;; The root of the tree could have a nil ts-node. + (name (when ts-node + (or (if name-fn + (funcall name-fn ts-node) + (treesit-defun-name ts-node)) + "Anonymous"))) + (marker (when ts-node + (set-marker (make-marker) + (treesit-node-start ts-node))))) + (cond + ;; The tree-sitter node in the root node of the tree returned by + ;; `treesit-induce-sparse-tree' is often nil. + ((null ts-node) + subtrees) + ;; This tree-sitter node is not a valid entry, skip it. + ((and pred (not (funcall pred ts-node))) + subtrees) + ;; Non-leaf node, return a (list of) subgroup. + (subtrees + `((,name + ,(cons " " marker) + ,@subtrees))) + ;; Leaf node, return a (list of) plain index entry. + (t (list (cons name marker)))))) + +(defun treesit-simple-imenu () + "Return an Imenu index for the current buffer." + (let ((root (treesit-buffer-root-node))) + (mapcan (lambda (setting) + (pcase-let ((`(,category ,regexp ,pred ,name-fn) + setting)) + (when-let* ((tree (treesit-induce-sparse-tree + root regexp)) + (index (treesit--simple-imenu-1 + tree pred name-fn))) + (if category + (list (cons category index)) + index)))) + treesit-simple-imenu-settings))) + ;;; Activating tree-sitter (defun treesit-ready-p (language &optional quiet) @@ -2066,6 +2151,11 @@ If `treesit-simple-indent-rules' is non-nil, setup indentation. If `treesit-defun-type-regexp' is non-nil, setup `beginning/end-of-defun' functions. +If `treesit-defun-name-function' is non-nil, setup +`add-log-current-defun'. + +If `treesit-simple-imenu-settings' is non-nil, setup Imenu. + Make sure necessary parsers are created for the current buffer before calling this function." ;; Font-lock. @@ -2106,7 +2196,11 @@ before calling this function." ;; Defun name. (when treesit-defun-name-function (setq-local add-log-current-defun-function - #'treesit-add-log-current-defun))) + #'treesit-add-log-current-defun)) + ;; Imenu. + (when treesit-simple-imenu-settings + (setq-local imenu-create-index-function + #'treesit-simple-imenu))) ;;; Debugging -- cgit v1.2.1 From 248c13dcfe1b9618811a6fe67e967b25b1a8f139 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Tue, 27 Dec 2022 20:57:12 -0800 Subject: Update tree-sitter major modes to use the new Imenu facility See previous commit for more explanation. * lisp/progmodes/c-ts-mode.el (c-ts-mode--defun-name): Handle more types. (c-ts-mode--imenu-1) (c-ts-mode--imenu): Remove functions. (c-ts-base-mode): Setup Imenu. * lisp/progmodes/csharp-mode.el (csharp-ts-mode--imenu-1) (csharp-ts-mode--imenu): Remove functions. (csharp-ts-mode): Setup Imenu. * lisp/progmodes/java-ts-mode.el (java-ts-mode--imenu-1) (java-ts-mode--imenu): Remove functions. (java-ts-mode): Setup Imenu. * lisp/progmodes/js.el (js--treesit-imenu-1) (js--treesit-imenu): Remove functions. (js--treesit-valid-imenu-entry): New function. (js-ts-mode): Setup Imenu. * lisp/progmodes/json-ts-mode.el (json-ts-mode--defun-name): Trim the quotes. (json-ts-mode--imenu-1) (json-ts-mode--imenu): Remove functions. (json-ts-mode): Setup Imenu. * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--imenu) (rust-ts-mode--imenu-1): Remove functions. (rust-ts-mode): Setup Imenu. * lisp/progmodes/typescript-ts-mode.el: (typescript-ts-base-mode): Remove treesit-defun-prefer-top-level, it's not used anymore. Setup Imenu. Setup treesit-defun-name-function. * lisp/textmodes/css-mode.el (css--treesit-imenu-1) (css--treesit-imenu): Remove functions. (css-ts-mode): Setup Imenu. * lisp/textmodes/toml-ts-mode.el (toml-ts-mode--defun-name): Fix it and add a fallback. (toml-ts-mode--imenu-1) (toml-ts-mode--imenu): Remove functions. (toml-ts-mode): Setup Imenu. --- lisp/progmodes/c-ts-mode.el | 57 +++++++------------------ lisp/progmodes/csharp-mode.el | 58 ++++---------------------- lisp/progmodes/java-ts-mode.el | 51 +++-------------------- lisp/progmodes/js.el | 81 ++++++------------------------------ lisp/progmodes/json-ts-mode.el | 39 ++++------------- lisp/progmodes/rust-ts-mode.el | 59 ++++---------------------- lisp/progmodes/typescript-ts-mode.el | 18 ++++---- lisp/textmodes/css-mode.el | 32 ++------------ lisp/textmodes/toml-ts-mode.el | 40 +++--------------- 9 files changed, 73 insertions(+), 362 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 2847d65daf4..5f15861eed8 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -487,55 +487,17 @@ For NODE, OVERRIDE, START, and END, see (defun c-ts-mode--defun-name (node) "Return the name of the defun NODE. -Return nil if NODE is not a defun node, return an empty string if -NODE doesn't have a name." +Return nil if NODE is not a defun node or doesn't have a name." (treesit-node-text (pcase (treesit-node-type node) ((or "function_definition" "declaration") (c-ts-mode--declarator-identifier (treesit-node-child-by-field-name node "declarator"))) - ("struct_specifier" + ((or "struct_specifier" "enum_specifier" + "union_specifier" "class_specifier") (treesit-node-child-by-field-name node "name"))) t)) -(defun c-ts-mode--imenu-1 (node) - "Helper for `c-ts-mode--imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (subtrees (mapcan #'c-ts-mode--imenu-1 (cdr node))) - (name (when ts-node - (treesit-defun-name ts-node))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((or (null ts-node) (null name)) - subtrees) - ((null (c-ts-mode--defun-valid-p ts-node)) - nil) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) - -(defun c-ts-mode--imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (func-tree (treesit-induce-sparse-tree - node "^function_definition$" nil 1000)) - (var-tree (treesit-induce-sparse-tree - node "^declaration$" nil 1000)) - (struct-tree (treesit-induce-sparse-tree - node "^struct_specifier$" nil 1000)) - (func-index (c-ts-mode--imenu-1 func-tree)) - (var-index (c-ts-mode--imenu-1 var-tree)) - (struct-index (c-ts-mode--imenu-1 struct-tree))) - (append - (when struct-index `(("Struct" . ,struct-index))) - (when var-index `(("Variable" . ,var-index))) - (when func-index `(("Function" . ,func-index)))))) - ;;; Defun navigation (defun c-ts-mode--defun-valid-p (node) @@ -745,8 +707,17 @@ Set up: (append "{}():;," electric-indent-chars)) ;; Imenu. - (setq-local imenu-create-index-function #'c-ts-mode--imenu) - (setq-local which-func-functions nil) + (setq-local treesit-simple-imenu-settings + (let ((pred #'c-ts-mode--defun-valid-p)) + `(("Struct" ,(rx bos (or "struct" "enum" "union") + "_specifier" eos) + ,pred nil) + ("Variable" ,(rx bos "declaration" eos) ,pred nil) + ("Function" "\\`function_definition\\'" ,pred nil) + ("Class" ,(rx bos (or "class_specifier" + "function_definition") + eos) + ,pred nil)))) (setq-local treesit-font-lock-feature-list '(( comment definition) diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 13a6f6254f5..b967571db7d 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -857,54 +857,6 @@ Return nil if there is no name or if NODE is not a defun node." node "name") t)))) -(defun csharp-ts-mode--imenu-1 (node) - "Helper for `csharp-ts-mode--imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (subtrees (mapcan #'csharp-ts-mode--imenu-1 (cdr node))) - (name (when ts-node - (or (treesit-defun-name ts-node) - "Unnamed node"))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((null ts-node) subtrees) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) - -(defun csharp-ts-mode--imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (class-tree (treesit-induce-sparse-tree - node "^class_declaration$" nil 1000)) - (interface-tree (treesit-induce-sparse-tree - node "^interface_declaration$" nil 1000)) - (enum-tree (treesit-induce-sparse-tree - node "^enum_declaration$" nil 1000)) - (struct-tree (treesit-induce-sparse-tree - node "^struct_declaration$" nil 1000)) - (record-tree (treesit-induce-sparse-tree - node "^record_declaration$" nil 1000)) - (method-tree (treesit-induce-sparse-tree - node "^method_declaration$" nil 1000)) - (class-index (csharp-ts-mode--imenu-1 class-tree)) - (interface-index (csharp-ts-mode--imenu-1 interface-tree)) - (enum-index (csharp-ts-mode--imenu-1 enum-tree)) - (record-index (csharp-ts-mode--imenu-1 record-tree)) - (struct-index (csharp-ts-mode--imenu-1 struct-tree)) - (method-index (csharp-ts-mode--imenu-1 method-tree))) - (append - (when class-index `(("Class" . ,class-index))) - (when interface-index `(("Interface" . ,interface-index))) - (when enum-index `(("Enum" . ,enum-index))) - (when record-index `(("Record" . ,record-index))) - (when struct-index `(("Struct" . ,struct-index))) - (when method-index `(("Method" . ,method-index)))))) - ;;;###autoload (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) @@ -955,8 +907,14 @@ Key bindings: ( bracket delimiter))) ;; Imenu. - (setq-local imenu-create-index-function #'csharp-ts-mode--imenu) - (setq-local which-func-functions nil) ;; Piggyback on imenu + (setq-local treesit-simple-imenu-settings + '(("Class" "\\`class_declaration\\'" nil nil) + ("Interface" "\\`interface_declaration\\'" nil nil) + ("Enum" "\\`enum_declaration\\'" nil nil) + ("Record" "\\`record_declaration\\'" nil nil) + ("Struct" "\\`struct_declaration\\'" nil nil) + ("Method" "\\`method_declaration\\'" nil nil))) + (treesit-major-mode-setup)) (provide 'csharp-mode) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index ddad8c7afb9..c389f795dd3 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -266,50 +266,6 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-node-child-by-field-name node "name") t)))) -(defun java-ts-mode--imenu-1 (node) - "Helper for `java-ts-mode--imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (subtrees (mapcan #'java-ts-mode--imenu-1 (cdr node))) - (name (when ts-node - (or (treesit-defun-name ts-node) - "Unnamed node"))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((null ts-node) subtrees) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) - -(defun java-ts-mode--imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (class-tree (treesit-induce-sparse-tree - node "^class_declaration$" nil 1000)) - (interface-tree (treesit-induce-sparse-tree - node "^interface_declaration$" nil 1000)) - (enum-tree (treesit-induce-sparse-tree - node "^enum_declaration$" nil 1000)) - (record-tree (treesit-induce-sparse-tree - node "^record_declaration$" nil 1000)) - (method-tree (treesit-induce-sparse-tree - node "^method_declaration$" nil 1000)) - (class-index (java-ts-mode--imenu-1 class-tree)) - (interface-index (java-ts-mode--imenu-1 interface-tree)) - (enum-index (java-ts-mode--imenu-1 enum-tree)) - (record-index (java-ts-mode--imenu-1 record-tree)) - (method-index (java-ts-mode--imenu-1 method-tree))) - (append - (when class-index `(("Class" . ,class-index))) - (when interface-index `(("Interface" . ,interface-index))) - (when enum-index `(("Enum" . ,enum-index))) - (when record-index `(("Record" . ,record-index))) - (when method-index `(("Method" . ,method-index)))))) - ;;;###autoload (define-derived-mode java-ts-mode prog-mode "Java" "Major mode for editing Java, powered by tree-sitter." @@ -352,8 +308,11 @@ the subtrees." ( bracket delimiter operator))) ;; Imenu. - (setq-local imenu-create-index-function #'java-ts-mode--imenu) - (setq-local which-func-functions nil) ;; Piggyback on imenu + (setq-local treesit-simple-imenu-settings + '(("Class" "\\`class_declaration\\'" nil nil) + ("Interface "\\`interface_declaration\\'" nil nil) + ("Enum" "\\`record_declaration\\'" nil nil) + ("Method" "\\`method_declaration\\'" nil nil))) (treesit-major-mode-setup)) (provide 'java-ts-mode) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index a6e6dc05418..c7a40ab1adb 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3670,70 +3670,11 @@ Return nil if there is no name or if NODE is not a defun node." "name") t)) -(defun js--treesit-imenu-1 (node) - "Given a sparse tree, create an imenu alist. - -NODE is the root node of the tree returned by -`treesit-induce-sparse-tree' (not a tree-sitter node, its car is -a tree-sitter node). Walk that tree and return an imenu alist. - -Return a list of ENTRY where - -ENTRY := (NAME . MARKER) - | (NAME . ((JUMP-LABEL . MARKER) - ENTRY - ...) - -NAME is the function/class's name, JUMP-LABEL is like \"*function -definition*\"." - (let* ((ts-node (car node)) - (children (cdr node)) - (subtrees (mapcan #'js--treesit-imenu-1 - children)) - (type (pcase (treesit-node-type ts-node) - ("lexical_declaration" 'variable) - ("class_declaration" 'class) - ("method_definition" 'method) - ("function_declaration" 'function))) - ;; The root of the tree could have a nil ts-node. - (name (when ts-node - (or (treesit-defun-name ts-node) - "Anonymous"))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((null ts-node) - subtrees) - ;; Don't included non-top-level variable declarations. - ((and (eq type 'variable) - (treesit-node-top-level ts-node)) - nil) - (subtrees - `((,name - ,(cons "" marker) - ,@subtrees))) - (t (list (cons name marker)))))) - -(defun js--treesit-imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (class-tree (treesit-induce-sparse-tree - node (rx (or "class_declaration" - "method_definition")) - nil 1000)) - (func-tree (treesit-induce-sparse-tree - node "function_declaration" nil 1000)) - (var-tree (treesit-induce-sparse-tree - node "lexical_declaration" nil 1000))) - ;; When a sub-tree is empty, we should not return that pair at all. - (append - (and func-tree - `(("Function" . ,(js--treesit-imenu-1 func-tree)))) - (and var-tree - `(("Variable" . ,(js--treesit-imenu-1 var-tree)))) - (and class-tree - `(("Class" . ,(js--treesit-imenu-1 class-tree))))))) +(defun js--treesit-valid-imenu-entry (node) + "Return nil if NODE is a non-top-level \"lexical_declaration\"." + (pcase (treesit-node-type node) + ("lexical_declaration" (treesit-node-top-level node)) + (_ t))) ;;; Main Function @@ -3875,10 +3816,14 @@ Currently there are `js-mode' and `js-ts-mode'." identifier jsx number pattern property) ( bracket delimiter operator))) ;; Imenu - (setq-local imenu-create-index-function - #'js--treesit-imenu) - ;; Which-func (use imenu). - (setq-local which-func-functions nil) + (setq-local treesit-simple-imenu-settings + `(("Function" "\\`function_declaration\\'" nil nil) + ("Variable" "\\`lexical_declaration\\'" + js--treesit-valid-imenu-entry nil) + ("Class" ,(rx bos (or "class_declaration" + "method_definition") + eos) + nil nil))) (treesit-major-mode-setup))) ;;;###autoload diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index 6725c5f2270..2a467dccecc 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -112,36 +112,11 @@ Return nil if there is no name or if NODE is not a defun node." (pcase (treesit-node-type node) ((or "pair" "object") - (treesit-node-text - (treesit-node-child-by-field-name - node "key") - t)))) - -(defun json-ts-mode--imenu-1 (node) - "Helper for `json-ts-mode--imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (subtrees (mapcan #'json-ts-mode--imenu-1 (cdr node))) - (name (when ts-node - (or (treesit-defun-name ts-node) - "Anonymous"))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((null ts-node) subtrees) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) - -(defun json-ts-mode--imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (tree (treesit-induce-sparse-tree - node "pair" nil 1000))) - (json-ts-mode--imenu-1 tree))) + (string-trim (treesit-node-text + (treesit-node-child-by-field-name + node "key") + t) + "\"" "\"")))) ;;;###autoload (define-derived-mode json-ts-mode prog-mode "JSON" @@ -179,8 +154,8 @@ the subtrees." (bracket delimiter error))) ;; Imenu. - (setq-local imenu-create-index-function #'json-ts-mode--imenu) - (setq-local which-func-functions nil) ;; Piggyback on imenu + (setq-local treesit-simple-imenu-settings + '((nil "\\`pair\\'" nil nil))) (treesit-major-mode-setup)) diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index d8cd2a195d2..d03dffe628e 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -248,35 +248,6 @@ '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `rust-ts-mode'.") -(defun rust-ts-mode--imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (enum-tree (treesit-induce-sparse-tree - node "enum_item" nil)) - (enum-index (rust-ts-mode--imenu-1 enum-tree)) - (func-tree (treesit-induce-sparse-tree - node "function_item" nil)) - (func-index (rust-ts-mode--imenu-1 func-tree)) - (impl-tree (treesit-induce-sparse-tree - node "impl_item" nil)) - (impl-index (rust-ts-mode--imenu-1 impl-tree)) - (mod-tree (treesit-induce-sparse-tree - node "mod_item" nil)) - (mod-index (rust-ts-mode--imenu-1 mod-tree)) - (struct-tree (treesit-induce-sparse-tree - node "struct_item" nil)) - (struct-index (rust-ts-mode--imenu-1 struct-tree)) - (type-tree (treesit-induce-sparse-tree - node "type_item" nil)) - (type-index (rust-ts-mode--imenu-1 type-tree))) - (append - (when mod-index `(("Module" . ,mod-index))) - (when enum-index `(("Enum" . ,enum-index))) - (when impl-index `(("Impl" . ,impl-index))) - (when type-index `(("Type" . ,type-index))) - (when struct-index `(("Struct" . ,struct-index))) - (when func-index `(("Fn" . ,func-index)))))) - (defun rust-ts-mode--defun-name (node) "Return the defun name of NODE. Return nil if there is no name or if NODE is not a defun node." @@ -304,27 +275,6 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-node-text (treesit-node-child-by-field-name node "name") t)))) -(defun rust-ts-mode--imenu-1 (node) - "Helper for `rust-ts-mode--imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (children (cdr node)) - (subtrees (mapcan #'rust-ts-mode--imenu-1 - children)) - (name (when ts-node - (or (treesit-defun-name ts-node) - "Anonymous"))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((or (null ts-node) (null name)) subtrees) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) - ;;;###autoload (add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode)) @@ -350,8 +300,13 @@ the subtrees." ( bracket delimiter error operator))) ;; Imenu. - (setq-local imenu-create-index-function #'rust-ts-mode--imenu) - (setq-local which-func-functions nil) + (setq-local treesit-simple-imenu-settings + `(("Module" "\\`mod_item\\'" nil nil) + ("Enum" "\\`enum_item\\'" nil nil) + ("Impl" "\\`impl_item\\'" nil nil) + ("Type" "\\`type_item\\'" nil nil) + ("Struct" "\\`struct_item\\'" nil nil) + ("Fn" "\\`function_item\\'" nil nil))) ;; Indent. (setq-local indent-tabs-mode nil diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 0bfdc81e22d..8935165d1fa 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -335,8 +335,6 @@ Argument LANGUAGE is either `typescript' or `tsx'." ;; Comments. (c-ts-mode-comment-setup) - (setq-local treesit-defun-prefer-top-level t) - ;; Electric (setq-local electric-indent-chars (append "{}():;," electric-indent-chars)) @@ -347,11 +345,17 @@ Argument LANGUAGE is either `typescript' or `tsx'." "method_definition" "function_declaration" "lexical_declaration"))) - ;; Imenu. - (setq-local imenu-create-index-function #'js--treesit-imenu) - - ;; Which-func (use imenu). - (setq-local which-func-functions nil)) + (setq-local treesit-defun-name-function #'js--treesit-defun-name) + + ;; Imenu (same as in `js-ts-mode'). + (setq-local treesit-simple-imenu-settings + `(("Function" "\\`function_declaration\\'" nil nil) + ("Variable" "\\`lexical_declaration\\'" + js--treesit-valid-imenu-entry nil) + ("Class" ,(rx bos (or "class_declaration" + "method_definition") + eos) + nil nil)))) ;;;###autoload (define-derived-mode typescript-ts-mode typescript-ts-base-mode "TypeScript" diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 99ef4f10a06..204331ec72f 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1425,33 +1425,6 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-node-start node) (treesit-node-start block))))))) -(defun css--treesit-imenu-1 (node) - "Helper for `css--treesit-imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (subtrees (mapcan #'css--treesit-imenu-1 (cdr node))) - (name (when ts-node - (or (treesit-defun-name ts-node) - "Anonymous"))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((or (null ts-node) (null name)) subtrees) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) - -(defun css--treesit-imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (tree (treesit-induce-sparse-tree - node (rx (or "rule_set" "media_statement")) - nil 1000))) - (css--treesit-imenu-1 tree))) - ;;; Completion (defun css--complete-property () @@ -1847,8 +1820,9 @@ can also be used to fill comments. '((selector comment query keyword) (property constant string) (error variable function operator bracket))) - (setq-local imenu-create-index-function #'css--treesit-imenu) - (setq-local which-func-functions nil) + (setq-local treesit-simple-imenu-settings + `( nil ,(rx bos (or "rule_set" "media_statement") eos) + nil nil)) (treesit-major-mode-setup))) ;;;###autoload diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el index 790de2133e8..7771cfa6e2a 100644 --- a/lisp/textmodes/toml-ts-mode.el +++ b/lisp/textmodes/toml-ts-mode.el @@ -112,39 +112,8 @@ Return nil if there is no name or if NODE is not a defun node." (pcase (treesit-node-type node) ((or "table" "table_array_element") - (car (cdr (treesit-node-children node)))))) - -(defun toml-ts-mode--imenu-1 (node) - "Helper for `toml-ts-mode--imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (subtrees (mapcan #'toml-ts-mode--imenu-1 (cdr node))) - (name (or (treesit-defun-name ts-node) - "Root table")) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((null ts-node) subtrees) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) - -(defun toml-ts-mode--imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (table-tree (treesit-induce-sparse-tree - node "^table$" nil 1000)) - (table-array-tree (treesit-induce-sparse-tree - node "^table_array_element$" nil 1000)) - (table-index (toml-ts-mode--imenu-1 table-tree)) - (table-array-index (toml-ts-mode--imenu-1 table-array-tree))) - (append - (when table-index `(("Headers" . ,table-index))) - (when table-array-index `(("Arrays" . ,table-array-index)))))) - + (or (treesit-node-text (treesit-node-child node 1) t) + "Root table")))) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode)) @@ -179,8 +148,9 @@ the subtrees." (delimiter error))) ;; Imenu. - (setq-local imenu-create-index-function #'toml-ts-mode--imenu) - (setq-local which-func-functions nil) ;; Piggyback on imenu + (setq-local treesit-simple-imenu-settings + '(("Header" "\\`table\\'" nil nil) + ("Array" "\\`table_array_element\\'" nil nil))) (treesit-major-mode-setup))) -- cgit v1.2.1 From eedc9d79aed0c795b6f0687bc49993cb626c4039 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Wed, 28 Dec 2022 00:32:37 -0800 Subject: Fix tree-sitter typos * doc/lispref/parsing.texi (Tree-sitter major modes): * lisp/progmodes/java-ts-mode.el: * test/src/treesit-tests.el (treesit-defun-navigation-nested-4): Fix typo. --- lisp/progmodes/java-ts-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index c389f795dd3..6dd69a44a4a 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -310,7 +310,7 @@ Return nil if there is no name or if NODE is not a defun node." ;; Imenu. (setq-local treesit-simple-imenu-settings '(("Class" "\\`class_declaration\\'" nil nil) - ("Interface "\\`interface_declaration\\'" nil nil) + ("Interface" "\\`interface_declaration\\'" nil nil) ("Enum" "\\`record_declaration\\'" nil nil) ("Method" "\\`method_declaration\\'" nil nil))) (treesit-major-mode-setup)) -- cgit v1.2.1 From 8503b370be104c2ee40a34e38f69d144f19b0314 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 28 Dec 2022 15:12:44 +0200 Subject: (python--treesit-settings): Remove duplicate matcher * lisp/progmodes/python.el (python--treesit-settings): Remove duplicate matcher (which found itself under 'function' in addition to 'definition'). --- lisp/progmodes/python.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 9a6f807f4f2..07f86d31551 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1096,9 +1096,7 @@ fontified." :feature 'function :language 'python - '((function_definition - name: (identifier) @font-lock-function-name-face) - (call function: (identifier) @font-lock-function-name-face) + '((call function: (identifier) @font-lock-function-name-face) (call function: (attribute attribute: (identifier) @font-lock-function-name-face))) -- cgit v1.2.1 From 2d0a92148630858754319bd067f8ce409231f176 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 28 Dec 2022 16:41:58 +0200 Subject: ; Avoid treesit-related byte-compiler warnings * lisp/progmodes/json-ts-mode.el (treesit-node-child-by-field-name): * lisp/textmodes/toml-ts-mode.el (treesit-node-child-by-field-name): * lisp/progmodes/java-ts-mode.el (treesit-node-child-by-field-name): * lisp/progmodes/csharp-mode.el (treesit-node-child-by-field-name): Avoid byte-compilation warnings about treesit-node-type. --- lisp/progmodes/csharp-mode.el | 1 + lisp/progmodes/java-ts-mode.el | 1 + lisp/progmodes/json-ts-mode.el | 1 + lisp/textmodes/toml-ts-mode.el | 1 + 4 files changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index b967571db7d..66e4a65184c 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -43,6 +43,7 @@ (declare-function treesit-parser-create "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-type "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") (defgroup csharp nil diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 6dd69a44a4a..c13cf032c44 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -34,6 +34,7 @@ (declare-function treesit-parser-create "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-type "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") (defcustom java-ts-mode-indent-offset 4 diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index 2a467dccecc..adba2f820fa 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -33,6 +33,7 @@ (declare-function treesit-parser-create "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-type "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el index 7771cfa6e2a..983a1401008 100644 --- a/lisp/textmodes/toml-ts-mode.el +++ b/lisp/textmodes/toml-ts-mode.el @@ -32,6 +32,7 @@ (declare-function treesit-parser-create "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-type "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") (defcustom toml-ts-mode-indent-offset 2 -- cgit v1.2.1 From 2d8f7b66bcc5fa745ccf581253f59645e5e32490 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 28 Dec 2022 16:48:22 +0200 Subject: ; Fix one more treesit byte-compilation warning. --- lisp/textmodes/toml-ts-mode.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp') diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el index 983a1401008..cbdc758d4b3 100644 --- a/lisp/textmodes/toml-ts-mode.el +++ b/lisp/textmodes/toml-ts-mode.el @@ -33,6 +33,7 @@ (declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-node-start "treesit.c") (declare-function treesit-node-type "treesit.c") +(declare-function treesit-node-child "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") (defcustom toml-ts-mode-indent-offset 2 -- cgit v1.2.1 From 19d00fab9aaf28dae6af5786f6e22b8558b10eea Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 28 Dec 2022 06:18:01 -0800 Subject: Avoid "already compiled" warning in erc-compat * lisp/erc/erc-compat.el (erc-compat--29-auth-source-pass-search): Don't `byte-compile' sub-29 secrets wrapper. This was especially noisy in tests. Ditch closed-over vars via HOF instead of suppressing because compiling emits "unused lexical" warning on Emacs 27. --- lisp/erc/erc-compat.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index fdcb146d42a..864c5882cf2 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -261,7 +261,7 @@ If START or END is negative, it counts from the end." (when-let* ((s (plist-get e :secret)) (v (auth-source--obfuscate s))) (setf (plist-get e :secret) - (byte-compile (lambda () (auth-source--deobfuscate v))))) + (apply-partially #'auth-source--deobfuscate v))) (push e out))) rv))) -- cgit v1.2.1 From 2ddc480f4417775d6bf8ebcfc27b8cd7fa761a7d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 25 Dec 2022 21:36:53 -0800 Subject: Warn of absent networks module in ERC * doc/misc/erc.texi: Add linkable note in Modules chapter about some modules being required. Also tweak markup in auth-source section. * etc/ERC-NEWS: Mention the special role of `networks'. * lisp/erc/erc-backend.el (erc--server-post-connect-hook): Add internal hook for core modules to perform post-network-process, pre-protocol config validation even when they haven't been loaded. (erc--register-connection): Run `erc--server-post-connect-hook'. * lisp/erc/erc-networks.el (erc-networks--bouncer-targets, erc-networks-on-MOTD-end): Fix comments and doc strings. Also change former from constant to internal variable in case adjustment needed between releases. (erc-networks--warn-on-connect): New function to warn about the `networks' module being absent from `erc-modules'. This could probably run at any time up to and including when the logical IRC connection is established, but doing so at the process/protocol boundary seems ideal. * lisp/erc/erc-sasl.el (erc--register-connection): Defer to base method instead of calling `erc-login' explicitly. * lisp/erc/erc.el (erc-generate-new-buffer-name): Don't reconcile buffer names when networks module not in play. (erc-format-target-and/or-network): Don't assume networks module loaded. * test/lisp/erc/erc-scenarios-base-unstable.el: (erc-scenarios-networks-no-module): New test. * test/lisp/erc/resources/networks/no-module/basic.eld: New test data file. (Bug#60331.) --- lisp/erc/erc-backend.el | 10 ++++++++++ lisp/erc/erc-networks.el | 26 ++++++++++++++++++++------ lisp/erc/erc-sasl.el | 2 +- lisp/erc/erc.el | 6 ++++-- 4 files changed, 35 insertions(+), 9 deletions(-) (limited to 'lisp') diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 43c5faad638..6820bf0d1a3 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -320,6 +320,15 @@ session when reconnecting. Once `erc-reuse-buffers' is retired and fully removed, modules can switch to leveraging the `permanent-local' property instead.") +(defvar erc--server-post-connect-hook '(erc-networks--warn-on-connect) + "Functions to run when a network connection is successfully opened. +Though internal, this complements `erc-connect-pre-hook' in that +it bookends the process rather than the logical connection, which +is the domain of `erc-before-connect' and `erc-after-connect'. +Note that unlike `erc-connect-pre-hook', this only runs in server +buffers, and it does so immediately before the first protocol +exchange.") + (defvar-local erc-server-timed-out nil "Non-nil if the IRC server failed to respond to a ping.") @@ -646,6 +655,7 @@ The current buffer is given by BUFFER." (cl-defmethod erc--register-connection () "Perform opening IRC protocol exchange with server." + (run-hooks 'erc--server-post-connect-hook) (erc-login)) (defvar erc--server-connect-dumb-ipv6-regexp diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 2e2d0930118..f05a98be16d 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -1472,14 +1472,16 @@ to be a false alarm. If `erc-reuse-buffers' is nil, let (t (rename-buffer (generate-new-buffer-name name))))) nil) -;; Soju v0.4.0 only sends ISUPPORT on upstream reconnect, so this -;; doesn't apply. ZNC 1.8.2, however, still sends the entire burst. -(defconst erc-networks--bouncer-targets '(*status bouncerserv) - "Case-mapped symbols matching known bouncer service-bot targets.") +;; Soju v0.4.0 sends ISUPPORT and nothing else on upstream reconnect, +;; so this actually doesn't apply. ZNC 1.8.2, however, still sends +;; the entire burst. +(defvar erc-networks--bouncer-targets '(*status bouncerserv) + "Symbols matching proxy-bot targets.") (defun erc-networks-on-MOTD-end (proc parsed) - "Call on-connect functions with server PROC and PARSED message. -This must run before `erc-server-connected' is set." + "Call on-connect functions with server PROC and PARSED message." + ;; This should normally run before `erc-server-connected' is set. + ;; However, bouncers and other proxies may interfere with that. (when erc-server-connected (unless (erc-buffer-filter (lambda () (and erc--target @@ -1502,6 +1504,18 @@ This must run before `erc-server-connected' is set." ((remove-hook 'erc-server-376-functions #'erc-networks-on-MOTD-end) (remove-hook 'erc-server-422-functions #'erc-networks-on-MOTD-end))) +(defun erc-networks--warn-on-connect () + "Emit warning when the `networks' module hasn't been loaded. +Ideally, do so upon opening the network process." + (unless (or erc--target erc-networks-mode) + (require 'info nil t) + (let ((m (concat "Required module `networks' not loaded. If this " + " was unexpected, please add it to `erc-modules'."))) + ;; Assume the server buffer has been marked as active. + (erc-display-error-notice + nil (concat m " See Info:\"(erc) Required Modules\" for more.")) + (lwarn 'erc :warning m)))) + (defun erc-ports-list (ports) "Return a list of PORTS. diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index 78d02a46381..23110d74b5e 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -435,7 +435,7 @@ Otherwise, expect it to disappear in subsequent versions.") (if (eq :user (alist-get 'user erc-sasl--options)) (erc-current-nick) erc-session-username))) - (erc-login)) + (cl-call-next-method)) (when erc-sasl--send-cap-ls (erc-server-send "CAP REQ :sasl")) (erc-server-send (format "AUTHENTICATE %s" m))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6a5e0018964..16a0aba77b1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1607,7 +1607,8 @@ same manner." (when target ; compat (setq tgt-info (erc--target-from-string target))) (if tgt-info - (let* ((esid (erc-networks--id-symbol erc-networks--id)) + (let* ((esid (and erc-networks--id + (erc-networks--id-symbol erc-networks--id))) (name (if esid (erc-networks--reconcile-buffer-names tgt-info erc-networks--id) @@ -6760,7 +6761,8 @@ This should be a string with substitution variables recognized by If the name of the network is not available, then use the shortened server name instead." (if-let ((erc--target) - (name (if-let ((esid (erc-networks--id-symbol erc-networks--id))) + (name (if-let ((erc-networks--id) + (esid (erc-networks--id-symbol erc-networks--id))) (symbol-name esid) (erc-shorten-server-name (or erc-server-announced-name erc-session-server))))) -- cgit v1.2.1 From 8676bec51de7433bf54d66bc1dfd819eb4fadeb3 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 28 Dec 2022 17:37:46 +0100 Subject: ; * lisp/treesit.el (treesit--simple-imenu-1): Doc fix; wording. --- lisp/treesit.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 0aab0a12614..4ee0fba79b7 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2039,7 +2039,7 @@ NODE is a node in the tree returned by `treesit-induce-sparse-tree' (not a tree-sitter node, its car is a tree-sitter node). Walk that tree and return an Imenu index. -Return a list of ENTRYs where +Return a list of entries where each ENTRY has the form: ENTRY := (NAME . MARKER) | (NAME . ((\" \" . MARKER) -- cgit v1.2.1 From c0be51389eb27582614e1891fe0e3925ba09707e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 28 Dec 2022 19:08:19 +0200 Subject: ; Yet another declare-function to avoid treesit-related warning --- lisp/progmodes/sh-script.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp') diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 85da9e89f9a..3a3391ccdd2 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -150,6 +150,8 @@ (require 'executable) (require 'treesit) +(declare-function treesit-parser-create "treesit.c") + (autoload 'comint-completion-at-point "comint") (autoload 'comint-filename-completion "comint") (autoload 'comint-send-string "comint") -- cgit v1.2.1 From f9a22cf78d1a7f6472b09c3046c6a7f6984bc2d2 Mon Sep 17 00:00:00 2001 From: Theodor Thornhill Date: Sun, 25 Dec 2022 22:47:36 +0100 Subject: Fixes in prog-fill-reindent-defun Ensure that we don't consider lines such as switch (foo) { case 2: // If point on 'c' in 'case' return 2; not to be considered for filling. Also make sure we check for the active region, to replicate the normal fill-paragraph behavior. * lisp/progmodes/prog-mode.el (prog-fill-reindent-defun): Adjust regex, and make sure fill-paragraph checks for active region. (bug#60360, bug#60322) --- lisp/progmodes/prog-mode.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index aa37a4ac865..5e692980b2f 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -164,10 +164,8 @@ or follows point." (treesit-node-type (treesit-node-at (point))))))) (if (or treesit-text-node (nth 8 (syntax-ppss)) - (re-search-forward comment-start-skip (line-end-position) t)) - (if (memq fill-paragraph-function '(t nil)) - (lisp-fill-paragraph argument) - (funcall fill-paragraph-function argument)) + (re-search-forward "^\\s<" (line-end-position) t)) + (fill-paragraph argument (region-active-p)) (beginning-of-defun) (let ((start (point))) (end-of-defun) -- cgit v1.2.1 From fd48201ffe77d20729002abea63e1b6d8502d186 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 28 Dec 2022 19:47:52 +0200 Subject: * lisp/tab-line.el (tab-line-cache-key-default): More cache keys (bug#60340). Move more cache keys here from 'tab-line-format' to give users more freedom. --- lisp/tab-line.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/tab-line.el b/lisp/tab-line.el index c4e4a688720..30612728bde 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -572,9 +572,14 @@ For use in `tab-line-tab-face-functions'." (defvar tab-line-auto-hscroll) -(defun tab-line-cache-key-default (_tabs) +(defun tab-line-cache-key-default (tabs) "Return default list of cache keys." (list + tabs + ;; handle buffer renames + (buffer-name (window-buffer)) + ;; handle tab-line scrolling + (window-parameter nil 'tab-line-hscroll) ;; for setting face 'tab-line-tab-current' (mode-line-window-selected-p) ;; for `tab-line-tab-face-modified' @@ -591,12 +596,7 @@ of cache keys. You can use `add-function' to add more cache keys.") (defun tab-line-format () "Format for displaying the tab line of the selected window." (let* ((tabs (funcall tab-line-tabs-function)) - (cache-key (append (list tabs - ;; handle buffer renames - (buffer-name (window-buffer)) - ;; handle tab-line scrolling - (window-parameter nil 'tab-line-hscroll)) - (funcall tab-line-cache-key-function tabs))) + (cache-key (funcall tab-line-cache-key-function tabs)) (cache (window-parameter nil 'tab-line-cache))) ;; Enable auto-hscroll again after it was disabled on manual scrolling. ;; The moment to enable it is when the window-buffer was updated. -- cgit v1.2.1 From 70480d3b6b7c1fe68a6a86dd2a7382c904ae1f30 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 28 Dec 2022 19:58:44 +0200 Subject: * lisp/repeat.el (repeat-echo-function): Suggest 'add-function' in docstring. (bug#60353) --- lisp/repeat.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/repeat.el b/lisp/repeat.el index 3b3a444ee24..e382239fc86 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -399,7 +399,8 @@ but the property value is `t', then check the last key." (defcustom repeat-echo-function #'repeat-echo-message "Function to display a hint about available keys. Function is called after every repeatable command with one argument: -a repeating map, or nil after deactivating the transient repeating mode." +a repeating map, or nil after deactivating the transient repeating mode. +You can use `add-function' for multiple functions simultaneously." :type '(choice (const :tag "Show hints in the echo area" repeat-echo-message) (const :tag "Show indicator in the mode line" -- cgit v1.2.1 From 7e98b8a0fa67f51784024fac3199d774dfa77192 Mon Sep 17 00:00:00 2001 From: Theodor Thornhill Date: Sun, 25 Dec 2022 20:11:59 +0100 Subject: Add treesit-transpose-sexps (bug#60128) We don't really need to rely on forward-sexp to define what to transpose. In tree-sitter we can consider siblings as "balanced expressions", and swap them without doing any movement to calculate where the siblings in question are. * lisp/simple.el (transpose-sexps-function): New defvar-local. (transpose-sexps): Use the new defvar-local if available. (transpose-subr): Check whether the mover function returns a cons of conses, then run transpose-subr-1 on the position-pairs. * lisp/treesit.el (treesit-transpose-sexps): New function. --- lisp/simple.el | 88 ++++++++++++++++++++++++++++++++------------------------- lisp/treesit.el | 29 ++++++++++++++++++- 2 files changed, 77 insertions(+), 40 deletions(-) (limited to 'lisp') diff --git a/lisp/simple.el b/lisp/simple.el index 4551b749d56..cf0845853a2 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8438,6 +8438,43 @@ are interchanged." (interactive "*p") (transpose-subr 'forward-word arg)) +(defvar transpose-sexps-function + (lambda (arg) + ;; Here we should try to simulate the behavior of + ;; (cons (progn (forward-sexp x) (point)) + ;; (progn (forward-sexp (- x)) (point))) + ;; Except that we don't want to rely on the second forward-sexp + ;; putting us back to where we want to be, since forward-sexp-function + ;; might do funny things like infix-precedence. + (if (if (> arg 0) + (looking-at "\\sw\\|\\s_") + (and (not (bobp)) + (save-excursion + (forward-char -1) + (looking-at "\\sw\\|\\s_")))) + ;; Jumping over a symbol. We might be inside it, mind you. + (progn (funcall (if (> arg 0) + #'skip-syntax-backward #'skip-syntax-forward) + "w_") + (cons (save-excursion (forward-sexp arg) (point)) (point))) + ;; Otherwise, we're between sexps. Take a step back before jumping + ;; to make sure we'll obey the same precedence no matter which + ;; direction we're going. + (funcall (if (> arg 0) #'skip-syntax-backward #'skip-syntax-forward) + " .") + (cons (save-excursion (forward-sexp arg) (point)) + (progn (while (or (forward-comment (if (> arg 0) 1 -1)) + (not (zerop (funcall (if (> arg 0) + #'skip-syntax-forward + #'skip-syntax-backward) + "."))))) + (point))))) + "If non-nil, `transpose-sexps' delegates to this function. + +This function takes one argument ARG, a number. Its expected +return value is a position pair, which is a cons (BEG . END), +where BEG and END are buffer positions.") + (defun transpose-sexps (arg &optional interactive) "Like \\[transpose-chars] (`transpose-chars'), but applies to sexps. Unlike `transpose-words', point must be between the two sexps and not @@ -8453,38 +8490,7 @@ report errors as appropriate for this kind of usage." (condition-case nil (transpose-sexps arg nil) (scan-error (user-error "Not between two complete sexps"))) - (transpose-subr - (lambda (arg) - ;; Here we should try to simulate the behavior of - ;; (cons (progn (forward-sexp x) (point)) - ;; (progn (forward-sexp (- x)) (point))) - ;; Except that we don't want to rely on the second forward-sexp - ;; putting us back to where we want to be, since forward-sexp-function - ;; might do funny things like infix-precedence. - (if (if (> arg 0) - (looking-at "\\sw\\|\\s_") - (and (not (bobp)) - (save-excursion - (forward-char -1) - (looking-at "\\sw\\|\\s_")))) - ;; Jumping over a symbol. We might be inside it, mind you. - (progn (funcall (if (> arg 0) - 'skip-syntax-backward 'skip-syntax-forward) - "w_") - (cons (save-excursion (forward-sexp arg) (point)) (point))) - ;; Otherwise, we're between sexps. Take a step back before jumping - ;; to make sure we'll obey the same precedence no matter which - ;; direction we're going. - (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) - " .") - (cons (save-excursion (forward-sexp arg) (point)) - (progn (while (or (forward-comment (if (> arg 0) 1 -1)) - (not (zerop (funcall (if (> arg 0) - 'skip-syntax-forward - 'skip-syntax-backward) - "."))))) - (point))))) - arg 'special))) + (transpose-subr transpose-sexps-function arg 'special))) (defun transpose-lines (arg) "Exchange current line and previous line, leaving point after both. @@ -8509,13 +8515,15 @@ With argument 0, interchanges line point is in with line mark is in." ;; FIXME document SPECIAL. (defun transpose-subr (mover arg &optional special) "Subroutine to do the work of transposing objects. -Works for lines, sentences, paragraphs, etc. MOVER is a function that -moves forward by units of the given object (e.g. `forward-sentence', -`forward-paragraph'). If ARG is zero, exchanges the current object -with the one containing mark. If ARG is an integer, moves the -current object past ARG following (if ARG is positive) or -preceding (if ARG is negative) objects, leaving point after the -current object." +Works for lines, sentences, paragraphs, etc. MOVER is a function +that moves forward by units of the given +object (e.g. `forward-sentence', `forward-paragraph'), or a +function calculating a cons of buffer positions. + + If ARG is zero, exchanges the current object with the one +containing mark. If ARG is an integer, moves the current object +past ARG following (if ARG is positive) or preceding (if ARG is +negative) objects, leaving point after the current object." (let ((aux (if special mover (lambda (x) (cons (progn (funcall mover x) (point)) @@ -8542,6 +8550,8 @@ current object." (goto-char (+ (car pos2) (- (cdr pos1) (car pos1)))))))) (defun transpose-subr-1 (pos1 pos2) + (unless (and pos1 pos2) + (error "Don't have two things to transpose")) (when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1)))) (when (> (car pos2) (cdr pos2)) (setq pos2 (cons (cdr pos2) (car pos2)))) (when (> (car pos1) (car pos2)) diff --git a/lisp/treesit.el b/lisp/treesit.el index cefbed1a168..203a724fe7a 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1582,6 +1582,32 @@ BACKWARD and ALL are the same as in `treesit-search-forward'." (goto-char current-pos))) node)) +(defun treesit-transpose-sexps (&optional arg) + "Tree-sitter `transpose-sexps' function. +Arg is the same as in `transpose-sexps'. + +Locate the node closest to POINT, and transpose that node with +its sibling node ARG nodes away. + +Return a pair of positions as described by +`transpose-sexps-function' for use in `transpose-subr' and +friends." + (let* ((parent (treesit-node-parent (treesit-node-at (point)))) + (child (treesit-node-child parent 0 t))) + (named-let loop ((prev child) + (next (treesit-node-next-sibling child t))) + (when (and prev next) + (if (< (point) (treesit-node-end next)) + (if (= arg -1) + (cons (treesit-node-start prev) + (treesit-node-end prev)) + (when-let ((n (treesit-node-child + parent (+ arg (treesit-node-index prev t)) t))) + (cons (treesit-node-end n) + (treesit-node-start n)))) + (loop (treesit-node-next-sibling prev t) + (treesit-node-next-sibling next t))))))) + ;;; Navigation, defun, things ;; ;; Emacs lets you define "things" by a regexp that matches the type of @@ -2111,7 +2137,8 @@ before calling this function." ;; Defun name. (when treesit-defun-name-function (setq-local add-log-current-defun-function - #'treesit-add-log-current-defun))) + #'treesit-add-log-current-defun)) + (setq-local transpose-sexps-function #'treesit-transpose-sexps)) ;;; Debugging -- cgit v1.2.1 From b69bffeec05302529209559dfb2ab24d9e711192 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 28 Dec 2022 20:14:43 +0200 Subject: * lisp/vc/diff-mode.el (diff-minor-mode-prefix): Replace "ESC" with "\e". "ESC" looks like an attempt to use kbd syntax in customization. But actually now 'key-description' is used in 'diff-minor-mode-map' to convert "\e" to "ESC". --- lisp/vc/diff-mode.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 357ce001b3c..b80337eb742 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -272,8 +272,7 @@ and hunk-based syntax highlighting otherwise as a fallback." (defcustom diff-minor-mode-prefix "\C-c=" "Prefix key for `diff-minor-mode' commands." - :type '(choice (string "ESC") - (string "\C-c=") string)) + :type '(choice (string "\e") (string "\C-c=") string)) (defvar-keymap diff-minor-mode-map :doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'." -- cgit v1.2.1 From 7a0eaee198003aa6c1410107f051b45e0b786ce9 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 28 Dec 2022 20:27:07 +0200 Subject: * lisp/isearch.el: Small fixes. (isearch-wrap-pause): Mention the new feature of `no' and `no-ding' in the docstring. (isearch-lax-whitespace, isearch-forward-thing-at-point): Add the group 'isearch' since another defgroup changed the default group. (isearch-delete-char): Use 'isearch-invisible' instead of 'search-invisible' since the users might change the current value with 'M-s i'. --- lisp/isearch.el | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/isearch.el b/lisp/isearch.el index 6a17d18c45e..ba67cce841a 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -181,7 +181,9 @@ When t (by default), signal an error when no more matches are found. Then after repeating the search, wrap with `isearch-wrap-function'. When `no', wrap immediately after reaching the last match. When `no-ding', wrap immediately without flashing the screen. -When nil, never wrap, just stop at the last match." +When nil, never wrap, just stop at the last match. +With the values `no' and `no-ding' the search will try +to wrap around also on typing a character." :type '(choice (const :tag "Pause before wrapping" t) (const :tag "No pause before wrapping" no) (const :tag "No pause and no flashing" no-ding) @@ -880,6 +882,7 @@ matches literally, against one space. You can toggle the value of this variable by the command `isearch-toggle-lax-whitespace', usually bound to `M-s SPC' during isearch." :type 'boolean + :group 'isearch :version "25.1") (defvar isearch-regexp-lax-whitespace nil @@ -1179,6 +1182,7 @@ Each element of the list should be one of the symbols supported by `isearch-forward-thing-at-point' to yank the initial \"thing\" as text to the search string." :type '(repeat (symbol :tag "Thing symbol")) + :group 'isearch :version "28.1") (defun isearch-forward-thing-at-point () @@ -2525,10 +2529,11 @@ If no input items have been entered yet, just beep." (ding) (isearch-pop-state)) ;; When going back to the hidden match, reopen it and close other overlays. - (when (and (eq search-invisible 'open) isearch-hide-immediately) + (when (and (eq isearch-invisible 'open) isearch-hide-immediately) (if isearch-other-end - (isearch-range-invisible (min (point) isearch-other-end) - (max (point) isearch-other-end)) + (let ((search-invisible isearch-invisible)) + (isearch-range-invisible (min (point) isearch-other-end) + (max (point) isearch-other-end))) (isearch-close-unnecessary-overlays (point) (point)))) (isearch-update)) -- cgit v1.2.1 From db96b1282f90ee40560f81e8b715fe785badbb6e Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 28 Dec 2022 20:48:40 +0200 Subject: * lisp/help.el: Use 'C-h C-q' to toggle 'help-quick' window (bug#60249). (help-map): Bind "C-q" to 'help-quick-toggle'. Rebind "q" to 'help-quit'. (help-quick): Replace help-quit-or-quick with help-quick-toggle. (help-quick-toggle): New command. (help-quit-or-quick): Remove command. (help-for-help): Replace help-quick-or-quit with help-quick-toggle. --- lisp/help.el | 32 ++++++++++++++------------------ 1 file changed, 14 insertions(+), 18 deletions(-) (limited to 'lisp') diff --git a/lisp/help.el b/lisp/help.el index b709062cb27..d7fd4d555ea 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -76,6 +76,7 @@ buffer.") "C-n" #'view-emacs-news "C-o" #'describe-distribution "C-p" #'view-emacs-problems + "C-q" #'help-quick-toggle "C-s" #'search-forward-help-for-help "C-t" #'view-emacs-todo "C-w" #'describe-no-warranty @@ -116,7 +117,7 @@ buffer.") "v" #'describe-variable "w" #'where-is "x" #'describe-command - "q" #'help-quit-or-quick) + "q" #'help-quit) (define-key global-map (char-to-string help-char) 'help-command) (define-key global-map [help] 'help-command) @@ -243,7 +244,17 @@ buffer.") ;; ... and shrink it immediately. (fit-window-to-buffer)) (message - (substitute-command-keys "Toggle the quick help buffer using \\[help-quit-or-quick].")))) + (substitute-command-keys "Toggle the quick help buffer using \\[help-quick-toggle].")))) + +(defun help-quick-toggle () + "Toggle the quick-help window." + (interactive) + (if (and-let* ((window (get-buffer-window "*Quick Help*"))) + (quit-window t window)) + ;; Clear the message we may have gotten from `C-h' and then + ;; waiting before hitting `q'. + (message "") + (help-quick))) (defalias 'cheat-sheet #'help-quick) @@ -252,21 +263,6 @@ buffer.") (interactive) nil) -(defun help-quit-or-quick () - "Call `help-quit' or `help-quick' depending on the context." - (interactive) - (cond - (help-buffer-under-preparation - ;; FIXME: There should be a better way to detect if we are in the - ;; help command loop. - (help-quit)) - ((and-let* ((window (get-buffer-window "*Quick Help*"))) - (quit-window t window) - ;; Clear the message we may have gotten from `C-h' and then - ;; waiting before hitting `q'. - (message ""))) - ((help-quick)))) - (defvar help-return-method nil "What to do to \"exit\" the help buffer. This is a list @@ -416,7 +412,7 @@ Do not call this in the scope of `with-help-window'." ("describe-package" "Describe a specific Emacs package") "" ("help-with-tutorial" "Start the Emacs tutorial") - ("help-quick-or-quit" "Display the quick help buffer.") + ("help-quick-toggle" "Display the quick help buffer.") ("view-echo-area-messages" "Show recent messages (from echo area)") ("view-lossage" ,(format "Show last %d input keystrokes (lossage)" -- cgit v1.2.1 From 19b8733aa27719e0aa60fad23a45a7f89d68b88d Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Wed, 28 Dec 2022 15:44:26 -0800 Subject: Fix syntax for < and > in c++-ts-mode (bug#60351) < and > are usually punctuation, e.g., in ->. But when used for templates, they should be considered pairs. Right now we always consider them as pairs which is incorrect. * lisp/progmodes/c-ts-mode.el (c++-ts-mode--syntax-table): Remove variable. (c-ts-mode--syntax-propertize): New function. (c++-ts-mode): Remove syntax table. Setup syntax-propertize-function. --- lisp/progmodes/c-ts-mode.el | 33 +++++++++++++++++++++++++-------- 1 file changed, 25 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 5f15861eed8..83b0459c230 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -63,6 +63,8 @@ follows the form of `treesit-simple-indent-rules'." (function :tag "A function for user customized style" ignore)) :group 'c) +;;; Syntax table + (defvar c-ts-mode--syntax-table (let ((table (make-syntax-table))) ;; Taken from the cc-langs version @@ -85,13 +87,27 @@ follows the form of `treesit-simple-indent-rules'." table) "Syntax table for `c-ts-mode'.") -(defvar c++-ts-mode--syntax-table - (let ((table (make-syntax-table c-ts-mode--syntax-table))) - ;; Template delimiters. - (modify-syntax-entry ?< "(" table) - (modify-syntax-entry ?> ")" table) - table) - "Syntax table for `c++-ts-mode'.") +(defun c-ts-mode--syntax-propertize (beg end) + "Apply syntax text property to template delimiters between BEG and END. + +< and > are usually punctuation, e.g., in ->. But when used for +templates, they should be considered pairs. + +This function checks for < and > in the changed RANGES and apply +appropriate text property to alter the syntax of template +delimiters < and >'s." + (goto-char beg) + (while (re-search-forward (rx (or "<" ">")) end t) + (pcase (treesit-node-type + (treesit-node-parent + (treesit-node-at (match-beginning 0)))) + ("template_argument_list" + (put-text-property (match-beginning 0) + (match-end 0) + 'syntax-table + (pcase (char-before) + (?< '(4 . ?>)) + (?> '(5 . ?<)))))))) ;;; Indent @@ -751,12 +767,13 @@ Set up: (define-derived-mode c++-ts-mode c-ts-base-mode "C++" "Major mode for editing C++, powered by tree-sitter." :group 'c++ - :syntax-table c++-ts-mode--syntax-table (unless (treesit-ready-p 'cpp) (error "Tree-sitter for C++ isn't available")) (treesit-parser-create 'cpp) + (setq-local syntax-propertize-function + #'c-ts-mode--syntax-propertize) (setq-local treesit-simple-indent-rules (c-ts-mode--set-indent-style 'cpp)) -- cgit v1.2.1 From 398ed75c276d7e4de583a9de750a777173252e77 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Wed, 28 Dec 2022 15:47:14 -0800 Subject: ; * lisp/progmodes/c-ts-mode.el (c-ts-mode--fill-paragraph): Fix. --- lisp/progmodes/c-ts-mode.el | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 83b0459c230..8ba6cdee42d 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -590,6 +590,10 @@ ARG is passed to `fill-paragraph'." (goto-char (match-beginning 1)) (setq start-marker (point-marker)) (replace-match " " nil nil nil 1)) + ;; Include whitespaces before /*. + (goto-char start) + (beginning-of-line) + (setq start (point)) ;; Mask spaces before "*/" if it is attached at the end ;; of a sentence rather than on its own line. (goto-char end) @@ -661,11 +665,18 @@ Set up: (concat (rx (* (syntax whitespace)) (group (or (seq "/" (+ "/")) (* "*")))) adaptive-fill-regexp)) - ;; Same as `adaptive-fill-regexp'. + ;; Note the missing * comparing to `adaptive-fill-regexp'. The + ;; reason for its absence is a bit convoluted to explain. Suffice + ;; to say that without it, filling a single line paragraph that + ;; starts with /* doesn't insert * at the beginning of each + ;; following line, and filling a multi-line paragraph whose first + ;; two lines start with * does insert * at the beginning of each + ;; following line. If you know how does adaptive filling works, you + ;; know what I mean. (setq-local adaptive-fill-first-line-regexp (rx bos (seq (* (syntax whitespace)) - (group (or (seq "/" (+ "/")) (* "*"))) + (group (seq "/" (+ "/"))) (* (syntax whitespace))) eos)) ;; Same as `adaptive-fill-regexp'. -- cgit v1.2.1 From e78e69b33189c653d1588b810283969ac3cca137 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Wed, 28 Dec 2022 16:52:47 -0800 Subject: Clean up font-lock rules in js-ts-mode Changes for each feature: - string: Take out string-interpolation bits. - string-interpolation: New. - declaration: Rename to definition. - identifier: Remove. - property: Use a pred to filter out methods. - expression: Rename to assignment. - function: New. - pattern: Merge into assignment. * lisp/progmodes/js.el (js--treesit-font-lock-settings): See above. (js--treesit-property-not-function-p) (js--treesit-lhs-identifier-query): New variable. (js--treesit-fontify-assignment-lhs): New functions. (js-ts-mode): Update feature list. --- lisp/progmodes/js.el | 104 +++++++++++++++++++++++++++------------------------ 1 file changed, 55 insertions(+), 49 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index c7a40ab1adb..211d4d7d805 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3498,17 +3498,19 @@ This function is intended for use in `after-change-functions'." [(this) (super)] @font-lock-keyword-face) :language 'javascript - :override t :feature 'string - `((regex pattern: (regex_pattern)) @font-lock-string-face - (string) @font-lock-string-face - (template_string) @js--fontify-template-string - (template_substitution ["${" "}"] @font-lock-builtin-face)) + '((regex pattern: (regex_pattern)) @font-lock-string-face + (string) @font-lock-string-face) :language 'javascript + :feature 'string-interpolation :override t - :feature 'declaration - `((function + '((template_string) @js--fontify-template-string + (template_substitution ["${" "}"] @font-lock-delimiter-face)) + + :language 'javascript + :feature 'definition + '((function name: (identifier) @font-lock-function-name-face) (class_declaration @@ -3535,24 +3537,10 @@ This function is intended for use in `after-change-functions'." value: (array (number) (function)))) :language 'javascript - :override t - :feature 'identifier - `((new_expression - constructor: (identifier) @font-lock-type-face) - - (for_in_statement - left: (identifier) @font-lock-variable-name-face) - - (arrow_function - parameter: (identifier) @font-lock-variable-name-face)) - - :language 'javascript - :override t :feature 'property - ;; This needs to be before function-name feature, because methods - ;; can be both property and function-name, and we want them in - ;; function-name face. - `((property_identifier) @font-lock-property-face + '(((property_identifier) @font-lock-property-face + (:pred js--treesit-property-not-function-p + @font-lock-property-face)) (pair value: (identifier) @font-lock-variable-name-face) @@ -3561,33 +3549,25 @@ This function is intended for use in `after-change-functions'." ((shorthand_property_identifier_pattern) @font-lock-property-face)) :language 'javascript - :override t - :feature 'expression - `((assignment_expression - left: [(identifier) @font-lock-function-name-face - (member_expression property: (property_identifier) - @font-lock-function-name-face)] - right: [(function) (arrow_function)]) - - (call_expression + :feature 'assignment + '((assignment_expression + left: (_) @js--treesit-fontify-assignment-lhs)) + + :language 'javascript + :feature 'function + '((call_expression function: [(identifier) @font-lock-function-name-face (member_expression property: (property_identifier) @font-lock-function-name-face)]) - - (assignment_expression - left: [(identifier) @font-lock-variable-name-face - (member_expression - property: (property_identifier) @font-lock-variable-name-face)])) - - :language 'javascript - :override t - :feature 'pattern - `((pair_pattern key: (property_identifier) @font-lock-variable-name-face) - (array_pattern (identifier) @font-lock-variable-name-face)) + (method_definition + name: (property_identifier) @font-lock-function-name-face) + (function_declaration + name: (identifier) @font-lock-function-name-face) + (function + name: (identifier) @font-lock-function-name-face)) :language 'javascript - :override t :feature 'jsx `( (jsx_opening_element @@ -3657,6 +3637,31 @@ OVERRIDE is the override flag described in (setq font-beg (treesit-node-end child) child (treesit-node-next-sibling child))))) +(defun js--treesit-property-not-function-p (node) + "Check that NODE, a property_identifier, is not used as a function." + (not (equal (treesit-node-type + (treesit-node-parent ; Maybe call_expression. + (treesit-node-parent ; Maybe member_expression. + node))) + "call_expression"))) + +(defvar js--treesit-lhs-identifier-query + (treesit-query-compile 'javascript '((identifier) @id + (property_identifier) @id)) + "Query that captures identifier and query_identifier.") + +(defun js--treesit-fontify-assignment-lhs (node override start end &rest _) + "Fontify the lhs NODE of an assignment_expression. +For OVERRIDE, START, END, see `treesit-font-lock-rules'." + (dolist (node (treesit-query-capture + node js--treesit-lhs-identifier-query nil nil t)) + (treesit-fontify-with-override + (treesit-node-start node) (treesit-node-end node) + (pcase (treesit-node-type node) + ("identifier" 'font-lock-variable-name-face) + ("property_identifier" 'font-lock-property-face)) + override start end))) + (defun js--treesit-defun-name (node) "Return the defun name of NODE. Return nil if there is no name or if NODE is not a defun node." @@ -3810,11 +3815,12 @@ Currently there are `js-mode' and `js-ts-mode'." ;; Fontification. (setq-local treesit-font-lock-settings js--treesit-font-lock-settings) (setq-local treesit-font-lock-feature-list - '(( comment declaration) + '(( comment definition) ( keyword string) - ( constant escape-sequence expression - identifier jsx number pattern property) - ( bracket delimiter operator))) + ( assignment constant escape-sequence jsx number + pattern) + ( bracket delimiter function operator property + string-interpolation))) ;; Imenu (setq-local treesit-simple-imenu-settings `(("Function" "\\`function_declaration\\'" nil nil) -- cgit v1.2.1 From 909091d7578b7225601b202fb9257dedae879e9a Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Wed, 28 Dec 2022 16:57:21 -0800 Subject: ; Minor cleanup for tree-sitter font-lock rules in js-ts-mode * lisp/progmodes/js.el (js--treesit-font-lock-settings): Minor cleanup. --- lisp/progmodes/js.el | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 211d4d7d805..4dece11d1c1 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3479,20 +3479,17 @@ This function is intended for use in `after-change-functions'." (treesit-font-lock-rules :language 'javascript - :override t :feature 'comment - `((comment) @font-lock-comment-face) + '((comment) @font-lock-comment-face) :language 'javascript - :override t :feature 'constant - `(((identifier) @font-lock-constant-face + '(((identifier) @font-lock-constant-face (:match "^[A-Z_][A-Z_\\d]*$" @font-lock-constant-face)) [(true) (false) (null)] @font-lock-constant-face) :language 'javascript - :override t :feature 'keyword `([,@js--treesit-keywords] @font-lock-keyword-face [(this) (super)] @font-lock-keyword-face) @@ -3569,8 +3566,7 @@ This function is intended for use in `after-change-functions'." :language 'javascript :feature 'jsx - `( - (jsx_opening_element + '((jsx_opening_element [(nested_identifier (identifier)) (identifier)] @font-lock-function-name-face) @@ -3588,7 +3584,7 @@ This function is intended for use in `after-change-functions'." :language 'javascript :feature 'number - `((number) @font-lock-number-face + '((number) @font-lock-number-face ((identifier) @font-lock-number-face (:match "^\\(:?NaN\\|Infinity\\)$" @font-lock-number-face))) -- cgit v1.2.1 From 784e509bded0fe41dd9908022a92c54ac8c21a2c Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Thu, 29 Dec 2022 00:58:50 -0800 Subject: Fix c-ts-mode bracket indentation (bug#60398) * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Use new anchor. (c-ts-mode--bracket-children-anchor): New anchor function. --- lisp/progmodes/c-ts-mode.el | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 8ba6cdee42d..82458ba5adb 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -118,7 +118,7 @@ MODE is either `c' or `cpp'." `(((parent-is "translation_unit") parent-bol 0) ((node-is ")") parent 1) ((node-is "]") parent-bol 0) - ((node-is "}") (and parent parent-bol) 0) + ((node-is "}") c-ts-mode--bracket-children-anchor 0) ((node-is "else") parent-bol 0) ((node-is "case") parent-bol 0) ((node-is "preproc_arg") no-indent) @@ -133,7 +133,8 @@ MODE is either `c' or `cpp'." ((match "#endif" "preproc_if") point-min 0) ((match "preproc_function_def" "compound_statement") point-min 0) ((match "preproc_call" "compound_statement") point-min 0) - ((parent-is "compound_statement") (and parent parent-bol) c-ts-mode-indent-offset) + ((parent-is "compound_statement") + c-ts-mode--bracket-children-anchor c-ts-mode-indent-offset) ((parent-is "function_definition") parent-bol 0) ((parent-is "conditional_expression") first-sibling 0) ((parent-is "assignment_expression") parent-bol c-ts-mode-indent-offset) @@ -189,6 +190,21 @@ MODE is either `c' or `cpp'." ('linux (alist-get 'linux (c-ts-mode--indent-styles mode))))))) `((,mode ,@style)))) +(defun c-ts-mode--bracket-children-anchor (_n parent &rest _) + "This anchor is used for children of a compound_statement. +So anything inside a {} block. PARENT should be the +compound_statement. This anchor looks at the {, if itson its own +line, anchor at it, if it has stuff before it, anchor at the +beginning of grandparent." + (save-excursion + (goto-char (treesit-node-start parent)) + (let ((bol (line-beginning-position))) + (skip-chars-backward " \t") + (treesit-node-start + (if (< bol (point)) + (treesit-node-parent parent) + parent))))) + (defun c-ts-mode--looking-at-star (&rest _) "A tree-sitter simple indent matcher. Matches if there is a \"*\" after point (ignoring whitespace in -- cgit v1.2.1 From 38c35bf0f6a938001dfecbe439addf8fb62897c6 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Thu, 29 Dec 2022 01:28:25 -0800 Subject: Clean up treesit-default-defun-skipper and add comments * lisp/treesit.el (treesit-default-defun-skipper): Clean up, fix some small issue, add comment. --- lisp/treesit.el | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/treesit.el b/lisp/treesit.el index 4ee0fba79b7..0ba4395a6b4 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1744,13 +1744,17 @@ this function depends on `treesit-defun-type-regexp' and This function tries to move to the beginning of a line, either by moving to the empty newline after a defun, or to the beginning of the current line if the beginning of the defun is indented." - (cond ((and (looking-at (rx (* (or " " "\\t")) "\n")) - (not (looking-at (rx bol)))) - (goto-char (match-end 0))) - ((save-excursion - (skip-chars-backward " \t") - (eq (point) (line-beginning-position))) - (goto-char (line-beginning-position))))) + ;; Moving forward, point at the end of a line and not already on an + ;; empty line: go to BOL of the next line (which hopefully is an + ;; empty line). + (cond ((and (looking-at (rx (* (or " " "\t")) "\n")) + (not (bolp))) + (forward-line 1)) + ;; Moving backward, but there are some whitespace (and only + ;; whitespace) between point and BOL: go back to BOL. + ((looking-back (rx (+ (or " " "\t"))) + (line-beginning-position)) + (beginning-of-line)))) ;; prev-sibling: ;; 1. end-of-node before pos -- cgit v1.2.1 From 1a88a28ace24c8b4fb1e4780948b50dd37ada539 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 28 Dec 2022 13:10:35 +0100 Subject: * lisp/subr.el (with-demoted-errors): Better message and location. --- lisp/subr.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/subr.el b/lisp/subr.el index d24169276a5..f0081de0619 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4850,6 +4850,7 @@ but that should be robust in the unexpected case that an error is signaled." (declare (debug t) (indent 1)) (let* ((err (make-symbol "err")) (orig-body body) + (orig-format format) (format (if (and (stringp format) body) format (prog1 "Error: %S" (if format (push format body))))) @@ -4860,7 +4861,9 @@ but that should be robust in the unexpected case that an error is signaled." (if (eq orig-body body) exp ;; The use without `format' is obsolete, let's warn when we bump ;; into any such remaining uses. - (macroexp-warn-and-return "Missing format argument" exp nil nil format)))) + (macroexp-warn-and-return + "Missing format argument in `with-demote-errors'" exp nil nil + orig-format)))) (defmacro combine-after-change-calls (&rest body) "Execute BODY, but don't call the after-change functions till the end. -- cgit v1.2.1 From 1480865e641b06d570f5ab56011f8e3e5481da7d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 28 Dec 2022 14:40:19 +0100 Subject: Warn about `ignore-error` with quoted condition argument * lisp/subr.el (ignore-error): Clarify condition argument in doc string and add warning. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-warn-quoted-condition): New test. --- lisp/subr.el | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/subr.el b/lisp/subr.el index f0081de0619..5e8f3c82a2a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -380,9 +380,18 @@ without silencing all errors." "Execute BODY; if the error CONDITION occurs, return nil. Otherwise, return result of last form in BODY. -CONDITION can also be a list of error conditions." +CONDITION can also be a list of error conditions. +The CONDITION argument is not evaluated. Do not quote it." (declare (debug t) (indent 1)) - `(condition-case nil (progn ,@body) (,condition nil))) + (if (and (eq (car-safe condition) 'quote) + (cdr condition) (null (cddr condition))) + (macroexp-warn-and-return + (format "`ignore-error' condition argument should not be quoted: %S" + condition) + `(condition-case nil (progn ,@body) (,(cadr condition) nil)) + nil t condition) + `(condition-case nil (progn ,@body) (,condition nil)))) + ;;;; Basic Lisp functions. -- cgit v1.2.1 From 2de25accaf31aef643557ec476041c770fc7ac15 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 29 Dec 2022 12:00:50 +0100 Subject: Warn about `condition-case' with quoted condition names * lisp/emacs-lisp/bytecomp.el (byte-compile-condition-case): Add warning. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-warn-quoted-condition): Add test case. --- lisp/emacs-lisp/bytecomp.el | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7571b4d409a..1a488977390 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4835,6 +4835,11 @@ binding slots have been popped." (dolist (clause (reverse clauses)) (let ((condition (nth 1 clause))) + (when (and (eq (car-safe condition) 'quote) + (cdr condition) (null (cddr condition))) + (byte-compile-warn-x + condition "`condition-case' condition should not be quoted: %S" + condition)) (unless (consp condition) (setq condition (list condition))) (dolist (c condition) (unless (and c (symbolp c)) -- cgit v1.2.1 From 7c63b632e4e2241a28f08015cc981a72e18d7867 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 29 Dec 2022 13:01:47 +0100 Subject: Add empty-body warning for when, unless etc Warn about code like (when SOME-CONDITION) because these may indicate bugs. Warnings currently apply to `when`, `unless`, `ignore-error`, `with-suppressed-warnings` and (as before) `let` and `let*`. * lisp/emacs-lisp/byte-run.el (with-suppressed-warnings): Update doc string. * lisp/emacs-lisp/bytecomp.el: (byte-compile-warning-types) (byte-compile-warnings): Add empty-body. (byte-compile-initial-macro-environment): Add empty-body warning for with-suppressed-warnings. * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Use the empty-body category for let and let*. * lisp/subr.el (when, unless, ignore-error): Add empty-body warning. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test--with-suppressed-warnings): Add test cases. --- lisp/emacs-lisp/byte-run.el | 4 ++-- lisp/emacs-lisp/bytecomp.el | 26 ++++++++++++++++---------- lisp/emacs-lisp/macroexp.el | 2 +- lisp/subr.el | 31 +++++++++++++++++++++---------- 4 files changed, 40 insertions(+), 23 deletions(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index b5e887db836..d909395e973 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -649,8 +649,8 @@ in `byte-compile-warning-types'; see the variable `byte-compile-warnings' for a fuller explanation of the warning types. The types that can be suppressed with this macro are `free-vars', `callargs', `redefine', `obsolete', -`interactive-only', `lexical', `mapcar', `constants' and -`suspicious'. +`interactive-only', `lexical', `mapcar', `constants', +`suspicious' and `empty-body'. For the `mapcar' case, only the `mapcar' function can be used in the symbol list. For `suspicious', only `set-buffer', `lsh' and `eq' diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1a488977390..a41e076f9b0 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -295,7 +295,8 @@ The information is logged to `byte-compile-log-buffer'." '(redefine callargs free-vars unresolved obsolete noruntime interactive-only make-local mapcar constants suspicious lexical lexical-dynamic - docstrings docstrings-non-ascii-quotes not-unused) + docstrings docstrings-non-ascii-quotes not-unused + empty-body) "The list of warning types used when `byte-compile-warnings' is t.") (defcustom byte-compile-warnings t "List of warnings that the byte-compiler should issue (t for almost all). @@ -326,6 +327,7 @@ Elements of the list may be: docstrings-non-ascii-quotes docstrings that have non-ASCII quotes. This depends on the `docstrings' warning type. suspicious constructs that usually don't do what the coder wanted. + empty-body body argument to a special form or macro is empty. If the list begins with `not', then the remaining elements specify warnings to suppress. For example, (not mapcar) will suppress warnings about mapcar. @@ -541,15 +543,19 @@ Return the compile-time value of FORM." ;; Later `internal--with-suppressed-warnings' binds it again, this ;; time in order to affect warnings emitted during the ;; compilation itself. - (let ((byte-compile--suppressed-warnings - (append warnings byte-compile--suppressed-warnings))) - ;; This function doesn't exist, but is just a placeholder - ;; symbol to hook up with the - ;; `byte-hunk-handler'/`byte-defop-compiler-1' machinery. - `(internal--with-suppressed-warnings - ',warnings - ,(macroexpand-all `(progn ,@body) - macroexpand-all-environment)))))) + (if body + (let ((byte-compile--suppressed-warnings + (append warnings byte-compile--suppressed-warnings))) + ;; This function doesn't exist, but is just a placeholder + ;; symbol to hook up with the + ;; `byte-hunk-handler'/`byte-defop-compiler-1' machinery. + `(internal--with-suppressed-warnings + ',warnings + ,(macroexpand-all `(progn ,@body) + macroexpand-all-environment))) + (macroexp-warn-and-return + "`with-suppressed-warnings' with empty body" + nil '(empty-body with-suppressed-warnings) t warnings))))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 8953e5fd019..8aa9cb860c4 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -368,7 +368,7 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexp-unprogn (macroexp-warn-and-return (format "Empty %s body" fun) - nil nil 'compile-only fun)) + nil (list 'empty-body fun) 'compile-only fun)) (macroexp--all-forms body)) (cdr form)) form))) diff --git a/lisp/subr.el b/lisp/subr.el index 5e8f3c82a2a..69e6198e1bd 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -280,14 +280,20 @@ change the list." When COND yields non-nil, eval BODY forms sequentially and return value of last one, or nil if there are none." (declare (indent 1) (debug t)) - (list 'if cond (cons 'progn body))) + (if body + (list 'if cond (cons 'progn body)) + (macroexp-warn-and-return "`when' with empty body" + cond '(empty-body when) t))) (defmacro unless (cond &rest body) "If COND yields nil, do BODY, else return nil. When COND yields nil, eval BODY forms sequentially and return value of last one, or nil if there are none." (declare (indent 1) (debug t)) - (cons 'if (cons cond (cons nil body)))) + (if body + (cons 'if (cons cond (cons nil body))) + (macroexp-warn-and-return "`unless' with empty body" + cond '(empty-body unless) t))) (defsubst subr-primitive-p (object) "Return t if OBJECT is a built-in primitive function." @@ -383,14 +389,19 @@ Otherwise, return result of last form in BODY. CONDITION can also be a list of error conditions. The CONDITION argument is not evaluated. Do not quote it." (declare (debug t) (indent 1)) - (if (and (eq (car-safe condition) 'quote) - (cdr condition) (null (cddr condition))) - (macroexp-warn-and-return - (format "`ignore-error' condition argument should not be quoted: %S" - condition) - `(condition-case nil (progn ,@body) (,(cadr condition) nil)) - nil t condition) - `(condition-case nil (progn ,@body) (,condition nil)))) + (cond + ((and (eq (car-safe condition) 'quote) + (cdr condition) (null (cddr condition))) + (macroexp-warn-and-return + (format "`ignore-error' condition argument should not be quoted: %S" + condition) + `(condition-case nil (progn ,@body) (,(cadr condition) nil)) + nil t condition)) + (body + `(condition-case nil (progn ,@body) (,condition nil))) + (t + (macroexp-warn-and-return "`ignore-error' with empty body" + nil '(empty-body ignore-error) t condition)))) ;;;; Basic Lisp functions. -- cgit v1.2.1 From 314cbef84944145e2160736ce32812403ed99cd9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 29 Dec 2022 13:15:20 +0100 Subject: ; Suppress empty-body warnings in cedet/semantic --- lisp/cedet/semantic/lex-spp.el | 2 +- lisp/cedet/semantic/lex.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 390c13ec98b..f3704f9a4d4 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -1243,7 +1243,7 @@ Finds the header file belonging to NAME, gets the macros from that file, and then merge the macros with our current symbol table." (when semantic-lex-spp-use-headers-flag - ;; @todo - do this someday, ok? + nil ; @todo - do this someday, ok? )) (defmacro define-lex-spp-include-analyzer (name doc regexp tokidx diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 264b2027711..e4bce67c6f7 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -1108,7 +1108,7 @@ This can be done by using `semantic-lex-push-token'." (semantic-lex-analysis-bounds (cons (point) (point-max))) (semantic-lex-current-depth 0) (semantic-lex-maximum-depth semantic-lex-depth)) - (when ,condition ,@forms) + (when ,condition nil ,@forms) ; `nil' avoids an empty-body warning. semantic-lex-token-stream)))) (defmacro define-lex-regex-analyzer (name doc regexp &rest forms) -- cgit v1.2.1 From 29d23b7fa00ed8263baa060d487b526d51fa6986 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 29 Dec 2022 17:00:01 +0100 Subject: Consistent empty-body warning messages for let and let* * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test--with-suppressed-warnings): Make warning messages for let and let* consistent with other empty-body warnings. --- lisp/emacs-lisp/macroexp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 8aa9cb860c4..d8c0cd5c7bd 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -367,7 +367,7 @@ Assumes the caller has bound `macroexpand-all-environment'." (if (null body) (macroexp-unprogn (macroexp-warn-and-return - (format "Empty %s body" fun) + (format "`%s' with empty body" fun) nil (list 'empty-body fun) 'compile-only fun)) (macroexp--all-forms body)) (cdr form)) -- cgit v1.2.1 From 0aea1cf8190aa804a0d11a67b4a3cb4b715ae82d Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 29 Dec 2022 19:45:12 +0200 Subject: * lisp/hi-lock.el (hi-lock--regexps-at-point): Fix bug (bug#60241). Handle two cases: when a pattern is a regexp or a function. --- lisp/hi-lock.el | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) (limited to 'lisp') diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index a45e74eca26..bc631747e6d 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -569,24 +569,29 @@ the major mode specifies support for Font Lock." (when (and face-before face-after (not (eq face-before face-after))) (setq face-before nil)) (when (or face-after face-before) - (let* ((hi-text - (buffer-substring-no-properties - (if face-before - (or (previous-single-property-change (point) 'face) - (point-min)) - (point)) - (if face-after - (or (next-single-property-change (point) 'face) - (point-max)) - (point))))) + (let* ((beg (if face-before + (or (previous-single-property-change (point) 'face) + (point-min)) + (point))) + (end (if face-after + (or (next-single-property-change (point) 'face) + (point-max)) + (point)))) ;; Compute hi-lock patterns that match the ;; highlighted text at point. Use this later in ;; during completing-read. (dolist (hi-lock-pattern hi-lock-interactive-patterns) - (let ((regexp (or (car (rassq hi-lock-pattern hi-lock-interactive-lighters)) - (car hi-lock-pattern)))) - (if (string-match regexp hi-text) - (push regexp regexps))))))) + (let ((pattern (or (rassq hi-lock-pattern hi-lock-interactive-lighters) + (car hi-lock-pattern)))) + (cond + ((stringp pattern) + (when (string-match pattern (buffer-substring-no-properties beg end)) + (push pattern regexps))) + ((functionp (cadr pattern)) + (save-excursion + (goto-char beg) + (when (funcall (cadr pattern) end) + (push (car pattern) regexps)))))))))) regexps)) (defvar-local hi-lock--unused-faces nil -- cgit v1.2.1 From 91ae9f3d12885373d38c3e8d693f7dc210f9d471 Mon Sep 17 00:00:00 2001 From: Theodor Thornhill Date: Thu, 29 Dec 2022 20:19:46 +0100 Subject: Allow for indentation in prog-fill-reindent-defun (bug#60322) * lisp/progmodes/prog-mode.el (prog-fill-reindent-defun): Adjust regexp. --- lisp/progmodes/prog-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index 5e692980b2f..2e0cb6cd25c 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -164,7 +164,7 @@ or follows point." (treesit-node-type (treesit-node-at (point))))))) (if (or treesit-text-node (nth 8 (syntax-ppss)) - (re-search-forward "^\\s<" (line-end-position) t)) + (re-search-forward "\\s-*\\s<" (line-end-position) t)) (fill-paragraph argument (region-active-p)) (beginning-of-defun) (let ((start (point))) -- cgit v1.2.1 From 793641a3db5e14cd2eeb251d2f473b1035192560 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Thu, 29 Dec 2022 11:34:28 -0800 Subject: ; * lisp/progmodes/js.el: Fix byte-compile warning. --- lisp/progmodes/js.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 4dece11d1c1..0cc673a80ff 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -74,6 +74,8 @@ (declare-function treesit-node-start "treesit.c") (declare-function treesit-node-end "treesit.c") (declare-function treesit-node-type "treesit.c") +(declare-function treesit-query-compile "treesit.c") +(declare-function treesit-query-capture "treesit.c") ;;; Constants @@ -3642,8 +3644,9 @@ OVERRIDE is the override flag described in "call_expression"))) (defvar js--treesit-lhs-identifier-query - (treesit-query-compile 'javascript '((identifier) @id - (property_identifier) @id)) + (when (treesit-available-p) + (treesit-query-compile 'javascript '((identifier) @id + (property_identifier) @id))) "Query that captures identifier and query_identifier.") (defun js--treesit-fontify-assignment-lhs (node override start end &rest _) -- cgit v1.2.1 From a96a7c811517063053a1dffc30ac94deffad503f Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Thu, 29 Dec 2022 11:41:26 -0800 Subject: ; * lisp/textmodes/css-mode.el (css-ts-mode): Fix imenu setup. --- lisp/textmodes/css-mode.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 204331ec72f..19f5fa303f9 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1821,8 +1821,8 @@ can also be used to fill comments. (property constant string) (error variable function operator bracket))) (setq-local treesit-simple-imenu-settings - `( nil ,(rx bos (or "rule_set" "media_statement") eos) - nil nil)) + `(( nil ,(rx bos (or "rule_set" "media_statement") eos) + nil nil))) (treesit-major-mode-setup))) ;;;###autoload -- cgit v1.2.1 From 558b59d81b938fc434e62523106360b9704c88e2 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Thu, 29 Dec 2022 11:52:06 -0800 Subject: Add color fontification in css-ts-mode (bug#60405) * lisp/textmodes/css-mode.el (css-ts-mode): Add color fontification and syntax-propertize-function. --- lisp/textmodes/css-mode.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 19f5fa303f9..e8d97259489 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1804,11 +1804,15 @@ can also be used to fill comments. :syntax-table css-mode-syntax-table (when (treesit-ready-p 'css) ;; Borrowed from `css-mode'. + (setq-local syntax-propertize-function + css-syntax-propertize-function) (add-hook 'completion-at-point-functions #'css-completion-at-point nil 'local) (setq-local fill-paragraph-function #'css-fill-paragraph) (setq-local adaptive-fill-function #'css-adaptive-fill) - (setq-local add-log-current-defun-function #'css-current-defun-name) + ;; `css--fontify-region' first calls the default function, which + ;; will call tree-sitter's function, then it fontifies colors. + (setq-local font-lock-fontify-region-function #'css--fontify-region) ;; Tree-sitter specific setup. (treesit-parser-create 'css) -- cgit v1.2.1 From beed746f944aba2559192c057ea294233876e99d Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 29 Dec 2022 21:50:26 +0000 Subject: Fix completion when completion-auto-select is set * lisp/minibuffer.el (completion--do-completion): Do not display "Complete, but not unique" messages when completion-auto-select is set. Fixes bug#60359. --- lisp/minibuffer.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 6e42296e7ba..7a720cf2c0a 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1474,7 +1474,10 @@ when the buffer's text is already an exact match." (if (and (eq this-command last-command) completion-auto-help) (minibuffer-completion-help beg end)) (completion--done completion 'exact - (unless expect-exact + (unless (or expect-exact + (and completion-auto-select + (eq this-command last-command) + completion-auto-help)) "Complete, but not unique")))) (minibuffer--bitset completed t exact)))))))) -- cgit v1.2.1 From dafa6d6badd6552b6f88ba884e3e5dadb362380d Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Mon, 19 Dec 2022 22:18:22 +0000 Subject: Handle non-string values in pcomplete * lisp/pcomplete.el (pcomplete-arg): When pcomplete-parse-arguments-function returns a non-string value, return the string the user typed in, and attach the value as a text property to that string. Fixes bug#59956 and bug#60021. --- lisp/pcomplete.el | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 4e3a88bbda8..2d3730e294a 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -645,13 +645,26 @@ parts of the list. The OFFSET argument is added to/taken away from the index that will be used. This is really only useful with `first' and `last', for -accessing absolute argument positions." - (nth (+ (pcase index - ('first 0) - ('last pcomplete-last) - (_ (- pcomplete-index (or index 0)))) - (or offset 0)) - pcomplete-args)) +accessing absolute argument positions. + +When the argument has been transformed into something that is not +a string by `pcomplete-parse-arguments-function', the text +representation of the argument, namely what the user actually +typed in, is returned, and the value of the argument is stored in +the pcomplete-arg-value text property of that string." + (let ((arg + (nth (+ (pcase index + ('first 0) + ('last pcomplete-last) + (_ (- pcomplete-index (or index 0)))) + (or offset 0)) + pcomplete-args))) + (if (stringp arg) + arg + (propertize + (buffer-substring (pcomplete-begin index offset) + (pcomplete-begin (1- (or index 0)) offset)) + 'pcomplete-arg-value arg)))) (defun pcomplete-begin (&optional index offset) "Return the beginning position of the INDEXth argument. -- cgit v1.2.1 From d086cd6cf877c6ca7af6712f9b79b52dd0caa934 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 29 Dec 2022 22:41:58 +0000 Subject: Clarify the documentation of 'set-face-attribute' * lisp/faces.el (set-face-attribute): Mention the evaluation order of attribute-value pairs in the docstring. * doc/lispref/display.texi (Attribute Functions): Likewise, and explain with an example that a different argument order might give different results. Also align the documentation in the manual with that of the docstring, whose changes were discussed in bug#57499 but not included in the manual. --- lisp/faces.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp') diff --git a/lisp/faces.el b/lisp/faces.el index 29e26e4c651..fe683e437f5 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -690,6 +690,10 @@ be reset to `unspecified' when creating new frames, disregarding what the FACE's face spec says, call this function with FRAME set to t and the ATTRIBUTE's value set to `unspecified'. +Note that the ATTRIBUTE VALUE pairs are evaluated in the order +they are specified, except the `:family' and `:foundry' +attributes which are evaluated first. + The following attributes are recognized: `:family' -- cgit v1.2.1 From ab38abfdf75e091b9970dd3ba977aaa1b6067cc3 Mon Sep 17 00:00:00 2001 From: Roland Winkler Date: Thu, 29 Dec 2022 23:22:48 -0600 Subject: lisp/textmodes/bibtex.el: Treat $ as punctuation in BibTeX fields (bug#50202) --- lisp/textmodes/bibtex.el | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index f4b557f443f..a1a3cbd8f14 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1822,8 +1822,9 @@ Initialized by `bibtex-set-dialect'.") 1 '(11)))) (defvar bibtex-font-lock-keywords - ;; entry type and reference key - `((,bibtex-any-entry-maybe-empty-head + `(("\\$[^$\n]+\\$" . font-lock-string-face) ; bug#50202 + ;; entry type and reference key + (,bibtex-any-entry-maybe-empty-head (,bibtex-type-in-head font-lock-function-name-face) (,bibtex-key-in-head font-lock-constant-face nil t)) ;; optional field names (treated as comments) @@ -3631,8 +3632,11 @@ if that value is non-nil. (setq-local fill-paragraph-function #'bibtex-fill-field) (setq-local font-lock-defaults '(bibtex-font-lock-keywords - nil t ((?$ . "\"") - ;; Mathematical expressions should be fontified as strings + nil t ((?$ . ".") + ;; Mathematical expressions should be fontified + ;; as strings. Yet `$' may also appear in certain + ;; fields like `URL' when it does not delimit + ;; a math expression (bug#50202). (?\" . ".") ;; Quotes are field delimiters and quote-delimited ;; entries should be fontified in the same way as -- cgit v1.2.1 From 644c71d6788d268cb065bd9317efb8a16a8236e6 Mon Sep 17 00:00:00 2001 From: Roland Winkler Date: Thu, 29 Dec 2022 23:31:08 -0600 Subject: lisp/textmodes/bibtex.el: fix bibtex-beginning-of-entry (bug#56636) lisp/textmodes/bibtex.el (bibtex-beginning-of-entry): use bibtex-any-entry-maybe-empty-head (bug#56636) --- lisp/textmodes/bibtex.el | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'lisp') diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index a1a3cbd8f14..23909742889 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -4083,11 +4083,19 @@ INIT is surrounded by field delimiters, unless NODELIM is non-nil." If inside an entry, move to the beginning of it, otherwise move to the beginning of the previous entry. If point is ahead of all BibTeX entries move point to the beginning of buffer. Return the new location of point." + ;; This command is similar to `beginning-of-defun', but with historical + ;; differences. + ;; - It does not move point to the previous entry if point is already + ;; at the beginning of an entry + ;; - It does not take an optional ARG that moves backward to the beginning + ;; of a defun ARG times. + ;; - It returns point and the code relies on this. (interactive) - (skip-chars-forward " \t") - (if (looking-at "@") - (forward-char)) - (re-search-backward "^[ \t]*@" nil 'move) + (beginning-of-line) + ;; `bibtex-any-valid-entry-type' would fail if users "disable" + ;; an entry by chosing an invalid entry type. + (or (looking-at bibtex-any-entry-maybe-empty-head) + (re-search-backward bibtex-any-entry-maybe-empty-head nil 'move)) (point)) (defun bibtex-end-of-entry () -- cgit v1.2.1 From 8c13e8497821881b5197a1717e9e53b9991859d0 Mon Sep 17 00:00:00 2001 From: LdBeth Date: Thu, 29 Dec 2022 19:16:09 -0800 Subject: Fix newsticker timezone decode 'newsticker--decode-rfc822-date' has the regex pattern for North American timezones but the actual timezone conversion for them was not implmented. Now cond cases are added to handle them as specified in RFC822. Copyright-paperwork-exempt: yes --- lisp/net/newst-backend.el | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) (limited to 'lisp') diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index af196ccecf9..2a87742fdf8 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -1623,7 +1623,7 @@ Sat, 07 Sep 2002 00:00:01 GMT ":\\([0-9]\\{2\\}\\)" ;; second "\\(:\\([0-9]\\{2\\}\\)\\)?" - ;; zone -- fixme + ;; zone "\\(\\s-+\\(" "UT\\|GMT\\|EST\\|EDT\\|CST\\|CDT\\|MST\\|MDT\\|PST\\|PDT" "\\|\\([-+]\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)" @@ -1642,16 +1642,26 @@ Sat, 07 Sep 2002 00:00:01 GMT (offset-hour (read (or (match-string 14 rfc822-string) "0"))) (offset-minute (read (or (match-string 15 rfc822-string) - "0"))) - ;;FIXME - ) + "0")))) (when zone (cond ((string= sign "+") (setq hour (- hour offset-hour)) (setq minute (- minute offset-minute))) ((string= sign "-") (setq hour (+ hour offset-hour)) - (setq minute (+ minute offset-minute))))) + (setq minute (+ minute offset-minute))) + ((or (string= zone "UT") (string= zone "GMT")) + nil) + ((string= zone "EDT") + (setq hour (+ hour 4))) + ((or (string= zone "EST") (string= zone "CDT")) + (setq hour (+ hour 5))) + ((or (string= zone "CST") (string= zone "MDT")) + (setq hour (+ hour 6))) + ((or (string= zone "MST") (string= zone "PDT")) + (setq hour (+ hour 7))) + ((string= zone "PST") + (setq hour (+ hour 8))))) (condition-case error-data (let ((i 1)) (dolist (m '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" -- cgit v1.2.1 From 73769dc2b872441eb0b8565e1090e97fc0b5d521 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 29 Dec 2022 19:16:09 -0800 Subject: In cal-dst, be consistent re default to UTC * lisp/calendar/cal-dst.el (calendar-standard-time-zone-name) (calendar-daylight-time-zone-name): When using alphabetic time zone abbreviations, default to "UTC" rather than to "EST" or "EDT", to be consistent with the behavior when using numeric time zone abbreviations. Also, in the numeric time zone use "-0000" rather than "+0000" to show that the time zone is unknown; this is the RFC 5322 standard. --- lisp/calendar/cal-dst.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index 5f601f24d24..c8a65126a49 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -354,10 +354,10 @@ If the locale never uses daylight saving time, set this to 0." (if calendar-current-time-zone-cache (format-time-string "%z" 0 (* 60 (car calendar-current-time-zone-cache))) - "+0000") - (or (nth 2 calendar-current-time-zone-cache) "EST")) + "-0000") + (or (nth 2 calendar-current-time-zone-cache) "UTC")) "Abbreviated name of standard time zone at `calendar-location-name'. -For example, \"EST\" in New York City, \"PST\" for Los Angeles." +For example, \"-0500\" or \"EST\" in New York City." :type 'string :version "28.1" :set-after '(calendar-time-zone-style) @@ -368,10 +368,10 @@ For example, \"EST\" in New York City, \"PST\" for Los Angeles." (if calendar-current-time-zone-cache (format-time-string "%z" 0 (* 60 (cadr calendar-current-time-zone-cache))) - "+0000") - (or (nth 3 calendar-current-time-zone-cache) "EDT")) + "-0000") + (or (nth 3 calendar-current-time-zone-cache) "UTC")) "Abbreviated name of daylight saving time zone at `calendar-location-name'. -For example, \"EDT\" in New York City, \"PDT\" for Los Angeles." +For example, \"-0400\" or \"EDT\" in New York City." :type 'string :version "28.1" :set-after '(calendar-time-zone-style) -- cgit v1.2.1 From d11e34ce76aac8680337f247419657e042e4cf34 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 29 Dec 2022 21:27:45 -0800 Subject: Default mbox "From " time zone to -0000 * lisp/mail/rmailout.el (rmail-nuke-pinhead-header): Default the time zone to "-0000" instead of "EST", as "-0000" is the RFC-2822-and-later standard for unknown time zones. --- lisp/mail/rmailout.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'lisp') diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index c1371308d4f..18f980df975 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -327,15 +327,14 @@ Replaces the From line with a \"Mail-from\" header. Adds \"Date\" and "Date: \\2, \\4 \\3 \\9 \\5 " ;; The timezone could be matched by group 7 or group 10. - ;; If neither of them matched, assume EST, since only - ;; Easterners would be so sloppy. + ;; If neither matched, use "-0000" for an unknown zone. ;; It's a shame the substitution can't use "\\10". (cond ((/= (match-beginning 7) (match-end 7)) "\\7") ((/= (match-beginning 10) (match-end 10)) (buffer-substring (match-beginning 10) (match-end 10))) - (t "EST")) + (t "-0000")) "\n")) ;; Keep and reformat the sender if we don't ;; have a From: field. -- cgit v1.2.1 From bc4cbbcc57a56a23c64576c8c23ecf6afb1c747b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 29 Dec 2022 19:16:09 -0800 Subject: Add nndiary-headers obsolescence comment * lisp/gnus/nndiary.el (nndiary-headers): Add comment about alphabetic time zone names being obsolescent. --- lisp/gnus/nndiary.el | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'lisp') diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index ab9c6dd74f9..e3fb5d8f872 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -339,8 +339,15 @@ all. This may very well take some time.") ;; for this header) or one list (specifying all the possible values for this ;; header). In the latter case, the list does NOT include the unspecified ;; spec (*). + ;; For time zone values, we have symbolic time zone names associated with ;; the (relative) number of seconds ahead GMT. + ;; The list of time zone values is obsolescent, and new code should + ;; not rely on it. Many of the time zone abbreviations are wrong; + ;; in particular, all single-letter abbreviations other than "Z" have + ;; been wrong since Internet RFC 2822 (2001). However, the + ;; abbreviations have not been changed due to backward compatibility + ;; concerns. ) (defsubst nndiary-schedule () -- cgit v1.2.1 From 007e66bccb2cb8382158e5e24727fd1b4478cd69 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 29 Dec 2022 19:16:09 -0800 Subject: Use RFC 822 abbrevs in sunrise-sunset strings * lisp/calendar/solar.el (sunrise-sunset): Use RFC 822 time zone abbreviations like "+0530" instead of idiosyncratic abbreviations like "UTC+330min". --- lisp/calendar/solar.el | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) (limited to 'lisp') diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 8f501824bb0..0b5bc166530 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -839,12 +839,10 @@ This function is suitable for execution in an init file." "E" "W")))))) (calendar-standard-time-zone-name (if (< arg 16) calendar-standard-time-zone-name - (cond ((zerop calendar-time-zone) - (if (eq calendar-time-zone-style 'numeric) - "+0000" "UTC")) - ((< calendar-time-zone 0) - (format "UTC%dmin" calendar-time-zone)) - (t (format "UTC+%dmin" calendar-time-zone))))) + (if (and (zerop calendar-time-zone) + (not (eq calendar-time-zone-style 'numeric))) + "UTC" + (format-time-string "%z" 0 (* 60 calendar-time-zone))))) (calendar-daylight-savings-starts (if (< arg 16) calendar-daylight-savings-starts)) (calendar-daylight-savings-ends -- cgit v1.2.1 From 9153cf8158489d387a6a0d9d0ede9a2528c35f0a Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 29 Dec 2022 19:16:10 -0800 Subject: Avoid some obsolescent tz abbrevs in doc. --- lisp/calendar/diary-lib.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 9a2baf1e43c..cc1e7ec5f72 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -339,7 +339,7 @@ Returns a string using match elements 1-5, where: (t "\\1 \\2 \\3"))) ; MDY "\n \\4 %s, \\5"))) ;; TODO Sometimes the time is in a different time-zone to the one you -;; are in. Eg in PST, you might still get an email referring to: +;; are in. E.g., in Los Angeles, you might still get an email referring to: ;; "7:00 PM-8:00 PM. Greenwich Standard Time". ;; Note that it doesn't use a standard abbreviation for the timezone, ;; or anything helpful like that. -- cgit v1.2.1 From 073da412a139e317959f56e359ed12de726a0a35 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sat, 24 Dec 2022 14:31:50 -0800 Subject: Fix reference-counting of Eshell I/O handles This ensures that output targets in Eshell are only closed when Eshell is actually done with them. In particular, this means that "{ echo foo; echo bar } | rev" prints "raboof" as expected (bug#59545). * lisp/eshell/esh-io.el (eshell-create-handles): Structure the handles differently so the targets and their ref-count can be shared. (eshell-duplicate-handles): Reimplement this to share targets between the original and new handle sets. Add STEAL-P argument. (eshell-protect-handles, eshell-copy-output-handle) (eshell-interactive-output-p, eshell-output-object): Account for changes to the handle structure. (eshell-close-handle): New function... (eshell-close-handles, eshell-set-output-handle): ... use it. (eshell-get-targets): Remove. This only existed to make the previous implementation of 'eshell-duplicate-handles' work. * lisp/eshell/esh-cmd.el (eshell-with-copied-handles): New argument STEAL-P. (eshell-do-pipelines): Use STEAL-P for the last item in the pipeline. (eshell-parse-command): Don't copy handles for the last command in the list; explain why we can't use STEAL-P here. (eshell-eval-command): When queuing input, set 'eshell-command-body' and 'eshell-test-body' for the 'if' conditional (see 'eshell-do-eval'). * test/lisp/eshell/esh-io-tests.el (esh-io-test/redirect-pipe): Split into... (esh-io-test/pipeline/default, esh-io-test/pipeline/all): ... these. (esh-io-test/pipeline/subcommands): New test. * test/lisp/eshell/esh-cmd-tests.el (esh-cmd-test/for-loop-pipe) (esh-cmd-test/while-loop-pipe, esh-cmd-test/if-statement-pipe) esh-cmd-test/if-else-statement-pipe): New tests. (esh-cmd-test/while-loop): Use 'pop' to simplify the test a bit. * test/lisp/eshell/eshell-test-helpers.el (eshell-test--max-subprocess-time): Rename to... (eshell-test--max-wait-time): ... this. (eshell-wait-for): New function... (eshell-wait-for-subprocess): ... use it. * test/lisp/eshell/eshell-tests.el (eshell-test/queue-input): Fix this test. Previously, it didn't correctly verify that the original command completed. * test/lisp/eshell/em-tramp-tests.el (em-tramp-test/should-replace-command): New macro... (em-tramp-test/su-default, em-tramp-test/su-user) (em-tramp-test/su-login, em-tramp-test/sudo-shell) (em-tramp-test/sudo-user-shell, em-tramp-test/doas-shell) (em-tramp-test/doas-user-shell): ... use it. --- lisp/eshell/esh-cmd.el | 25 ++++++---- lisp/eshell/esh-io.el | 123 +++++++++++++++++++++++++++++-------------------- 2 files changed, 89 insertions(+), 59 deletions(-) (limited to 'lisp') diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 79957aeb416..39579335cf7 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -419,11 +419,10 @@ hooks should be run before and after the command." (let ((cmd commands)) (while cmd ;; Copy I/O handles so each full statement can manipulate them - ;; if they like. As a small optimization, skip this for the - ;; last top-level one; we won't use these handles again - ;; anyway. - (when (or (not toplevel) (cdr cmd)) - (setcar cmd `(eshell-with-copied-handles ,(car cmd)))) + ;; if they like. Steal the handles for the last command in + ;; the list; we won't use the originals again anyway. + (setcar cmd `(eshell-with-copied-handles + ,(car cmd) ,(not (cdr cmd)))) (setq cmd (cdr cmd)))) (if toplevel `(eshell-commands (progn @@ -792,10 +791,12 @@ this grossness will be made to disappear by using `call/cc'..." (defvar eshell-output-handle) ;Defined in esh-io.el. (defvar eshell-error-handle) ;Defined in esh-io.el. -(defmacro eshell-with-copied-handles (object) - "Duplicate current I/O handles, so OBJECT works with its own copy." +(defmacro eshell-with-copied-handles (object &optional steal-p) + "Duplicate current I/O handles, so OBJECT works with its own copy. +If STEAL-P is non-nil, these new handles will be stolen from the +current ones (see `eshell-duplicate-handles')." `(let ((eshell-current-handles - (eshell-duplicate-handles eshell-current-handles))) + (eshell-duplicate-handles eshell-current-handles ,steal-p))) ,object)) (define-obsolete-function-alias 'eshell-copy-handles @@ -836,7 +837,9 @@ This macro calls itself recursively, with NOTFIRST non-nil." (let ((proc ,(car pipeline))) (set headproc (or proc (symbol-value headproc))) (set tailproc (or (symbol-value tailproc) proc)) - proc)))))) + proc))) + ;; Steal handles if this is the last item in the pipeline. + ,(null (cdr pipeline))))) (defmacro eshell-do-pipelines-synchronously (pipeline) "Execute the commands in PIPELINE in sequence synchronously. @@ -1024,7 +1027,9 @@ produced by `eshell-parse-command'." ;; We can just stick the new command at the end of the current ;; one, and everything will happen as it should. (setcdr (last (cdr eshell-current-command)) - (list `(let ((here (and (eobp) (point)))) + (list `(let ((here (and (eobp) (point))) + (eshell-command-body '(nil)) + (eshell-test-body '(nil))) ,(and input `(insert-and-inherit ,(concat input "\n"))) (if here diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index f2bc87374c1..90826a312b3 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -302,35 +302,51 @@ value of mode defaults to `insert'. The result is a vector of file handles. Each handle is of the form: - (TARGETS DEFAULT REF-COUNT) + ((TARGETS . REF-COUNT) DEFAULT) -TARGETS is a list of destinations for output. DEFAULT is non-nil -if handle has its initial default value (always t after calling -this function). REF-COUNT is the number of references to this -handle (initially 1); see `eshell-protect-handles' and -`eshell-close-handles'." +TARGETS is a list of destinations for output. REF-COUNT is the +number of references to this handle (initially 1); see +`eshell-protect-handles' and `eshell-close-handles'. DEFAULT is +non-nil if handle has its initial default value (always t after +calling this function)." (let* ((handles (make-vector eshell-number-of-handles nil)) - (output-target (eshell-get-targets stdout output-mode)) - (error-target (if stderr - (eshell-get-targets stderr error-mode) - output-target))) - (aset handles eshell-output-handle (list output-target t 1)) - (aset handles eshell-error-handle (list error-target t 1)) + (output-target + (let ((target (eshell-get-target stdout output-mode))) + (cons (when target (list target)) 1))) + (error-target + (if stderr + (let ((target (eshell-get-target stderr error-mode))) + (cons (when target (list target)) 1)) + (cl-incf (cdr output-target)) + output-target))) + (aset handles eshell-output-handle (list output-target t)) + (aset handles eshell-error-handle (list error-target t)) handles)) -(defun eshell-duplicate-handles (handles) +(defun eshell-duplicate-handles (handles &optional steal-p) "Create a duplicate of the file handles in HANDLES. -This will copy the targets of each handle in HANDLES, setting the -DEFAULT field to t (see `eshell-create-handles')." - (eshell-create-handles - (car (aref handles eshell-output-handle)) nil - (car (aref handles eshell-error-handle)) nil)) +This uses the targets of each handle in HANDLES, incrementing its +reference count by one (unless STEAL-P is non-nil). These +targets are shared between the original set of handles and the +new one, so the targets are only closed when the reference count +drops to 0 (see `eshell-close-handles'). + +This function also sets the DEFAULT field for each handle to +t (see `eshell-create-handles'). Unlike the targets, this value +is not shared with the original handles." + (let ((dup-handles (make-vector eshell-number-of-handles nil))) + (dotimes (idx eshell-number-of-handles) + (when-let ((handle (aref handles idx))) + (unless steal-p + (cl-incf (cdar handle))) + (aset dup-handles idx (list (car handle) t)))) + dup-handles)) (defun eshell-protect-handles (handles) "Protect the handles in HANDLES from a being closed." (dotimes (idx eshell-number-of-handles) (when-let ((handle (aref handles idx))) - (setcar (nthcdr 2 handle) (1+ (nth 2 handle))))) + (cl-incf (cdar handle)))) handles) (defun eshell-close-handles (&optional exit-code result handles) @@ -348,29 +364,45 @@ the value already set in `eshell-last-command-result'." (when result (cl-assert (eq (car result) 'quote)) (setq eshell-last-command-result (cadr result))) - (let ((handles (or handles eshell-current-handles))) + (let ((handles (or handles eshell-current-handles)) + (succeeded (= eshell-last-command-status 0))) (dotimes (idx eshell-number-of-handles) - (when-let ((handle (aref handles idx))) - (setcar (nthcdr 2 handle) (1- (nth 2 handle))) - (when (= (nth 2 handle) 0) - (dolist (target (ensure-list (car (aref handles idx)))) - (eshell-close-target target (= eshell-last-command-status 0))) - (setcar handle nil)))))) + (eshell-close-handle (aref handles idx) succeeded)))) + +(defun eshell-close-handle (handle status) + "Close a single HANDLE, taking refcounts into account. +This will pass STATUS to each target for the handle, which should +be a non-nil value on successful termination." + (when handle + (cl-assert (> (cdar handle) 0) + "Attempted to close a handle with 0 references") + (when (and (> (cdar handle) 0) + (= (cl-decf (cdar handle)) 0)) + (dolist (target (caar handle)) + (eshell-close-target target status)) + (setcar (car handle) nil)))) (defun eshell-set-output-handle (index mode &optional target handles) "Set handle INDEX for the current HANDLES to point to TARGET using MODE. -If HANDLES is nil, use `eshell-current-handles'." +If HANDLES is nil, use `eshell-current-handles'. + +If the handle is currently set to its default value (see +`eshell-create-handles'), this will overwrite the targets with +the new target. Otherwise, it will append the new target to the +current list of targets." (when target (let* ((handles (or handles eshell-current-handles)) (handle (or (aref handles index) - (aset handles index (list nil nil 1)))) - (defaultp (cadr handle)) - (current (unless defaultp (car handle)))) + (aset handles index (list (cons nil 1) nil)))) + (defaultp (cadr handle))) + (when defaultp + (cl-decf (cdar handle)) + (setcar handle (cons nil 1))) (catch 'eshell-null-device - (let ((where (eshell-get-target target mode))) + (let ((current (caar handle)) + (where (eshell-get-target target mode))) (unless (member where current) - (setq current (append current (list where)))))) - (setcar handle current) + (setcar (car handle) (append current (list where)))))) (setcar (cdr handle) nil)))) (defun eshell-copy-output-handle (index index-to-copy &optional handles) @@ -378,10 +410,10 @@ If HANDLES is nil, use `eshell-current-handles'." If HANDLES is nil, use `eshell-current-handles'." (let* ((handles (or handles eshell-current-handles)) (handle-to-copy (car (aref handles index-to-copy)))) - (setcar (aref handles index) - (if (listp handle-to-copy) - (copy-sequence handle-to-copy) - handle-to-copy)))) + (when handle-to-copy + (cl-incf (cdr handle-to-copy))) + (eshell-close-handle (aref handles index) nil) + (setcar (aref handles index) handle-to-copy))) (defun eshell-set-all-output-handles (mode &optional target handles) "Set output and error HANDLES to point to TARGET using MODE. @@ -501,13 +533,6 @@ it defaults to `insert'." (error "Invalid redirection target: %s" (eshell-stringify target))))) -(defun eshell-get-targets (targets &optional mode) - "Convert TARGETS into valid output targets. -TARGETS can be a single raw target or a list thereof. MODE is either -`overwrite', `append' or `insert'; if it is omitted or nil, it -defaults to `insert'." - (mapcar (lambda (i) (eshell-get-target i mode)) (ensure-list targets))) - (defun eshell-interactive-output-p (&optional index handles) "Return non-nil if the specified handle is bound for interactive display. HANDLES is the set of handles to check; if nil, use @@ -519,9 +544,9 @@ INDEX is the handle index to check. If nil, check (let ((handles (or handles eshell-current-handles)) (index (or index eshell-output-handle))) (if (eq index 'all) - (and (equal (car (aref handles eshell-output-handle)) '(t)) - (equal (car (aref handles eshell-error-handle)) '(t))) - (equal (car (aref handles index)) '(t))))) + (and (equal (caar (aref handles eshell-output-handle)) '(t)) + (equal (caar (aref handles eshell-error-handle)) '(t))) + (equal (caar (aref handles index)) '(t))))) (defvar eshell-print-queue nil) (defvar eshell-print-queue-count -1) @@ -628,8 +653,8 @@ Returns what was actually sent, or nil if nothing was sent." If HANDLE-INDEX is nil, output to `eshell-output-handle'. HANDLES is the set of file handles to use; if nil, use `eshell-current-handles'." - (let ((targets (car (aref (or handles eshell-current-handles) - (or handle-index eshell-output-handle))))) + (let ((targets (caar (aref (or handles eshell-current-handles) + (or handle-index eshell-output-handle))))) (dolist (target targets) (eshell-output-object-to-target object target)))) -- cgit v1.2.1 From c34230f12aa966df091dd7b3cb2e32ce43ad811d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 30 Dec 2022 11:11:14 +0100 Subject: ; remove incorrect quoting of condition names --- lisp/abbrev.el | 2 +- lisp/desktop.el | 2 +- lisp/eshell/esh-proc.el | 2 +- lisp/gnus/gnus-registry.el | 2 +- lisp/image-mode.el | 2 +- lisp/net/tramp.el | 2 +- lisp/startup.el | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) (limited to 'lisp') diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 2ca8e25dac7..26c2b097929 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -501,7 +501,7 @@ PROPS is a list of properties." (defun abbrev-table-p (object) "Return non-nil if OBJECT is an abbrev table." (and (obarrayp object) - (numberp (ignore-error 'wrong-type-argument + (numberp (ignore-error wrong-type-argument (abbrev-table-get object :abbrev-table-modiff))))) (defun abbrev-table-empty-p (object &optional ignore-system) diff --git a/lisp/desktop.el b/lisp/desktop.el index ef73bc596df..d55739bb6f8 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -828,7 +828,7 @@ is nil, ask the user where to save the desktop." ;; If we own it, we don't anymore. (when (eq (emacs-pid) (desktop-owner)) ;; Allow exiting Emacs even if we can't delete the desktop file. - (ignore-error 'file-error + (ignore-error file-error (desktop-release-lock)))) ;; ---------------------------------------------------------------------------- diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 950922ea7f8..c56278aad02 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -467,7 +467,7 @@ PROC is the process that's exiting. STRING is the exit message." (if (process-get proc :eshell-busy) (run-at-time 0 nil finish-io) (when data - (ignore-error 'eshell-pipe-broken + (ignore-error eshell-pipe-broken (eshell-output-object data index handles))) (eshell-close-handles diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index cf5ca628cff..c5cd4d7d6be 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -394,7 +394,7 @@ This is not required after changing `gnus-registry-cache-file'." (with-no-warnings (eieio-persistent-read file 'registry-db)) ;; Older EIEIO versions do not check the class name. - ('wrong-number-of-arguments + (wrong-number-of-arguments (eieio-persistent-read file))))) (gnus-message 5 "Reading Gnus registry from %s...done" file)) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index bd208fbad46..10af8c6cab9 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -1086,7 +1086,7 @@ Otherwise, display the image by calling `image-mode'." (unwind-protect (progn (setq-local image-fit-to-window-lock t) - (ignore-error 'remote-file-error + (ignore-error remote-file-error (image-toggle-display-image))) (setq image-fit-to-window-lock nil))))))))))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e39c9ccc31a..acbd50dc0fb 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -5439,7 +5439,7 @@ Wait, until the connection buffer changes." ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. - (while (not (tramp-compat-ignore-error 'file-error + (while (not (tramp-compat-ignore-error file-error (tramp-wait-for-regexp proc 0.1 tramp-security-key-confirmed-regexp))) (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) diff --git a/lisp/startup.el b/lisp/startup.el index 6270de2ace6..5a383630774 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2921,7 +2921,7 @@ nil default-directory" name) (when (looking-at "#!") (forward-line)) (let (value form) - (while (ignore-error 'end-of-file + (while (ignore-error end-of-file (setq form (read (current-buffer)))) (setq value (eval form t))) (kill-emacs (if (numberp value) -- cgit v1.2.1 From 7493b4026fc74a51c76c5b614bc83b864af9bc31 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 30 Dec 2022 11:30:23 +0100 Subject: ; fix misplaced bracketing of `and` inside `when` --- lisp/help-fns.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/help-fns.el b/lisp/help-fns.el index e29f763dabc..3307771ef68 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -2004,8 +2004,8 @@ variable with value KEYMAP." (mapatoms (lambda (symb) (when (and (boundp symb) (eq (symbol-value symb) keymap) - (not (eq symb 'keymap)) - (throw 'found-keymap symb))))) + (not (eq symb 'keymap))) + (throw 'found-keymap symb)))) nil))) ;; Follow aliasing. (or (ignore-errors (indirect-variable name)) name)))) -- cgit v1.2.1