commit 073da412a139e317959f56e359ed12de726a0a35 (HEAD, refs/remotes/origin/master) Author: Jim Porter Date: Sat Dec 24 14:31:50 2022 -0800 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. 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 @@ eshell-parse-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 @@ eshell-trap-errors (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 @@ eshell-do-pipelines (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 @@ eshell-eval-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 @@ eshell-create-handles 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 @@ eshell-close-handles (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 @@ eshell-copy-output-handle 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 @@ eshell-get-target (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 @@ eshell-interactive-output-p (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 @@ eshell-output-object 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)))) diff --git a/test/lisp/eshell/em-tramp-tests.el b/test/lisp/eshell/em-tramp-tests.el index 982a1eba279..936397d8869 100644 --- a/test/lisp/eshell/em-tramp-tests.el +++ b/test/lisp/eshell/em-tramp-tests.el @@ -23,40 +23,41 @@ (require 'em-tramp) (require 'tramp) +(defmacro em-tramp-test/should-replace-command (form replacement) + "Check that calling FORM results in it being replaced with REPLACEMENT." + (declare (indent 1)) + `(should (equal + (catch 'eshell-replace-command ,form) + (list 'eshell-with-copied-handles + (list 'eshell-trap-errors + ,replacement) + t)))) + (ert-deftest em-tramp-test/su-default () "Test Eshell `su' command with no arguments." - (should (equal - (catch 'eshell-replace-command (eshell/su)) - `(eshell-with-copied-handles - (eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/su:root@%s:%s" - tramp-default-host default-directory)))))))) + (em-tramp-test/should-replace-command (eshell/su) + `(eshell-named-command + "cd" + (list ,(format "/su:root@%s:%s" + tramp-default-host default-directory))))) (ert-deftest em-tramp-test/su-user () "Test Eshell `su' command with USER argument." - (should (equal - (catch 'eshell-replace-command (eshell/su "USER")) - `(eshell-with-copied-handles - (eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/su:USER@%s:%s" - tramp-default-host default-directory)))))))) + (em-tramp-test/should-replace-command (eshell/su "USER") + `(eshell-named-command + "cd" + (list ,(format "/su:USER@%s:%s" + tramp-default-host default-directory))))) (ert-deftest em-tramp-test/su-login () "Test Eshell `su' command with -/-l/--login option." (dolist (args '(("--login") ("-l") ("-"))) - (should (equal - (catch 'eshell-replace-command (apply #'eshell/su args)) - `(eshell-with-copied-handles - (eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/su:root@%s:~/" tramp-default-host))))))))) + (em-tramp-test/should-replace-command (apply #'eshell/su args) + `(eshell-named-command + "cd" + (list ,(format "/su:root@%s:~/" tramp-default-host)))))) (defun mock-eshell-named-command (&rest args) "Dummy function to test Eshell `sudo' command rewriting." @@ -92,25 +93,19 @@ em-tramp-test/sudo-shell "Test Eshell `sudo' command with -s/--shell option." (dolist (args '(("--shell") ("-s"))) - (should (equal - (catch 'eshell-replace-command (apply #'eshell/sudo args)) - `(eshell-with-copied-handles - (eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/sudo:root@%s:%s" - tramp-default-host default-directory))))))))) + (em-tramp-test/should-replace-command (apply #'eshell/sudo args) + `(eshell-named-command + "cd" + (list ,(format "/sudo:root@%s:%s" + tramp-default-host default-directory)))))) (ert-deftest em-tramp-test/sudo-user-shell () "Test Eshell `sudo' command with -s and -u options." - (should (equal - (catch 'eshell-replace-command (eshell/sudo "-u" "USER" "-s")) - `(eshell-with-copied-handles - (eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/sudo:USER@%s:%s" - tramp-default-host default-directory)))))))) + (em-tramp-test/should-replace-command (eshell/sudo "-u" "USER" "-s") + `(eshell-named-command + "cd" + (list ,(format "/sudo:USER@%s:%s" + tramp-default-host default-directory))))) (ert-deftest em-tramp-test/doas-basic () "Test Eshell `doas' command with default user." @@ -147,24 +142,18 @@ em-tramp-test/doas-shell "Test Eshell `doas' command with -s/--shell option." (dolist (args '(("--shell") ("-s"))) - (should (equal - (catch 'eshell-replace-command (apply #'eshell/doas args)) - `(eshell-with-copied-handles - (eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/doas:root@%s:%s" - tramp-default-host default-directory))))))))) + (em-tramp-test/should-replace-command (apply #'eshell/doas args) + `(eshell-named-command + "cd" + (list ,(format "/doas:root@%s:%s" + tramp-default-host default-directory)))))) (ert-deftest em-tramp-test/doas-user-shell () "Test Eshell `doas' command with -s and -u options." - (should (equal - (catch 'eshell-replace-command (eshell/doas "-u" "USER" "-s")) - `(eshell-with-copied-handles - (eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/doas:USER@%s:%s" - tramp-default-host default-directory)))))))) + (em-tramp-test/should-replace-command (eshell/doas "-u" "USER" "-s") + `(eshell-named-command + "cd" + (list ,(format "/doas:USER@%s:%s" + tramp-default-host default-directory))))) ;;; em-tramp-tests.el ends here diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index 92d785d7fdf..cc40dde3552 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -148,14 +148,21 @@ esh-cmd-test/for-name-shadow-loop "echo $name; for name in 3 { echo $name }; echo $name" "env-value\n3\nenv-value\n")))) +(ert-deftest esh-cmd-test/for-loop-pipe () + "Test invocation of a for loop piped to another command." + (skip-unless (executable-find "rev")) + (with-temp-eshell + (eshell-match-command-output "for i in foo bar baz { echo $i } | rev" + "zabraboof"))) + (ert-deftest esh-cmd-test/while-loop () "Test invocation of a while loop." (with-temp-eshell (let ((eshell-test-value '(0 1 2))) (eshell-match-command-output (concat "while $eshell-test-value " - "{ setq eshell-test-value (cdr eshell-test-value) }") - "(1 2)\n(2)\n")))) + "{ (pop eshell-test-value) }") + "0\n1\n2\n")))) (ert-deftest esh-cmd-test/while-loop-lisp-form () "Test invocation of a while loop using a Lisp form." @@ -176,6 +183,17 @@ esh-cmd-test/while-loop-ext-cmd "{ setq eshell-test-value (1+ eshell-test-value) }") "1\n2\n3\n")))) +(ert-deftest esh-cmd-test/while-loop-pipe () + "Test invocation of a while loop piped to another command." + (skip-unless (executable-find "rev")) + (with-temp-eshell + (let ((eshell-test-value '("foo" "bar" "baz"))) + (eshell-match-command-output + (concat "while $eshell-test-value " + "{ (pop eshell-test-value) }" + " | rev") + "zabraboof")))) + (ert-deftest esh-cmd-test/until-loop () "Test invocation of an until loop." (with-temp-eshell @@ -253,6 +271,28 @@ esh-cmd-test/if-else-statement-ext-cmd (eshell-command-result-equal "if {[ foo = bar ]} {echo yes} {echo no}" "no")) +(ert-deftest esh-cmd-test/if-statement-pipe () + "Test invocation of an if statement piped to another command." + (skip-unless (executable-find "rev")) + (let ((eshell-test-value t)) + (eshell-command-result-equal "if $eshell-test-value {echo yes} | rev" + "sey")) + (let ((eshell-test-value nil)) + (eshell-command-result-equal "if $eshell-test-value {echo yes} | rev" + nil))) + +(ert-deftest esh-cmd-test/if-else-statement-pipe () + "Test invocation of an if/else statement piped to another command." + (skip-unless (executable-find "rev")) + (let ((eshell-test-value t)) + (eshell-command-result-equal + "if $eshell-test-value {echo yes} {echo no} | rev" + "sey")) + (let ((eshell-test-value nil)) + (eshell-command-result-equal + "if $eshell-test-value {echo yes} {echo no} | rev" + "on"))) + (ert-deftest esh-cmd-test/unless-statement () "Test invocation of an unless statement." (let ((eshell-test-value t)) diff --git a/test/lisp/eshell/esh-io-tests.el b/test/lisp/eshell/esh-io-tests.el index 9a3c14f365f..0f09afa19e4 100644 --- a/test/lisp/eshell/esh-io-tests.el +++ b/test/lisp/eshell/esh-io-tests.el @@ -301,15 +301,28 @@ esh-io-test/redirect-copy-first "stderr\n")) (should (equal (buffer-string) "stdout\n")))) -(ert-deftest esh-io-test/redirect-pipe () - "Check that \"redirecting\" to a pipe works." - ;; `|' should only redirect stdout. + +;; Pipelines + +(ert-deftest esh-io-test/pipeline/default () + "Check that `|' only pipes stdout." + (skip-unless (executable-find "rev")) (eshell-command-result-equal "test-output | rev" - "stderr\ntuodts\n") - ;; `|&' should redirect stdout and stderr. + "stderr\ntuodts\n")) + + +(ert-deftest esh-io-test/pipeline/all () + "Check that `|&' only pipes stdout and stderr." + (skip-unless (executable-find "rev")) (eshell-command-result-equal "test-output |& rev" "tuodts\nrredts\n")) +(ert-deftest esh-io-test/pipeline/subcommands () + "Chek that all commands in a subcommand are properly piped." + (skip-unless (executable-find "rev")) + (eshell-command-result-equal "{echo foo; echo bar} | rev" + "raboof")) + ;; Virtual targets diff --git a/test/lisp/eshell/eshell-tests-helpers.el b/test/lisp/eshell/eshell-tests-helpers.el index 1d9674070c0..a9338050311 100644 --- a/test/lisp/eshell/eshell-tests-helpers.el +++ b/test/lisp/eshell/eshell-tests-helpers.el @@ -33,9 +33,9 @@ (defvar eshell-history-file-name nil) (defvar eshell-last-dir-ring-file-name nil) -(defvar eshell-test--max-subprocess-time 5 - "The maximum amount of time to wait for a subprocess to finish, in seconds. -See `eshell-wait-for-subprocess'.") +(defvar eshell-test--max-wait-time 5 + "The maximum amount of time to wait for a condition to resolve, in seconds. +See `eshell-wait-for'.") (defun eshell-tests-remote-accessible-p () "Return if a test involving remote files can proceed. @@ -73,19 +73,28 @@ eshell-with-temp-buffer (let ((,bufname (buffer-name))) ,@body))) +(defun eshell-wait-for (predicate &optional message) + "Wait until PREDICATE returns non-nil. +If this takes longer than `eshell-test--max-wait-time', raise an +error. MESSAGE is an optional message to use if this times out." + (let ((start (current-time)) + (message (or message "timed out waiting for condition"))) + (while (not (funcall predicate)) + (when (> (float-time (time-since start)) + eshell-test--max-wait-time) + (error message)) + (sit-for 0.1)))) + (defun eshell-wait-for-subprocess (&optional all) "Wait until there is no interactive subprocess running in Eshell. If ALL is non-nil, wait until there are no Eshell subprocesses at all running. -If this takes longer than `eshell-test--max-subprocess-time', +If this takes longer than `eshell-test--max-wait-time', raise an error." - (let ((start (current-time))) - (while (if all eshell-process-list (eshell-interactive-process-p)) - (when (> (float-time (time-since start)) - eshell-test--max-subprocess-time) - (error "timed out waiting for subprocess(es)")) - (sit-for 0.1)))) + (eshell-wait-for + (lambda () + (not (if all eshell-process-list (eshell-interactive-process-p)))))) (defun eshell-insert-command (command &optional func) "Insert a COMMAND at the end of the buffer. diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index c67ac67fd36..dd8be8e65f0 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -128,16 +128,17 @@ eshell-test/forward-arg (delete-region (point) (point-max)))))) (ert-deftest eshell-test/queue-input () - "Test queuing command input" + "Test queuing command input. +This should let the current command finish, then automatically +insert the queued one at the next prompt, and finally run it." (with-temp-eshell - (eshell-insert-command "sleep 2") - (eshell-insert-command "echo alpha" 'eshell-queue-input) - (let ((count 10)) - (while (and eshell-current-command - (> count 0)) - (sit-for 1) - (setq count (1- count)))) - (should (eshell-match-output "alpha\n")))) + (eshell-insert-command "sleep 1; echo slept") + (eshell-insert-command "echo alpha" #'eshell-queue-input) + (let ((start (marker-position (eshell-beginning-of-output)))) + (eshell-wait-for (lambda () (not eshell-current-command))) + (should (string-match "^slept\n.*echo alpha\nalpha\n$" + (buffer-substring-no-properties + start (eshell-end-of-output))))))) (ert-deftest eshell-test/flush-output () "Test flushing of previous output" commit 89e7bb230d643b3619d7e2ed6855c35184032542 Merge: 9153cf81584 644c71d6788 Author: Stefan Kangas Date: Fri Dec 30 06:45:13 2022 +0100 Merge from origin/emacs-29 644c71d6788 lisp/textmodes/bibtex.el: fix bibtex-beginning-of-entry (... ab38abfdf75 lisp/textmodes/bibtex.el: Treat $ as punctuation in BibTe... d086cd6cf87 Clarify the documentation of 'set-face-attribute' dafa6d6badd Handle non-string values in pcomplete beed746f944 Fix completion when completion-auto-select is set 7ccb88486eb ; * etc/DEBUG: Update MS-Windows specifics for GDB 13 and... 558b59d81b9 Add color fontification in css-ts-mode (bug#60405) a96a7c81151 ; * lisp/textmodes/css-mode.el (css-ts-mode): Fix imenu s... 793641a3db5 ; * lisp/progmodes/js.el: Fix byte-compile warning. 0aea1cf8190 * lisp/hi-lock.el (hi-lock--regexps-at-point): Fix bug (b... 60418e6f09c * src/keyboard.c (echo_add_key): Use recently rebound C-h... 706ed852855 Avoid assertion violations in treesit.c with --enable-che... 38c35bf0f6a Clean up treesit-default-defun-skipper and add comments 9371d488be6 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/... 9d814bea460 ; whitespace.el: Use the new 'ert-with-buffer-selected' i... 784e509bded Fix c-ts-mode bracket indentation (bug#60398) commit 9153cf8158489d387a6a0d9d0ede9a2528c35f0a Author: Paul Eggert Date: Thu Dec 29 19:16:10 2022 -0800 Avoid some obsolescent tz abbrevs in doc. diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi index 1a80c62edba..0650ad69a8d 100644 --- a/doc/misc/mh-e.texi +++ b/doc/misc/mh-e.texi @@ -793,7 +793,7 @@ Reading Mail Tour @cartouche @smallexample - 3 t08/24 root received fax files on Wed Aug 24 11:00:13 PDT 1 + 3 t08/24 root received fax files on Wed Aug 24 11:00:13 -0700 1 # 4+t08/24 To:wohler Test< "08 April 1991, 17:32:09 EST" +==> "08 Apr 1991 17:32:09 -0500" (sc-mail-field "subject") ==> "Better get out your asbestos suit" 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 @@ diary-outlook-format-1 (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. commit 523261b454058d0b28df2c3de1eab55fe378aa69 Author: Paul Eggert Date: Thu Dec 29 19:16:09 2022 -0800 Document calc-time-zone abbreviation obsolescence * doc/misc/calc.texi (Time Zones): Document that alphabetic time zone abbreviations are obsolescent and in some cases wrong. diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index ef9990c057a..e5bac25cac8 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -17341,8 +17341,12 @@ Time Zones For example @samp{tzone(PST) = tzone(8)} and @samp{tzone(pdt) = tzone(7)} (for Pacific standard and daylight saving times, respectively). -North American and European time zone names are defined as follows; -note that for each time zone there is one name for standard time, +North American and European time zone names are defined as follows. +These names are obsolescent and new code should not rely on them: +the @samp{YST}-related names have disagreed with time in Yukon since 1973, +and other names could well become confusing or wrong in the future +as countries change their time zone rules. +For each time zone there is one name for standard time, another for daylight saving time, and a third for ``generalized'' time in which the daylight saving adjustment is computed from context. @@ -17364,7 +17368,7 @@ Time Zones you must modify the Lisp variable @code{math-tzone-names}. This is a list of lists describing the different time zone names; its structure is best explained by an example. The three entries for -Pacific Time look like this: +circa-2022 US Pacific Time look like this: @smallexample @group commit 007e66bccb2cb8382158e5e24727fd1b4478cd69 Author: Paul Eggert Date: Thu Dec 29 19:16:09 2022 -0800 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". 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 @@ sunrise-sunset "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 commit bc4cbbcc57a56a23c64576c8c23ecf6afb1c747b Author: Paul Eggert Date: Thu Dec 29 19:16:09 2022 -0800 Add nndiary-headers obsolescence comment * lisp/gnus/nndiary.el (nndiary-headers): Add comment about alphabetic time zone names being obsolescent. 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 @@ nndiary-headers ;; 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 () commit d11e34ce76aac8680337f247419657e042e4cf34 Author: Paul Eggert Date: Thu Dec 29 21:27:45 2022 -0800 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. 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 @@ rmail-nuke-pinhead-header "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. commit 73769dc2b872441eb0b8565e1090e97fc0b5d521 Author: Paul Eggert Date: Thu Dec 29 19:16:09 2022 -0800 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. 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 @@ calendar-standard-time-zone-name (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 @@ calendar-daylight-time-zone-name (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) commit 8c13e8497821881b5197a1717e9e53b9991859d0 Author: LdBeth Date: Thu Dec 29 19:16:09 2022 -0800 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 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 @@ newsticker--decode-rfc822-date ":\\([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 @@ newsticker--decode-rfc822-date (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" commit 644c71d6788d268cb065bd9317efb8a16a8236e6 (refs/remotes/origin/emacs-29) Author: Roland Winkler Date: Thu Dec 29 23:31:08 2022 -0600 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) 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 @@ bibtex-beginning-of-entry 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 () commit ab38abfdf75e091b9970dd3ba977aaa1b6067cc3 Author: Roland Winkler Date: Thu Dec 29 23:22:48 2022 -0600 lisp/textmodes/bibtex.el: Treat $ as punctuation in BibTeX fields (bug#50202) 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 @@ bibtex-font-lock-syntactic-keywords 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 @@ bibtex-mode (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 commit d086cd6cf877c6ca7af6712f9b79b52dd0caa934 Author: Gregory Heytings Date: Thu Dec 29 22:41:58 2022 +0000 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. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 37434994548..5397489e44f 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -3057,17 +3057,23 @@ Attribute Functions for newly created frames; they will effectively override the attribute values specified by @code{defface}. If @var{frame} is @code{nil}, this function sets the attributes for all existing frames, as well as -for newly created frames. However, if you want to @emph{reset} the -value of an attribute to @code{unspecified} in a way that also affects -newly created frames, you @emph{must} explicitly call this function -with @var{frame} set to @code{t} and the value of the attribute set to -@code{unspecified} (@emph{not} @code{nil}!@:), in addition to the call -with @var{frame} set to @code{nil}. This is because the default -attributes for newly created frames are merged with the face's spec in -@code{defface} when a new frame is created, and so having -@code{unspecified} in the default attributes for new frames will be -unable to override @code{defface}; the special call to this function -as described above will arrange for @code{defface} to be overridden. +for newly created frames. + +To @emph{unset} the value of an attribute, that is, to indicate that +the face doesn't by itself specify a value for the attribute, the +special value @code{unspecified} (@emph{not} @code{nil}!@:) must be +used. + +Note that the attribute-value pairs are evaluated in the order they +are specified, except the @code{:family} and @code{:foundry} +attributes, which are evaluated first. This means both that only the +last value of a given attribute will be used, and that in some cases a +different order will give different results. For example, when +@code{:weight} is placed before @code{:font}, the weight value is +applied to the current font of the face, and might be rounded to the +closest available weight of that font, whereas when @code{:font} is +placed before @code{:weight} the weight value is applied to the +specified font. @end defun The following commands and functions mostly provide compatibility 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 @@ set-face-attribute 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' commit dafa6d6badd6552b6f88ba884e3e5dadb362380d Author: Gregory Heytings Date: Mon Dec 19 22:18:22 2022 +0000 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. 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 @@ pcomplete-arg 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. commit beed746f944aba2559192c057ea294233876e99d Author: Gregory Heytings Date: Thu Dec 29 21:50:26 2022 +0000 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. 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 @@ completion--do-completion (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)))))))) commit 7ccb88486eb289a1a59dcb01ae604fc6c31ea804 Author: Eli Zaretskii Date: Thu Dec 29 22:04:44 2022 +0200 ; * etc/DEBUG: Update MS-Windows specifics for GDB 13 and later. diff --git a/etc/DEBUG b/etc/DEBUG index ef9160a2090..ee134999dac 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -277,8 +277,13 @@ GDB: If you do this, then typing C-c or C-BREAK into the console window through which you interact with GDB will stop Emacs and return control to the debugger, no matter if Emacs displays GUI or text-mode frames. -This is the only reliable alternative on MS-Windows to get control to -the debugger, besides setting breakpoints in advance. +With GDB versions before 13.1, this is the only reliable alternative +on MS-Windows to get control to the debugger, besides setting +breakpoints in advance. GDB 13.1 changed the way C-c and C-BREAK are +handled on Windows, so with those newer versions, you don't need the +"set new-console 1" setting to be able to interrupt Emacs by typing +C-c or C-BREAK into the console window from which you started Emacs +and where you interact with GDB. ** Examining Lisp object values. commit 558b59d81b938fc434e62523106360b9704c88e2 Author: Yuan Fu Date: Thu Dec 29 11:52:06 2022 -0800 Add color fontification in css-ts-mode (bug#60405) * lisp/textmodes/css-mode.el (css-ts-mode): Add color fontification and syntax-propertize-function. 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 @@ css-ts-mode :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) commit a96a7c811517063053a1dffc30ac94deffad503f Author: Yuan Fu Date: Thu Dec 29 11:41:26 2022 -0800 ; * lisp/textmodes/css-mode.el (css-ts-mode): Fix imenu setup. 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 @@ css-ts-mode (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 commit 793641a3db5e14cd2eeb251d2f473b1035192560 Author: Yuan Fu Date: Thu Dec 29 11:34:28 2022 -0800 ; * lisp/progmodes/js.el: Fix byte-compile warning. 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 @@ electric-layout-rules (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 @@ js--treesit-property-not-function-p "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 _) commit 91ae9f3d12885373d38c3e8d693f7dc210f9d471 Author: Theodor Thornhill Date: Thu Dec 29 20:19:46 2022 +0100 Allow for indentation in prog-fill-reindent-defun (bug#60322) * lisp/progmodes/prog-mode.el (prog-fill-reindent-defun): Adjust regexp. 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 @@ prog-fill-reindent-defun (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))) commit 0aea1cf8190aa804a0d11a67b4a3cb4b715ae82d Author: Juri Linkov Date: Thu Dec 29 19:45:12 2022 +0200 * 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. 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 @@ hi-lock--regexps-at-point (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 commit 60418e6f09c67924e3e05eb4948e109d8f7c4073 Author: Juri Linkov Date: Thu Dec 29 19:41:41 2022 +0200 * src/keyboard.c (echo_add_key): Use recently rebound C-h key C-q (bug#60249) diff --git a/src/keyboard.c b/src/keyboard.c index d68b50428a9..7bf89ac7d4b 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -503,11 +503,10 @@ echo_add_key (Lisp_Object c) if ((NILP (echo_string) || SCHARS (echo_string) == 0) && help_char_p (c)) { - AUTO_STRING (str, " (Type ? for further options, q for quick help)"); + AUTO_STRING (str, " (Type ? for further options, C-q for quick help)"); AUTO_LIST2 (props, Qface, Qhelp_key_binding); Fadd_text_properties (make_fixnum (7), make_fixnum (8), props, str); - Fadd_text_properties (make_fixnum (30), make_fixnum (31), props, -str); + Fadd_text_properties (make_fixnum (30), make_fixnum (33), props, str); new_string = concat2 (new_string, str); } commit 753b7a1cff6b8ce2367a94d27b615ac31f1067ba Author: Mattias Engdegård Date: Thu Dec 29 17:38:02 2022 +0100 * etc/NEWS: Mention some recently added byte-compiler warnings diff --git a/etc/NEWS b/etc/NEWS index 83aa81eb4b8..50937f5e962 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -117,6 +117,53 @@ point is not in a comment or a string. It is by default bound to * Lisp Changes in Emacs 30.1 +** New or changed byte-compilation warnings + +--- +*** Warn about empty bodies for more special forms and macros. +The compiler now warns about an empty body argument to 'when', +'unless', 'ignore-error' and 'with-suppressed-warnings' in addition to +the existing warnings for 'let' and 'let*'. Example: + + (when (> x 2)) + +This warning can be suppressed using 'with-suppressed-warnings' with +the warning name 'empty-body'. + +--- +*** Warn about quoted error names in 'condition-case' and 'ignore-error'. +The compiler now warns about quoted condition (error) names +in 'condition-case' and 'ignore-error'. Example: + + (condition-case nil + (/ x y) + ('arith-error "division by zero")) + +Quoting them adds the error name 'quote' to those handled or ignored +respectively, which was probably not intended. + +--- +*** Warn about comparison with literal constants without defined identity. +The compiler now warns about comparisons by identity with a literal +string, cons, vector, record, function, large integer or float as this +may not match any value at all. Example: + + (eq x "hello") + +Only literals for symbols and small integers (fixnums), including +characters, are guaranteed to have a consistent (unique) identity. +This warning applies to 'eq', 'eql', 'memq', 'memql', 'assq', 'rassq', +'remq' and 'delq'. + +To compare by (structural) value, use 'equal', 'member', 'assoc', +'rassoc', 'remove' or 'delete' instead. Floats and bignums can also +be compared using 'eql', '=' and 'memql'. Function literals cannot be +compared reliably at all. + +This warning can be suppressed using 'with-suppressed-warnings' with +the warning name 'suspicious'. + + * Changes in Emacs 30.1 on Non-Free Operating Systems commit 29d23b7fa00ed8263baa060d487b526d51fa6986 Author: Mattias Engdegård Date: Thu Dec 29 17:00:01 2022 +0100 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. 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 @@ macroexp--expand-all (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)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index eec66c9585a..5c61ca10b9c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1440,14 +1440,14 @@ bytecomp-test--with-suppressed-warnings (let ((_ 1)) )) '((empty-body let)) - "Warning: Empty let body") + "Warning: `let' with empty body") (test-suppression '(defun zot () (let* ((_ 1)) )) '((empty-body let*)) - "Warning: Empty let\\* body") + "Warning: `let\\*' with empty body") (test-suppression '(defun zot (x) commit 314cbef84944145e2160736ce32812403ed99cd9 Author: Mattias Engdegård Date: Thu Dec 29 13:15:20 2022 +0100 ; Suppress empty-body warnings in cedet/semantic 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 @@ semantic-lex-spp-merge-header 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 @@ define-lex-analyzer (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) commit 7c63b632e4e2241a28f08015cc981a72e18d7867 Author: Mattias Engdegård Date: Thu Dec 29 13:01:47 2022 +0100 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. 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 @@ with-suppressed-warnings `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 @@ byte-compile-warning-types '(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 @@ byte-compile-warnings 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 @@ byte-compile-initial-macro-environment ;; 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 @@ macroexp--expand-all (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 @@ when 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 @@ ignore-error 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. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 61f4998f6ba..eec66c9585a 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1433,7 +1433,50 @@ bytecomp-test--with-suppressed-warnings (set-buffer (get-buffer-create "foo")) nil)) '((suspicious set-buffer)) - "Warning: Use .with-current-buffer. rather than")) + "Warning: Use .with-current-buffer. rather than") + + (test-suppression + '(defun zot () + (let ((_ 1)) + )) + '((empty-body let)) + "Warning: Empty let body") + + (test-suppression + '(defun zot () + (let* ((_ 1)) + )) + '((empty-body let*)) + "Warning: Empty let\\* body") + + (test-suppression + '(defun zot (x) + (when x + )) + '((empty-body when)) + "Warning: `when' with empty body") + + (test-suppression + '(defun zot (x) + (unless x + )) + '((empty-body unless)) + "Warning: `unless' with empty body") + + (test-suppression + '(defun zot (x) + (ignore-error arith-error + )) + '((empty-body ignore-error)) + "Warning: `ignore-error' with empty body") + + (test-suppression + '(defun zot (x) + (with-suppressed-warnings ((suspicious eq)) + )) + '((empty-body with-suppressed-warnings)) + "Warning: `with-suppressed-warnings' with empty body") + ) (ert-deftest bytecomp-tests--not-writable-directory () "Test that byte compilation works if the output directory isn't commit 706ed85285515e7047e16608815c1d02d4907b07 Author: Eli Zaretskii Date: Thu Dec 29 13:52:09 2022 +0200 Avoid assertion violations in treesit.c with --enable-checking * src/treesit.c (Ftreesit_node_first_child_for_pos) (Ftreesit_node_descendant_for_range): Check validity of buffer positions before converting them to byte-positions, to avoid assertion violations in buf_charpos_to_bytepos. diff --git a/src/treesit.c b/src/treesit.c index 6570ada1d92..eaa563a54c4 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2070,12 +2070,11 @@ DEFUN ("treesit-node-first-child-for-pos", struct buffer *buf = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer); ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg; - ptrdiff_t byte_pos = buf_charpos_to_bytepos (buf, XFIXNUM (pos)); treesit_check_position (pos, buf); - treesit_initialize (); + ptrdiff_t byte_pos = buf_charpos_to_bytepos (buf, XFIXNUM (pos)); TSNode treesit_node = XTS_NODE (node)->node; TSNode child; if (NILP (named)) @@ -2106,14 +2105,14 @@ DEFUN ("treesit-node-descendant-for-range", struct buffer *buf = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer); ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg; - ptrdiff_t byte_beg = buf_charpos_to_bytepos (buf, XFIXNUM (beg)); - ptrdiff_t byte_end = buf_charpos_to_bytepos (buf, XFIXNUM (end)); treesit_check_position (beg, buf); treesit_check_position (end, buf); treesit_initialize (); + ptrdiff_t byte_beg = buf_charpos_to_bytepos (buf, XFIXNUM (beg)); + ptrdiff_t byte_end = buf_charpos_to_bytepos (buf, XFIXNUM (end)); TSNode treesit_node = XTS_NODE (node)->node; TSNode child; if (NILP (named)) commit 2de25accaf31aef643557ec476041c770fc7ac15 Author: Mattias Engdegård Date: Thu Dec 29 12:00:50 2022 +0100 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. 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 @@ byte-compile-condition-case (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)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 0d62283c04a..61f4998f6ba 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -923,6 +923,11 @@ bytecomp-warn-wide-docstring/defvar `(defvar foo t ,bytecomp-tests--docstring))) (ert-deftest bytecomp-warn-quoted-condition () + (bytecomp--with-warning-test + "Warning: `condition-case' condition should not be quoted: 'arith-error" + '(condition-case nil + (abc) + ('arith-error "ugh"))) (bytecomp--with-warning-test "Warning: `ignore-error' condition argument should not be quoted: 'error" '(ignore-error 'error (abc)))) commit 1480865e641b06d570f5ab56011f8e3e5481da7d Author: Mattias Engdegård Date: Wed Dec 28 14:40:19 2022 +0100 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. 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 @@ ignore-error "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. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 47200de7a02..0d62283c04a 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -922,6 +922,11 @@ bytecomp-warn-wide-docstring/defvar (bytecomp--with-warning-test "defvar.*foo.*wider than.*characters" `(defvar foo t ,bytecomp-tests--docstring))) +(ert-deftest bytecomp-warn-quoted-condition () + (bytecomp--with-warning-test + "Warning: `ignore-error' condition argument should not be quoted: 'error" + '(ignore-error 'error (abc)))) + (ert-deftest bytecomp-warn-dodgy-args-eq () (dolist (fn '(eq eql)) (cl-flet ((msg (type arg) commit a6db8464e150c49724c71c5969b97f205ee2dec5 Author: Mattias Engdegård Date: Wed Dec 28 13:25:49 2022 +0100 ; Fix byte-compilation warnings in admin/*.el diff --git a/admin/admin.el b/admin/admin.el index 6a67f172e2c..12c9c10b1a5 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -843,8 +843,11 @@ admin--require-external-package (package-install pkg) (require pkg nil t)))) +(declare-function org-html-export-as-html "ox-html.el") (defvar org-html-postamble) (defvar org-html-mathjax-template) +(defvar htmlize-output-type) + (defun make-news-html-file (root version) "Convert the NEWS file into an HTML file." (interactive (let ((root diff --git a/admin/find-gc.el b/admin/find-gc.el index 1c3c419c563..6b0e2a3d803 100644 --- a/admin/find-gc.el +++ b/admin/find-gc.el @@ -100,7 +100,7 @@ trace-unsafe -(defun trace-call-tree (&optional ignored) +(defun trace-call-tree (&optional _ignored) (message "Setting up directories...") (setq find-gc-subrs-called nil) (let ((case-fold-search nil) diff --git a/admin/gitmerge.el b/admin/gitmerge.el index ddd3e184424..1ff8137e154 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -293,7 +293,7 @@ gitmerge-resolve "Try to resolve conflicts in FILE with smerge. Returns non-nil if conflicts remain." (unless (file-exists-p file) (error "Gitmerge-resolve: Can't find %s" file)) - (with-demoted-errors + (with-demoted-errors "Error: %S" (let ((exists (find-buffer-visiting file))) (with-current-buffer (let ((enable-local-variables :safe) (enable-local-eval nil)) commit 1a88a28ace24c8b4fb1e4780948b50dd37ada539 Author: Mattias Engdegård Date: Wed Dec 28 13:10:35 2022 +0100 * lisp/subr.el (with-demoted-errors): Better message and location. 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 @@ with-demoted-errors (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 @@ with-demoted-errors (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. commit 38c35bf0f6a938001dfecbe439addf8fb62897c6 Author: Yuan Fu Date: Thu Dec 29 01:28:25 2022 -0800 Clean up treesit-default-defun-skipper and add comments * lisp/treesit.el (treesit-default-defun-skipper): Clean up, fix some small issue, add comment. 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 @@ treesit-default-defun-skipper 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 commit 9371d488be62a37788b499a7e44b1f5db158e212 Merge: 9d814bea460 784e509bded Author: Eli Zaretskii Date: Thu Dec 29 11:11:58 2022 +0200 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/emacs into emacs-29 commit 9d814bea4600ac28dcdbf9caf386467551d7d9be Author: Richard Hansen Date: Sun Dec 18 00:24:16 2022 -0500 ; whitespace.el: Use the new 'ert-with-buffer-selected' in tests Commit 286c48137f69fa96b80d197da90c69a42df604a3 added a new `ert-with-test-buffer-selected' macro. Use that macro in 'whitespace-mode' tests to avoid code duplication. (Bug#60332) * test/lisp/whitespace-tests.el (whitespace--with-buffer-selected): Macro deleted. (whitespace-tests--indirect-clone-breaks-base-markers) (whitespace-tests--indirect-clone-markers) (whitespace-tests--regular-clone-markers): Use 'ert-with-buffer-selected'. diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el index 12f6cb99a23..d72748cd0c9 100644 --- a/test/lisp/whitespace-tests.el +++ b/test/lisp/whitespace-tests.el @@ -42,13 +42,6 @@ whitespace-tests--with-test-buffer '(whitespace-mode 1)) ,@body))) -(defmacro whitespace--with-buffer-selected (buffer-or-name &rest body) - (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)))) - (defun whitespace-tests--faceup (&rest lines) "Convenience wrapper around `faceup-test-font-lock-buffer'. Returns non-nil if the concatenated LINES match the current @@ -354,7 +347,7 @@ whitespace-tests--indirect-clone-breaks-base-markers (indirect (clone-indirect-buffer (buffer-name) nil))) (should (eq (marker-buffer whitespace-bob-marker) base)) (should (eq (marker-buffer whitespace-eob-marker) base)) - (whitespace--with-buffer-selected indirect + (ert-with-buffer-selected indirect ;; Mutate the indirect buffer to update its bob/eob markers. (execute-kbd-macro (kbd "z RET M-< a"))) ;; With Bug#59618, the above mutation would cause the base @@ -382,7 +375,7 @@ whitespace-tests--indirect-clone-markers ;; because the buffer should only be killed on success. (indirect (clone-indirect-buffer nil nil))) (whitespace-tests--check-markers base 2 4) - (whitespace--with-buffer-selected indirect + (ert-with-buffer-selected indirect (whitespace-tests--check-markers indirect 2 4) ;; Mutate the buffer to trigger `after-change-functions' and ;; thus `whitespace--update-bob-eob'. @@ -405,7 +398,7 @@ whitespace-tests--regular-clone-markers ;; the buffer should only be killed on success. (clone (clone-buffer))) (whitespace-tests--check-markers orig 2 4) - (whitespace--with-buffer-selected clone + (ert-with-buffer-selected clone (whitespace-tests--check-markers clone 2 4) (execute-kbd-macro (kbd "z RET M-< a")) (whitespace-tests--check-markers clone 1 8)) commit 784e509bded0fe41dd9908022a92c54ac8c21a2c Author: Yuan Fu Date: Thu Dec 29 00:58:50 2022 -0800 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. 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 @@ c-ts-mode--indent-styles `(((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 @@ c-ts-mode--indent-styles ((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 @@ c-ts-mode--set-indent-style ('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 commit d9d90666f545dc25be63c1b16c030ce1aa96510e Merge: dce6791e993 909091d7578 Author: Stefan Kangas Date: Thu Dec 29 06:30:09 2022 +0100 Merge from origin/emacs-29 909091d7578 ; Minor cleanup for tree-sitter font-lock rules in js-ts-... e78e69b3318 Clean up font-lock rules in js-ts-mode 0a61e4e2b71 ; * doc/lispref/parsing.texi (Using Parser): Minor improv... 398ed75c276 ; * lisp/progmodes/c-ts-mode.el (c-ts-mode--fill-paragrap... 19b8733aa27 Fix syntax for < and > in c++-ts-mode (bug#60351) f509246ba12 Call tree-sitter parser notifier on the first parse ec6feeaa191 Fix tree-sitter parser notifier recursion commit 909091d7578b7225601b202fb9257dedae879e9a Author: Yuan Fu Date: Wed Dec 28 16:57:21 2022 -0800 ; Minor cleanup for tree-sitter font-lock rules in js-ts-mode * lisp/progmodes/js.el (js--treesit-font-lock-settings): Minor cleanup. 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 @@ js--treesit-font-lock-settings (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 @@ js--treesit-font-lock-settings :language 'javascript :feature 'jsx - `( - (jsx_opening_element + '((jsx_opening_element [(nested_identifier (identifier)) (identifier)] @font-lock-function-name-face) @@ -3588,7 +3584,7 @@ js--treesit-font-lock-settings :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))) commit e78e69b33189c653d1588b810283969ac3cca137 Author: Yuan Fu Date: Wed Dec 28 16:52:47 2022 -0800 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. 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 @@ js--treesit-font-lock-settings [(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 @@ js--treesit-font-lock-settings 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 @@ js--treesit-font-lock-settings ((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 @@ js--fontify-template-string (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 @@ 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) commit 0a61e4e2b7189679df8ab3617e174b8b36afcf80 Author: Yuan Fu Date: Wed Dec 28 15:54:51 2022 -0800 ; * doc/lispref/parsing.texi (Using Parser): Minor improvement. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index b7199f071bc..86b3bd54e7c 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -505,7 +505,9 @@ Using Parser Every time a parser reparses a buffer, it compares the old and new parse-tree, computes the ranges in which nodes have changed, and -passes the ranges to notifier functions. +passes the ranges to notifier functions. Note that the initial parse +is also considered a ``change'', so notifier functions are called on +the initial parse, with range being the whole buffer. @defun treesit-parser-add-notifier parser function This function adds @var{function} to @var{parser}'s list of commit 398ed75c276d7e4de583a9de750a777173252e77 Author: Yuan Fu Date: Wed Dec 28 15:47:14 2022 -0800 ; * lisp/progmodes/c-ts-mode.el (c-ts-mode--fill-paragraph): Fix. 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 @@ c-ts-mode--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 @@ c-ts-mode-comment-setup (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'. commit 19b8733aa27719e0aa60fad23a45a7f89d68b88d Author: Yuan Fu Date: Wed Dec 28 15:44:26 2022 -0800 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. 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 @@ c-ts-mode-indent-style (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 @@ c-ts-mode--syntax-table 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 @@ c-ts-mode (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)) commit f509246ba12ac791291f586340622871cdfc18ed Author: Yuan Fu Date: Wed Dec 28 15:30:10 2022 -0800 Call tree-sitter parser notifier on the first parse * src/treesit.c (treesit_call_after_change_functions): Handle NULL old_tree. (treesit_ensure_parsed): Remove check for NULL tree. diff --git a/src/treesit.c b/src/treesit.c index e226df263c1..6570ada1d92 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -933,11 +933,24 @@ treesit_check_buffer_size (struct buffer *buffer) treesit_call_after_change_functions (TSTree *old_tree, TSTree *new_tree, Lisp_Object parser) { - uint32_t len; - TSRange *ranges = ts_tree_get_changed_ranges (old_tree, new_tree, &len); + /* If the old_tree is NULL, meaning this is the first parse, the + changed range is the whole buffer. */ + Lisp_Object lisp_ranges; struct buffer *buf = XBUFFER (XTS_PARSER (parser)->buffer); - Lisp_Object lisp_ranges = treesit_make_ranges (ranges, len, buf); - xfree (ranges); + if (old_tree) + { + uint32_t len; + TSRange *ranges = ts_tree_get_changed_ranges (old_tree, new_tree, &len); + lisp_ranges = treesit_make_ranges (ranges, len, buf); + xfree (ranges); + } + else + { + struct buffer *oldbuf = current_buffer; + set_buffer_internal (buf); + lisp_ranges = Fcons (Fcons (Fpoint_min (), Fpoint_max ()), Qnil); + set_buffer_internal (oldbuf); + } specpdl_ref count = SPECPDL_INDEX (); @@ -996,11 +1009,8 @@ treesit_ensure_parsed (Lisp_Object parser) treesit_ensure_parsed again, it returns early and do not recursively call the after change functions again. (ref:notifier-inside-ensure-parsed) */ - if (tree != NULL) - { - treesit_call_after_change_functions (tree, new_tree, parser); - ts_tree_delete (tree); - } + treesit_call_after_change_functions (tree, new_tree, parser); + ts_tree_delete (tree); } /* This is the read function provided to tree-sitter to read from a commit ec6feeaa19117deb0d60e97ad814b87ecbb7fa99 Author: Yuan Fu Date: Wed Dec 28 15:19:34 2022 -0800 Fix tree-sitter parser notifier recursion See the comment for detail. * src/treesit.c (treesit_ensure_parsed): Move the need_reparse short circuit to the very beginning. Move the call to treesit_call_after_change_functions to the very end. diff --git a/src/treesit.c b/src/treesit.c index 813d4222f98..e226df263c1 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -955,6 +955,11 @@ treesit_call_after_change_functions (TSTree *old_tree, TSTree *new_tree, static void treesit_ensure_parsed (Lisp_Object parser) { + /* Make sure this comes before everything else, see comment + (ref:notifier-inside-ensure-parsed) for more detail. */ + if (!XTS_PARSER (parser)->need_reparse) + return; + struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer); /* Before we parse, catch up with the narrowing situation. */ @@ -963,8 +968,6 @@ treesit_ensure_parsed (Lisp_Object parser) because it might set the flag to true. */ treesit_sync_visible_region (parser); - if (!XTS_PARSER (parser)->need_reparse) - return; TSParser *treesit_parser = XTS_PARSER (parser)->parser; TSTree *tree = XTS_PARSER (parser)->tree; TSInput input = XTS_PARSER (parser)->input; @@ -984,14 +987,20 @@ treesit_ensure_parsed (Lisp_Object parser) xsignal1 (Qtreesit_parse_error, buf); } + XTS_PARSER (parser)->tree = new_tree; + XTS_PARSER (parser)->need_reparse = false; + + /* After-change functions should run at the very end, most crucially + after need_reparse is set to false, this way if the function + calls some tree-sitter function which invokes + treesit_ensure_parsed again, it returns early and do not + recursively call the after change functions again. + (ref:notifier-inside-ensure-parsed) */ if (tree != NULL) { treesit_call_after_change_functions (tree, new_tree, parser); ts_tree_delete (tree); } - - XTS_PARSER (parser)->tree = new_tree; - XTS_PARSER (parser)->need_reparse = false; } /* This is the read function provided to tree-sitter to read from a commit dce6791e9934d029ffae45793a5d05096346be0c Merge: 7e98b8a0fa6 db96b1282f9 Author: Stefan Kangas Date: Wed Dec 28 21:40:59 2022 +0100 Merge from origin/emacs-29 db96b1282f9 * lisp/help.el: Use 'C-h C-q' to toggle 'help-quick' wind... 489865c21e4 ; Improve markup of long key sequences d42c2668cf3 ; * etc/NEWS: Fix wording of a recently edited entry. 7a0eaee1980 * lisp/isearch.el: Small fixes. b69bffeec05 * lisp/vc/diff-mode.el (diff-minor-mode-prefix): Replace ... 9263847ab76 ; * etc/NEWS: Move the paragraph with 'C-u RET' closer to... 62fb2dc37da * doc/emacs/display.texi (Text Scale): Improve section ab... 70480d3b6b7 * lisp/repeat.el (repeat-echo-function): Suggest 'add-fun... fd48201ffe7 * lisp/tab-line.el (tab-line-cache-key-default): More cac... b1646602602 * etc/package-keyring.gpg: Update with new key c0be51389eb ; Yet another declare-function to avoid treesit-related w... 8676bec51de ; * lisp/treesit.el (treesit--simple-imenu-1): Doc fix; w... 2ddc480f441 Warn of absent networks module in ERC 19d00fab9aa Avoid "already compiled" warning in erc-compat 2d8f7b66bcc ; Fix one more treesit byte-compilation warning. 2d0a9214863 ; Avoid treesit-related byte-compiler warnings 8503b370be1 (python--treesit-settings): Remove duplicate matcher b464e6c490b Make last change of w32 GUI dialogs conditional and rever... eedc9d79aed Fix tree-sitter typos 248c13dcfe1 Update tree-sitter major modes to use the new Imenu facility b39dc7ab27a Add tree-sitter helper functions for Imenu ba1ddea9dab Fix treesit--things-around (bug#60355) 7512b9025a1 ; * lisp/treesit.el (treesit-traverse-parent): Remove alias. 5326b041982 Improve treesit-node-top-level and treesit-parent-until 637f5b164f2 ; Add "src" to the heuristic sub-directory heuristic 8ab6df0c9fd ; * lisp/epa-ks.el (epa-ks-do-key-to-fetch): Fix 'when' u... 2b55a48d3e3 * src/w32menu.c (simple_dialog_show): Use MB_YESNOCANCEL ... 8b8b7915679 ; Improve documentation of TAB/SPC indentation 624e3822110 ; Improve doc strings of some new faces 41f12e1019b ; * lisp/elide-head.el (elide-head): Doc fix to silence c... e3b4cd0ac1d ; * lisp/htmlfontify.el (hfy-text-p): Fix whitespace. 1b4dc4691c1 Fix htmlfontify.el command injection vulnerability. 1fe4b98b4d5 Improve support for Scheme R6RS and R7RS libraries (bug#5... 2347f37f677 ; * test/src/treesit-tests.el: remove dead store (bytecom... a6d961ae2fd Add a new tree-sitter query predicate 'pred' 835a80dcc48 ; Fix tree-sitter defun tests a14821d6151 Improve gnutls-min-prime-bits docstring b14bbd108e4 Improve handling of tab-bar height. 669160d47b2 ; * nt/INSTALL.W64: More fixes and updates. 26b2ec7cb8c Simplify last change (bug#60311) 082fc6e3088 Fix 'json-available-p' on MS-Windows 6c86faec29e loaddefs-gen: Group results by absolute file name d90d7d15f2f ; Fix vindexes in parsing.texi eb268728376 Fix imenu for c-ts-mode (bug#60296) 8f68b6497ee Clean up python-ts-mode font-lock features 28f26b11a1e Add comment indent and filling to other tree-sitter major... c6b02826450 ; Remove unused function in c-ts-mode 6e52a9fcadc ; * doc/lispref/modes.texi (Parser-based Font Lock): Mino... 2bcd1e9a99d ; * doc/lispref/parsing.texi (Retrieving Nodes): Add notice. 7c7950fe006 Add maintainer stub for tree-sitter files cf327766226 ; * doc/lispref/parsing.texi (Using Parser): Remove delet... # Conflicts: # etc/NEWS # lisp/progmodes/c-ts-mode.el # lisp/progmodes/typescript-ts-mode.el # lisp/treesit.el commit db96b1282f90ee40560f81e8b715fe785badbb6e Author: Juri Linkov Date: Wed Dec 28 20:48:40 2022 +0200 * 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. diff --git a/etc/NEWS b/etc/NEWS index 0d1ab998e83..d2e11e5adf4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1077,7 +1077,7 @@ the default candidate. *** New command 'help-quick' displays an overview of common commands. The command pops up a buffer at the bottom of the screen with a few helpful commands for various tasks. You can toggle the display using -'C-h q'. +'C-h C-q'. ** Emacs now comes with Org v9.6. See the file ORG-NEWS for user-visible changes in Org. 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 @@ help-map "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 @@ help-map "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 @@ help-quick ;; ... 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 @@ help-quit (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 @@ 'help ("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)" commit 489865c21e41b3f896ab2e57784b2f43dfb4829b Author: Eli Zaretskii Date: Wed Dec 28 20:33:58 2022 +0200 ; Improve markup of long key sequences * doc/emacs/display.texi (Text Scale): Avoid breaking key sequences between lines by using @w{..}. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index c45c8e6eadf..ce2dd0a78bc 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -920,8 +920,8 @@ Text Scale direction of the scrolling. The final key of these commands may be repeated without the leading -@kbd{C-x} and without the modifiers. For instance, @kbd{C-x C-= C-= C-=} -and @kbd{C-x C-= = =} increase the face height by three steps. Each +@kbd{C-x} and without the modifiers. For instance, @w{@kbd{C-x C-= C-= C-=}} +and @w{@kbd{C-x C-= = =}} increase the face height by three steps. Each step scales the text height by a factor of 1.2; to change this factor, customize the variable @code{text-scale-mode-step}. A numeric argument of 0 to the @code{text-scale-adjust} command restores the commit d42c2668cf387c21309eba084801f5c2e33ef442 Author: Eli Zaretskii Date: Wed Dec 28 20:30:56 2022 +0200 ; * etc/NEWS: Fix wording of a recently edited entry. diff --git a/etc/NEWS b/etc/NEWS index 13cf98b8895..0d1ab998e83 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1877,7 +1877,7 @@ to type 'M-RET' to insert the selected candidate to the buffer. +++ *** Choosing a completion with a prefix argument doesn't exit the minibuffer. This means that typing 'C-u RET' on a completion candidate in the -"*Completions*" buffer inserts the completion to the minibuffer, +"*Completions*" buffer inserts the completion into the minibuffer, but doesn't exit the minibuffer. +++ commit 7a0eaee198003aa6c1410107f051b45e0b786ce9 Author: Juri Linkov Date: Wed Dec 28 20:27:07 2022 +0200 * 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'. 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 @@ isearch-wrap-pause 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 @@ isearch-lax-whitespace 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 @@ isearch-forward-thing-at-point `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 @@ isearch-delete-char (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)) commit b69bffeec05302529209559dfb2ab24d9e711192 Author: Juri Linkov Date: Wed Dec 28 20:14:43 2022 +0200 * 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". 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 @@ diff-mode-menu (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'." commit 9263847ab769577c528036c6a58dff9b16f0828f Author: Juri Linkov Date: Wed Dec 28 20:09:46 2022 +0200 ; * etc/NEWS: Move the paragraph with 'C-u RET' closer to the related section. diff --git a/etc/NEWS b/etc/NEWS index 3060bba5e93..13cf98b8895 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1103,7 +1103,7 @@ in addition to the ellipsis. The default is nil, but in 'help-mode' it has the value 'insert' that inserts the buttons directly into the buffer, and you can use 'RET' to cycle outline visibility. When the value is 'in-margins', Outline Minor Mode uses the window margins -to hide/show buttons. +for buttons that hide/show outlines. ** Windows @@ -1874,6 +1874,12 @@ exit the minibuffer. These keys are also available for in-buffer completion, but they don't insert candidates automatically, you need to type 'M-RET' to insert the selected candidate to the buffer. ++++ +*** Choosing a completion with a prefix argument doesn't exit the minibuffer. +This means that typing 'C-u RET' on a completion candidate in the +"*Completions*" buffer inserts the completion to the minibuffer, +but doesn't exit the minibuffer. + +++ *** The "*Completions*" buffer can now be automatically selected. To enable this behavior, customize the user option @@ -1932,12 +1938,6 @@ candidate in the "*Completions*" buffer is highlighted with that face. The nil value disables this highlighting. The default is to highlight using the 'completions-highlight' face. -+++ -*** Choosing a completion with a prefix argument doesn't exit the minibuffer. -This means that typing 'C-u RET' on a completion candidate in the -"*Completions*" buffer inserts the completion to the minibuffer, -but doesn't exit the minibuffer. - +++ *** You can now define abbrevs for the minibuffer modes. 'minibuffer-mode-abbrev-table' and commit 62fb2dc37da2dfaebc3bd90ec404efbe91af2298 Author: Juri Linkov Date: Wed Dec 28 20:06:18 2022 +0200 * doc/emacs/display.texi (Text Scale): Improve section about repeating keys. Mention that it's possible to use repeating keys without the modifiers and copy an example from etc/NEWS. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index cf4f0414523..c45c8e6eadf 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -920,12 +920,12 @@ Text Scale direction of the scrolling. The final key of these commands may be repeated without the leading -@kbd{C-x}. For instance, @kbd{C-x C-= C-= C-=} increases the face -height by three steps. Each step scales the text height by a factor -of 1.2; to change this factor, customize the variable -@code{text-scale-mode-step}. A numeric argument of 0 -to the @code{text-scale-adjust} command restores the default height, -the same as typing @kbd{C-x C-0}. +@kbd{C-x} and without the modifiers. For instance, @kbd{C-x C-= C-= C-=} +and @kbd{C-x C-= = =} increase the face height by three steps. Each +step scales the text height by a factor of 1.2; to change this factor, +customize the variable @code{text-scale-mode-step}. A numeric +argument of 0 to the @code{text-scale-adjust} command restores the +default height, the same as typing @kbd{C-x C-0}. @cindex adjust global font size @findex global-text-scale-adjust commit 7e98b8a0fa67f51784024fac3199d774dfa77192 Author: Theodor Thornhill Date: Sun Dec 25 20:11:59 2022 +0100 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. diff --git a/etc/NEWS b/etc/NEWS index d17e1f1f89f..83aa81eb4b8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -44,6 +44,15 @@ example, as part of preview for iconified frames. * Editing Changes in Emacs 30.1 +** New helper 'transpose-sexps-function' +Emacs now can set this defvar to customize the behavior of the +'transpose-sexps' function. + +** New function 'treesit-transpose-sexps' +treesit.el now unconditionally sets 'transpose-sexps-function' for all +Tree-sitter modes. This functionality utilizes the new +'transpose-sexps-function'. + * Changes in Specialized Modes and Packages in Emacs 30.1 --- 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 @@ transpose-words (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 @@ transpose-sexps (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 @@ transpose-lines ;; 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 @@ transpose-subr (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 @@ treesit-search-forward-goto (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 @@ treesit-major-mode-setup ;; 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 commit 70480d3b6b7c1fe68a6a86dd2a7382c904ae1f30 Author: Juri Linkov Date: Wed Dec 28 19:58:44 2022 +0200 * lisp/repeat.el (repeat-echo-function): Suggest 'add-function' in docstring. (bug#60353) 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 @@ repeat-check-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" commit fd48201ffe77d20729002abea63e1b6d8502d186 Author: Juri Linkov Date: Wed Dec 28 19:47:52 2022 +0200 * 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. 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 @@ tab-line-tab-face-group (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 @@ tab-line-cache-key-function (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. commit 7dc24fb611c72697b7d34ba2abce0a0abc972a6b Merge: f9a22cf78d1 2608e5edcca Author: Stefan Kangas Date: Wed Dec 28 18:47:25 2022 +0100 ; Merge from origin/emacs-29 The following commit was skipped: 2608e5edcca ; Fix typos commit f9a22cf78d1a7f6472b09c3046c6a7f6984bc2d2 Author: Theodor Thornhill Date: Sun Dec 25 22:47:36 2022 +0100 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) 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 @@ prog-fill-reindent-defun (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) commit b1646602602f40b263b2bfd5c0e5e94e8bbd412a Author: Stefan Monnier Date: Wed Dec 28 12:19:02 2022 -0500 * etc/package-keyring.gpg: Update with new key diff --git a/etc/package-keyring.gpg b/etc/package-keyring.gpg index 490dee41a92..563acbb16b6 100644 Binary files a/etc/package-keyring.gpg and b/etc/package-keyring.gpg differ commit c0be51389eb27582614e1891fe0e3925ba09707e Author: Eli Zaretskii Date: Wed Dec 28 19:08:19 2022 +0200 ; Yet another declare-function to avoid treesit-related warning 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") commit 8676bec51de7433bf54d66bc1dfd819eb4fadeb3 Author: Stefan Kangas Date: Wed Dec 28 17:37:46 2022 +0100 ; * lisp/treesit.el (treesit--simple-imenu-1): Doc fix; wording. 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 @@ treesit--simple-imenu-1 `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) commit 2ddc480f4417775d6bf8ebcfc27b8cd7fa761a7d Author: F. Jason Park Date: Sun Dec 25 21:36:53 2022 -0800 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.) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 2ab2e908940..249b58c73d8 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -529,6 +529,16 @@ Modules @end table +@anchor{Required Modules} +@subheading Required Modules +@cindex required modules + +Note that some modules are essential to core IRC operations and thus +not listed above. You can nevertheless still remove these, but doing +so demands special precautions to avoid degrading the user experience. +At present, the only such module is @code{networks}, whose library ERC +always loads anyway. + @subheading Local Modules @cindex local modules @@ -1290,7 +1300,7 @@ auth-source how ERC and its modules conduct searches, especially when exploring a new context, such as channel keys. (Hint: in such situations, try temporarily setting the variable @code{auth-source-debug} to @code{t} -and checking @samp{*Messages*} periodically for insights into how +and checking @file{*Messages*} periodically for insights into how auth-source is operating.) Overall, though, ERC tries to be consistent in performing queries across various authentication contexts. Here's what to expect with respect to the @samp{host} diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 76439f1d068..b577047ebcb 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -39,6 +39,14 @@ anew. The pre-5.4 "disabled" behavior has been restored and will remain accessible for the foreseeable future, warts and all (e.g., with its often superfluous "/DIALED-HOST" suffixing always present). +** The 'networks' module is now quasi-required. +The 'networks' module is now all but required for everyday interactive +use. A default member of 'erc-modules' since ERC 5.3, 'networks' has +grown increasingly integral to core client operations over the years. +From now on, only the most essential operations will be officially +supported in its absence, and users will see a warning upon +entry-point invocation when it's not present. + ** Tighter auth-source integration with bigger changes on the horizon. The days of hit-and-miss auth-source queries are hopefully behind us. With the overhaul of the services module temporarily shelved and the @@ -111,7 +119,8 @@ and 'erc-backend'. The function 'erc-network' always returns non-nil in server and target buffers belonging to a successfully established IRC connection, even -after that connection has been closed. +after that connection has been closed. (Also see the note in the +section above about the 'networks' module basically being mandatory.) In 5.4, support for network symbols as keys was added for 'erc-autojoin-channels-alist'. This has been extended to include 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 @@ erc--server-reconnecting 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 @@ erc-open-network-stream (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 @@ erc-networks--rename-server-buffer (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 @@ networks ((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 @@ erc--register-connection (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 @@ erc-generate-new-buffer-name (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 @@ erc-format-target-and/or-network 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))))) diff --git a/test/lisp/erc/erc-scenarios-base-unstable.el b/test/lisp/erc/erc-scenarios-base-unstable.el index f5b8df6f4a1..e6db40c5efb 100644 --- a/test/lisp/erc/erc-scenarios-base-unstable.el +++ b/test/lisp/erc/erc-scenarios-base-unstable.el @@ -24,7 +24,7 @@ (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-scenarios-common))) -(eval-when-compile (require 'erc-join)) +(eval-when-compile (require 'erc-join) (require 'warnings)) ;; Not unstable, but stashed here for now @@ -132,4 +132,56 @@ erc-scenarios-base-aborted-reconnect (not (setq failed (zerop (cl-decf tries))))))) (should-not failed))) +;; The `erc-networks' library has slowly become a hard dependency of +;; the interactive client since its incorporation in 2006. But its +;; module, which was added in ERC 5.3 (2008) and thereafter loaded by +;; default, only became quasi-required in ERC 5.5 (2022). Despite +;; this, a basic connection should still always succeed, at least long +;; enough to warn users that their setup is abnormal. Of course, +;; third-party code intentionally omitting the module will have to +;; override various erc-server-*-functions to avoid operating in a +;; degraded state, which has likely been the case for a while. + +(ert-deftest erc-scenarios-networks-no-module () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "networks/no-module") + (erc-server-flood-penalty 0.1) + (erc-networks-mode-orig erc-networks-mode) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (erc-modules (remq 'networks erc-modules)) + (warning-suppress-log-types '((erc))) + (expect (erc-d-t-make-expecter))) + + (erc-networks-mode -1) + (ert-info ("Connect and retain dialed name") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (funcall expect 10 "Required module `networks' not loaded") + (funcall expect 10 "This server is in debug mode") + ;; Buffer not named after network + (should (string= (buffer-name) (format "127.0.0.1:%d" port))) + (erc-cmd-JOIN "#chan"))) + + (ert-info ("Join #chan, change nick, query op") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 20 "Even at thy teat thou") + (erc-cmd-NICK "dummy") + (funcall expect 10 "Your new nickname is dummy") + (erc-scenarios-common-say "/msg alice hi"))) + + (ert-info ("Switch to query and quit") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "alice")) + (funcall expect 20 "bye")) + + (with-current-buffer (format "127.0.0.1:%d" port) + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + (when erc-networks-mode-orig + (erc-networks-mode +1)))) + ;;; erc-scenarios-base-unstable.el ends here diff --git a/test/lisp/erc/resources/networks/no-module/basic.eld b/test/lisp/erc/resources/networks/no-module/basic.eld new file mode 100644 index 00000000000..f1bdbd1219f --- /dev/null +++ b/test/lisp/erc/resources/networks/no-module/basic.eld @@ -0,0 +1,44 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 1 "USER tester 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0") + (0.00 ":irc.foonet.org 003 tester :This server was created Mon, 12 Dec 2022 01:25:38 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0.00 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4") + (0.01 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing")) + +((mode 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #chan") + (0.03 ":tester!~u@z5d6jyn8pwxge.irc JOIN #chan")) + +((~nick 10 "NICK dummy") + (0.01 ":tester!~u@z5d6jyn8pwxge.irc NICK dummy")) + +((mode-1 10 "MODE #chan") + (0.01 ":irc.foonet.org 353 tester = #chan :@alice bob foonet tester") + (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.03 ":irc.foonet.org 324 tester #chan +nt") + (0.00 ":irc.foonet.org 329 tester #chan 1670808354") + (0.00 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!") + (0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!") + (0.03 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :alice: Forbear it therefore; give your cause to heaven.") + (0.01 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :bob: Even at thy teat thou hadst thy tyranny.")) + +((privmsg 10 "PRIVMSG alice :hi") + (0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG dummy :bye")) + +((quit 10 "QUIT :\2ERC\2") + (0.03 ":dummy!~u@z5d6jyn8pwxge.irc QUIT :Quit: \2ERC\2")) commit 19d00fab9aaf28dae6af5786f6e22b8558b10eea Author: F. Jason Park Date: Wed Dec 28 06:18:01 2022 -0800 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. 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 @@ erc-compat--29-auth-source-pass-search (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))) commit 2d8f7b66bcc5fa745ccf581253f59645e5e32490 Author: Eli Zaretskii Date: Wed Dec 28 16:48:22 2022 +0200 ; Fix one more treesit byte-compilation warning. 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 commit 2d0a92148630858754319bd067f8ce409231f176 Author: Eli Zaretskii Date: Wed Dec 28 16:41:58 2022 +0200 ; 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. 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 commit 8503b370be104c2ee40a34e38f69d144f19b0314 Author: Dmitry Gutov Date: Wed Dec 28 15:12:44 2022 +0200 (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'). 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 @@ python--treesit-settings :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))) commit b464e6c490be72e29619c5e101902ab3c3a2e474 Author: Eli Zaretskii Date: Wed Dec 28 15:10:39 2022 +0200 Make last change of w32 GUI dialogs conditional and reversible * src/w32term.c (syms_of_w32term) : New boolean variable. (w32_initialize): Fix query for visible system caret: 'bool' is a single-byte data type, whereas SystemParametersInfo wants a BOOL, which is a 32-bit int. * src/w32menu.c (simple_dialog_show): Show "Cancel" button only if 'w32-yes-no-dialog-show-cancel' is non-nil. * etc/NEWS: Announce the change. diff --git a/etc/NEWS b/etc/NEWS index c64db9973d2..3060bba5e93 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -4701,6 +4701,15 @@ where those APIs are available. When 'w32-use-native-image-API' is non-nil, Emacs on MS-Windows now has built-in support for displaying BMP images. +--- +*** GUI Yes/No dialogs now include a "Cancel" button. +The "Cancel" button is in addition to "Yes" and "No", and is intended +to allow users to quit the dialog, as an equivalent of C-g when Emacs +asks a yes/no question via the echo area. This is controlled by the +new variable 'w32-yes-no-dialog-show-cancel', by default t. Set it to +nil to get back the old behavior of showing a modal dialog with only +two buttons: "Yes" and "No". + ** Cygwin --- diff --git a/src/w32menu.c b/src/w32menu.c index c6d1efaf25b..5f06f4c4170 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -1091,7 +1091,10 @@ simple_dialog_show (struct frame *f, Lisp_Object contents, Lisp_Object header) /* We use MB_YESNOCANCEL to allow the user the equivalent of C-g when the Yes/No question is asked vya y-or-n-p or yes-or-no-p. */ - type = MB_YESNOCANCEL; + if (w32_yes_no_dialog_show_cancel) + type = MB_YESNOCANCEL; + else + type = MB_YESNO; /* Since we only handle Yes/No dialogs, and we already checked is_simple_dialog, we don't need to worry about checking contents diff --git a/src/w32term.c b/src/w32term.c index dff21489e5b..e40e4588fde 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -7696,6 +7696,7 @@ w32_init_main_thread (void) w32_initialize (void) { HANDLE shell; + BOOL caret; HRESULT (WINAPI * set_user_model) (const wchar_t * id); baud_rate = 19200; @@ -7732,8 +7733,9 @@ w32_initialize (void) /* Initialize w32_use_visible_system_caret based on whether a screen reader is in use. */ - if (!SystemParametersInfo (SPI_GETSCREENREADER, 0, - &w32_use_visible_system_caret, 0)) + if (SystemParametersInfo (SPI_GETSCREENREADER, 0, &caret, 0)) + w32_use_visible_system_caret = caret == TRUE; + else w32_use_visible_system_caret = 0; any_help_event_p = 0; @@ -7923,6 +7925,11 @@ syms_of_w32term (void) w32_use_native_image_api = 0; #endif + DEFVAR_BOOL ("w32-yes-no-dialog-show-cancel", + w32_yes_no_dialog_show_cancel, + doc: /* If non-nil, show Cancel button in MS-Windows GUI Yes/No dialogs. */); + w32_yes_no_dialog_show_cancel = 1; + /* FIXME: The following variable will be (hopefully) removed before Emacs 25.1 gets released. */ commit eedc9d79aed0c795b6f0687bc49993cb626c4039 Author: Yuan Fu Date: Wed Dec 28 00:32:37 2022 -0800 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. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index c5500b0b37e..b7199f071bc 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1737,7 +1737,6 @@ Tree-sitter major modes @item If @code{treesit-defun-name-function} is non-@code{nil}, it sets up add-log functions used by @code{add-log-current-defun}. -@end itemize @item If @code{treesit-simple-imenu-settings} (@pxref{Imenu}) is 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 @@ java-ts-mode ;; 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)) diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index ec686c69642..f7f0c96efa9 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -1046,7 +1046,7 @@ treesit-defun-navigation-nested-3 (ert-deftest treesit-defun-navigation-nested-4 () "Test defun navigation using Elixir. This tests bug#60355." - (skip-unless (treesit-language-available-p 'bash)) + (skip-unless (treesit-language-available-p 'elixir)) ;; Nested defun navigation (let ((treesit-defun-tactic 'nested) (pred (lambda (node) commit 248c13dcfe1b9618811a6fe67e967b25b1a8f139 Author: Yuan Fu Date: Tue Dec 27 20:57:12 2022 -0800 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. 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 @@ c-ts-mode--fontify-error (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 @@ c-ts-base-mode (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 @@ csharp-ts-mode--defun-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 -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 @@ csharp-ts-mode ( 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 @@ java-ts-mode--defun-name (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 @@ java-ts-mode ( 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 @@ js--treesit-defun-name "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 @@ 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 @@ json-ts-mode--defun-name 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 @@ json-ts-mode (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 @@ rust-ts-mode--font-lock-settings '((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 @@ rust-ts-mode--defun-name (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 @@ rust-ts-mode ( 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 @@ typescript-ts-base-mode ;; 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 @@ typescript-ts-base-mode "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 @@ css--treesit-defun-name (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 @@ css-ts-mode '((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 @@ toml-ts-mode--defun-name 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 @@ toml-ts-mode (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))) commit b39dc7ab27a696a8607ab859aeff3c71509231f5 Author: Yuan Fu Date: Tue Dec 27 20:37:29 2022 -0800 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. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 449529a4307..de17969566d 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -2841,6 +2841,35 @@ Imenu Setting this variable makes it buffer-local in the current buffer. @end defvar +If built with tree-sitter, Emacs can automatically generate an Imenu +index if the major mode sets relevant variables. + +@defvar treesit-simple-imenu-settings +This variable instructs Emacs how to generate Imenu indexes. It +should be a list of @w{(@var{category} @var{regexp} @var{pred} +@var{name-fn})}. + +@var{category} should be the name of a category, like "Function", +"Class", etc. @var{regexp} should be a regexp matching the type of +nodes that belong to @var{category}. @var{pred} should be either +@code{nil} or a function that takes a node as the argument. It should +return non-@code{nil} if the node is a valid node for @var{category}, +or @code{nil} if not. + +@var{category} could also be @code{nil}. In which case the entries +matched by @var{regexp} and @var{pred} are not grouped under +@var{category}. + +@var{name-fn} should be either @var{nil} or a function that takes a +defun node and returns the name of that defun, e.g., the function name +for a function definition. If @var{name-fn} is @var{nil}, +@code{treesit-defun-name} (@pxref{Tree-sitter major modes}) is used +instead. + +@code{treesit-major-mode-setup} (@pxref{Tree-sitter major modes}) +automatically sets up Imenu if this variable is non-@code{nil}. +@end defvar + @node Font Lock Mode @section Font Lock Mode @cindex Font Lock mode diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 63741b69c22..c5500b0b37e 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1738,6 +1738,11 @@ Tree-sitter major modes If @code{treesit-defun-name-function} is non-@code{nil}, it sets up add-log functions used by @code{add-log-current-defun}. @end itemize + +@item +If @code{treesit-simple-imenu-settings} (@pxref{Imenu}) is +non-@code{nil}, it sets up Imenu. +@end itemize @end defun For more information of these built-in tree-sitter features, 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 @@ treesit-add-log-current-defun (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 @@ treesit-major-mode-setup 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 @@ treesit-major-mode-setup ;; 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 commit ba1ddea9dabf51c9c6e463d667bcce0b48294453 Author: Yuan Fu Date: Tue Dec 27 17:02:03 2022 -0800 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. 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 @@ treesit--things-around 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 diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index b0fbed4b06c..ec686c69642 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -940,7 +940,28 @@ treesit--ert-defun-navigation-bash-program [999]} [110] " - "Javascript source for navigation test.") + "Bash source for navigation test.") + +(defvar treesit--ert-defun-navigation-elixir-program + "[100] +[101]def bar() do +[999]end +[102] +[103]defmodule Example do[0] +[999] @impl true +[104] [1]def bar() do[2] +[999] end[3] +[105] [4] +[106] [5]def baz() do[6] +[999] end[7] +[107] [8] +[999]end[9] +[108] +[109]def bar() do +[999]end +[110] +" + "Elixir source for navigation test.") (defvar treesit--ert-defun-navigation-nested-master ;; START PREV-BEG NEXT-END PREV-END NEXT-BEG @@ -1022,6 +1043,23 @@ treesit-defun-navigation-nested-3 treesit--ert-defun-navigation-bash-program treesit--ert-defun-navigation-nested-master))) +(ert-deftest treesit-defun-navigation-nested-4 () + "Test defun navigation using Elixir. +This tests bug#60355." + (skip-unless (treesit-language-available-p 'bash)) + ;; Nested defun navigation + (let ((treesit-defun-tactic 'nested) + (pred (lambda (node) + (member (treesit-node-text + (treesit-node-child-by-field-name node "target")) + '("def" "defmodule"))))) + (treesit--ert-test-defun-navigation + (lambda () + (treesit-parser-create 'elixir) + (setq-local treesit-defun-type-regexp `("call" . ,pred))) + treesit--ert-defun-navigation-elixir-program + treesit--ert-defun-navigation-nested-master))) + (ert-deftest treesit-defun-navigation-top-level () "Test top-level only defun navigation." (skip-unless (treesit-language-available-p 'python)) commit 7512b9025a152ea953918e1c0748b695b742b4b6 Author: Yuan Fu Date: Tue Dec 27 15:08:07 2022 -0800 ; * 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. 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 @@ treesit-parent-while 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." commit 5326b041982287514522f7f7930ff243d8d5cc70 Author: Yuan Fu Date: Tue Dec 27 15:07:03 2022 -0800 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. 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 @@ treesit-node-on (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 @@ treesit-node-text (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)) commit 637f5b164f2dedad45bff6d881231a8f014c65bc Author: Philip Kaludercic Date: Tue Dec 27 20:28:05 2022 +0100 ; Add "src" to the heuristic sub-directory heuristic * lisp/emacs-lisp/package-vc.el (package-vc--unpack): Check for "src" directories, next 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 @@ package-vc--unpack ;; 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))) commit 8ab6df0c9fdcef11170163e68248092ef2742801 Author: Philip Kaludercic Date: Tue Dec 27 13:46:40 2022 +0100 ; * lisp/epa-ks.el (epa-ks-do-key-to-fetch): Fix 'when' usage 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 @@ epa-ks-do-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) commit 2b55a48d3e3ccc9f5b1f8b6191d63360686d94d9 Author: Eli Zaretskii Date: Tue Dec 27 20:55:12 2022 +0200 * src/w32menu.c (simple_dialog_show): Use MB_YESNOCANCEL style. diff --git a/src/w32menu.c b/src/w32menu.c index b10239d5cc6..c6d1efaf25b 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -1073,7 +1073,10 @@ is_simple_dialog (Lisp_Object contents) if (NILP (Fstring_equal (name, other))) return false; - /* Check there are no more options. */ + /* Check there are no more options. + + (FIXME: Since we use MB_YESNOCANCEL, we could also consider + dialogs with 3 options: Yes/No/Cancel as "simple". */ options = XCDR (options); return !(CONSP (options)); } @@ -1085,7 +1088,10 @@ simple_dialog_show (struct frame *f, Lisp_Object contents, Lisp_Object header) UINT type; Lisp_Object lispy_answer = Qnil, temp = XCAR (contents); - type = MB_YESNO; + /* We use MB_YESNOCANCEL to allow the user the equivalent of C-g + when the Yes/No question is asked vya y-or-n-p or + yes-or-no-p. */ + type = MB_YESNOCANCEL; /* Since we only handle Yes/No dialogs, and we already checked is_simple_dialog, we don't need to worry about checking contents commit 8b8b79156798b4ffa791e9a9f0262a5ffdc867e8 Author: Eli Zaretskii Date: Tue Dec 27 20:23:16 2022 +0200 ; 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. 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 @@ indent-accumulate-tab-stops (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)) diff --git a/src/indent.c b/src/indent.c index 4671ccccf90..66edaff67de 100644 --- a/src/indent.c +++ b/src/indent.c @@ -887,6 +887,8 @@ DEFUN ("indent-to", Findent_to, Sindent_to, 1, 2, "NIndent to column: ", Optional second argument MINIMUM says always do at least MINIMUM spaces even if that goes past COLUMN; by default, MINIMUM is zero. +Whether this uses tabs or spaces depends on `indent-tabs-mode'. + The return value is the column where the insertion ends. */) (Lisp_Object column, Lisp_Object minimum) { commit 624e3822110a94ff6bee2ffaf43a04271b5d7305 Author: Eli Zaretskii Date: Tue Dec 27 18:59:59 2022 +0200 ; Improve doc strings of some new faces * lisp/font-lock.el (font-lock-punctuation-face) (font-lock-delimiter-face): Doc fix. 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 @@ font-lock-property-face (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 @@ font-lock-bracket-face (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") commit 41f12e1019bb96e424e27c2290b285bf7899de80 Author: Stefan Kangas Date: Tue Dec 27 17:28:08 2022 +0100 ; * lisp/elide-head.el (elide-head): Doc fix to silence checkdoc. 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 @@ elide-head-mode (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 commit e3b4cd0ac1df326034492bcf64a25d95a1ca7e38 Author: Eli Zaretskii Date: Tue Dec 27 16:10:42 2022 +0200 ; * lisp/htmlfontify.el (hfy-text-p): Fix whitespace. 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 @@ hfy-make-directory (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 commit 1b4dc4691c1f87fc970fbe568b43869a15ad0d4c Author: Xi Lu Date: Sat Dec 24 16:28:54 2022 +0800 Fix htmlfontify.el command injection vulnerability. * lisp/htmlfontify.el (hfy-text-p): Fix command injection vulnerability. (Bug#60295) 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 @@ hfy-make-directory (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))) commit 1fe4b98b4d5e0fe3d9964bd1789d3ee5be61dd2a Author: Rudolf Adamkovič Date: Sat Dec 24 01:00:32 2022 +0100 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. diff --git a/etc/NEWS b/etc/NEWS index 5b804b82b7f..c64db9973d2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3055,6 +3055,19 @@ name. This key is now bound to 'Buffer-menu-view-other-window', which will view this line's buffer in View mode in another window. +** Scheme mode + +--- +*** Auto-detection of Scheme library files. +Emacs now automatically enables the Scheme mode when opening R6RS +Scheme Library Source ('.sls') files and R7RS Scheme Library +Definition ('.sld') files. + +--- +*** Imenu members for R6RS and R7RS library members. +Imenu now lists the members directly nested in R6RS Scheme libraries +('library') and R7RS libraries ('define-library'). + * New Modes and Packages in Emacs 29.1 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 @@ auto-mode-alist ("\\.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 @@ 'scheme-mode-abbrev-table (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 @@ scheme-imenu-generic-expression (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")) commit 2347f37f677cc4c3acbc84c424c08dff369e9047 Author: Mattias Engdegård Date: Tue Dec 27 11:18:02 2022 +0100 ; * test/src/treesit-tests.el: remove dead store (bytecomp warning) diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 3770a4d01e5..b0fbed4b06c 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -252,9 +252,7 @@ treesit--ert-search-setup (setq parser (treesit-parser-create 'json)) (setq root (treesit-parser-root-node parser)) - (setq array (treesit-node-child root 0)) - ;; First bracket. - (setq cursor (treesit-node-child array 0))) + (setq array (treesit-node-child root 0))) ,@body))) (ert-deftest treesit-search-forward () commit a6d961ae2fd0eb93938f2afd932f4d3cb63a0412 Author: Yuan Fu Date: Mon Dec 26 17:16:59 2022 -0800 Add a new tree-sitter query predicate 'pred' I realized that using an arbitrary function as the predicate in queries is very helpful for some queries I'm writing for python and javascript, and presumably most other languages[1]. Granted, we can already filter out unwanted nodes by using a function instead of a face for the capture name, and (1) determine whether the captured node is valid and (2) fontify that node if it's valid. However, such approach is a bit more cumbersome and more importantly gets in the way of another potential use of the fontification queries: context extraction. For example, I could use the query for the 'variable' feature to get all the variables in a certain region. In this use-case, we want the filtering happen before returning the captured nodes. Besides, the change is relatively small and straightforward: most code are already there, I just need to add some boilerplate. [1] For a code like aa.bb(cc), we want bb to be in function face, because obviously its a function. But for aa.bb, we want bb to be in property face, because it's a property. In the AST, bb is always a property, the difference between the two cases is the enclosing node: in the first case, aa.bb is in a "call_expression" node, indicating that bb is used as a function (a method). So we want a predicate function that checks whether bb is used as a function or a property, and determine whether it should be in function or property face. * doc/lispref/parsing.texi (Pattern Matching): Update manual. * src/treesit.c (Ftreesit_pattern_expand): Handle :pred. (treesit_predicate_capture_name_to_node): A new function extracted from treesit_predicate_capture_name_to_text. (treesit_predicate_capture_name_to_text): Use the newly extracted function. (treesit_predicate_pred): New predicate function. (treesit_eval_predicates): Add new predicate. Also fix a bug: we want to AND the results of each predicate. * test/src/treesit-tests.el (treesit--ert-pred-last-sibling): New helper function. (treesit-query-api): Test #pred predicate. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 5d1b11935cf..63741b69c22 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1266,10 +1266,11 @@ Pattern Matching @end example @noindent -tree-sitter only matches arrays where the first element equals to -the last element. To attach a predicate to a pattern, we need to -group them together. A predicate always starts with a @samp{#}. -Currently there are two predicates, @code{#equal} and @code{#match}. +tree-sitter only matches arrays where the first element equals to the +last element. To attach a predicate to a pattern, we need to group +them together. A predicate always starts with a @samp{#}. Currently +there are three predicates, @code{#equal}, @code{#match}, and +@code{#pred}. @deffn Predicate equal arg1 arg2 Matches if @var{arg1} equals to @var{arg2}. Arguments can be either @@ -1282,6 +1283,11 @@ Pattern Matching matches regular expression @var{regexp}. Matching is case-sensitive. @end deffn +@deffn Predicate pred fn &rest nodes +Matches if function @var{fn} returns non-@code{nil} when passed each +node in @var{nodes} as arguments. +@end deffn + Note that a predicate can only refer to capture names that appear in the same pattern. Indeed, it makes little sense to refer to capture names in other patterns. diff --git a/src/treesit.c b/src/treesit.c index ecc977745a6..813d4222f98 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2170,6 +2170,8 @@ DEFUN ("treesit-pattern-expand", return build_pure_c_string ("#equal"); if (EQ (pattern, QCmatch)) return build_pure_c_string ("#match"); + if (EQ (pattern, QCpred)) + return build_pure_c_string ("#pred"); Lisp_Object opening_delimeter = build_pure_c_string (VECTORP (pattern) ? "[" : "("); Lisp_Object closing_delimiter @@ -2269,10 +2271,10 @@ treesit_predicates_for_pattern (TSQuery *query, uint32_t pattern_index) return Fnreverse (result); } -/* Translate a capture NAME (symbol) to the text of the captured node. +/* Translate a capture NAME (symbol) to a node. Signals treesit-query-error if such node is not captured. */ static Lisp_Object -treesit_predicate_capture_name_to_text (Lisp_Object name, +treesit_predicate_capture_name_to_node (Lisp_Object name, struct capture_range captures) { Lisp_Object node = Qnil; @@ -2292,6 +2294,16 @@ treesit_predicate_capture_name_to_text (Lisp_Object name, name, build_pure_c_string ("A predicate can only refer" " to captured nodes in the " "same pattern")); + return node; +} + +/* Translate a capture NAME (symbol) to the text of the captured node. + Signals treesit-query-error if such node is not captured. */ +static Lisp_Object +treesit_predicate_capture_name_to_text (Lisp_Object name, + struct capture_range captures) +{ + Lisp_Object node = treesit_predicate_capture_name_to_node (name, captures); struct buffer *old_buffer = current_buffer; set_buffer_internal (XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer)); @@ -2365,13 +2377,30 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures) return false; } -/* About predicates: I decide to hard-code predicates in C instead of - implementing an extensible system where predicates are translated - to Lisp functions, and new predicates can be added by extending a - list of functions, because I really couldn't imagine any useful - predicates besides equal and match. If we later found out that - such system is indeed useful and necessary, it can be easily - added. */ +/* Handles predicate (#pred FN ARG...). Return true if FN returns + non-nil; return false otherwise. The arity of FN must match the + number of ARGs */ +static bool +treesit_predicate_pred (Lisp_Object args, struct capture_range captures) +{ + if (XFIXNUM (Flength (args)) < 2) + xsignal2 (Qtreesit_query_error, + build_pure_c_string ("Predicate `pred' requires " + "at least two arguments, " + "but was only given"), + Flength (args)); + + Lisp_Object fn = Fintern (XCAR (args), Qnil); + Lisp_Object nodes = Qnil; + Lisp_Object tail = XCDR (args); + FOR_EACH_TAIL (tail) + nodes = Fcons (treesit_predicate_capture_name_to_node (XCAR (tail), + captures), + nodes); + nodes = Fnreverse (nodes); + + return !NILP (CALLN (Fapply, fn, nodes)); +} /* If all predicates in PREDICATES passes, return true; otherwise return false. */ @@ -2387,14 +2416,17 @@ treesit_eval_predicates (struct capture_range captures, Lisp_Object predicates) Lisp_Object fn = XCAR (predicate); Lisp_Object args = XCDR (predicate); if (!NILP (Fstring_equal (fn, build_pure_c_string ("equal")))) - pass = treesit_predicate_equal (args, captures); + pass &= treesit_predicate_equal (args, captures); else if (!NILP (Fstring_equal (fn, build_pure_c_string ("match")))) - pass = treesit_predicate_match (args, captures); + pass &= treesit_predicate_match (args, captures); + else if (!NILP (Fstring_equal (fn, build_pure_c_string ("pred")))) + pass &= treesit_predicate_pred (args, captures); else xsignal3 (Qtreesit_query_error, build_pure_c_string ("Invalid predicate"), fn, build_pure_c_string ("Currently Emacs only supports" - " equal and match predicate")); + " equal, match, and pred" + " predicate")); } /* If all predicates passed, add captures to result list. */ return pass; @@ -3217,6 +3249,7 @@ syms_of_treesit (void) DEFSYM (QCanchor, ":anchor"); DEFSYM (QCequal, ":equal"); DEFSYM (QCmatch, ":match"); + DEFSYM (QCpred, ":pred"); DEFSYM (Qnot_found, "not-found"); DEFSYM (Qsymbol_error, "symbol-error"); diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 3fe59a78d07..3770a4d01e5 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -335,6 +335,9 @@ treesit-cursor-helper-with-missing-node ;;; Query +(defun treesit--ert-pred-last-sibling (node) + (null (treesit-node-next-sibling node t))) + (ert-deftest treesit-query-api () "Tests for query API." (skip-unless (treesit-language-available-p 'json)) @@ -357,13 +360,16 @@ treesit-query-api (pair key: (_) @keyword) ((_) @bob (#match \"^B.b$\" @bob)) (number) @number -((number) @n3 (#equal \"3\" @n3)) " +((number) @n3 (#equal \"3\" @n3)) +((number) @n3p (#pred treesit--ert-pred-last-sibling @n3p))" ;; Sexp query. ((string) @string (pair key: (_) @keyword) ((_) @bob (:match "^B.b$" @bob)) (number) @number - ((number) @n3 (:equal "3" @n3))))) + ((number) @n3 (:equal "3" @n3)) + ((number) @n3p (:pred treesit--ert-pred-last-sibling + @n3p))))) ;; Test `treesit-query-compile'. (dolist (query (list query1 (treesit-query-compile 'json query1))) @@ -375,7 +381,8 @@ treesit-query-api (string . "\"Bob\"") (bob . "Bob") (number . "3") - (n3 . "3")) + (n3 . "3") + (n3p . "3")) (mapcar (lambda (entry) (cons (car entry) (treesit-node-text commit 835a80dcc48c9c9d90709dcadbedb9afd6ded48c Author: Yuan Fu Date: Mon Dec 26 17:15:37 2022 -0800 ; Fix tree-sitter defun tests * test/src/treesit-tests.el (treesit--ert-test-defun-navigation): Change treesit--navigate-defun to treesit--navigate-thing. diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 48b61cf3dc3..3fe59a78d07 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -831,36 +831,40 @@ treesit--ert-test-defun-navigation and \"]\"." (with-temp-buffer (funcall init) - (let* ((opening (or opening "[")) - (closing (or closing "]")) - ;; Insert program and parse marker positions. - (marker-alist (treesit--ert-insert-and-parse-marker - opening closing program)) - ;; Translate marker positions into buffer positions. - (decoded-master - (cl-loop for record in master - collect - (cl-loop for pos in record - collect (alist-get pos marker-alist)))) - ;; Collect positions each function returns. - (positions - (treesit--ert-collect-positions - ;; The first column of DECODED-MASTER. - (mapcar #'car decoded-master) - ;; Four functions: next-end, prev-beg, next-beg, prev-end. - (mapcar (lambda (conf) - (lambda () - (if-let ((pos (funcall - #'treesit--navigate-defun - (point) (car conf) (cdr conf)))) - (save-excursion - (goto-char pos) - (funcall treesit-defun-skipper) - (point))))) - '((-1 . beg) - (1 . end) - (-1 . end) - (1 . beg)))))) + (pcase-let* + ((opening (or opening "[")) + (closing (or closing "]")) + ;; Insert program and parse marker positions. + (marker-alist (treesit--ert-insert-and-parse-marker + opening closing program)) + ;; Translate marker positions into buffer positions. + (decoded-master + (cl-loop for record in master + collect + (cl-loop for pos in record + collect (alist-get pos marker-alist)))) + (`(,regexp . ,pred) (treesit--thing-unpack-pattern + treesit-defun-type-regexp)) + ;; Collect positions each function returns. + (positions + (treesit--ert-collect-positions + ;; The first column of DECODED-MASTER. + (mapcar #'car decoded-master) + ;; Four functions: next-end, prev-beg, next-beg, prev-end. + (mapcar (lambda (conf) + (lambda () + (if-let ((pos (funcall + #'treesit--navigate-thing + (point) (car conf) (cdr conf) + regexp pred))) + (save-excursion + (goto-char pos) + (funcall treesit-defun-skipper) + (point))))) + '((-1 . beg) + (1 . end) + (-1 . end) + (1 . beg)))))) ;; Verify each position. (cl-loop for record in decoded-master for orig-record in master commit a14821d61511b53acb70c56765e71ff283b3e230 Author: Stefan Kangas Date: Mon Dec 26 21:22:42 2022 +0100 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`.) 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 @@ gnutls-min-prime-bits 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) commit b14bbd108e4bc43f8c7995dfff4c2c59c78f1b5f Author: Gregory Heytings Date: Mon Dec 26 00:20:59 2022 +0000 Improve handling of tab-bar height. * src/xdisp.c (redisplay_tab_bar): When 'auto-resize-tab-bar' is not 'grow-only', also consider the case when the tab-bar height needs to shrink. Fixes bug#60210. diff --git a/src/xdisp.c b/src/xdisp.c index ea2d11e8b4e..c9b3b187fe2 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -14271,12 +14271,14 @@ redisplay_tab_bar (struct frame *f) frame_default_tab_bar_height = new_height; } - /* If new_height or new_nrows indicate that we need to enlarge the - tab-bar window, we can return right away. */ + /* If new_height or new_nrows indicate that we need to enlarge or + shrink the tab-bar window, we can return right away. */ if (new_nrows > f->n_tab_bar_rows || (EQ (Vauto_resize_tab_bars, Qgrow_only) && !f->minimize_tab_bar_window_p - && new_height > WINDOW_PIXEL_HEIGHT (w))) + && new_height > WINDOW_PIXEL_HEIGHT (w)) + || (! EQ (Vauto_resize_tab_bars, Qgrow_only) + && new_height < WINDOW_PIXEL_HEIGHT (w))) { if (FRAME_TERMINAL (f)->change_tab_bar_height_hook) FRAME_TERMINAL (f)->change_tab_bar_height_hook (f, new_height); commit 669160d47b2e3d1eaab242e464c7397cffd6c38b Author: Eli Zaretskii Date: Mon Dec 26 16:26:28 2022 +0200 ; * nt/INSTALL.W64: More fixes and updates. diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index b543034e479..0e5e62117d2 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -31,13 +31,14 @@ build tools for MinGW-w64 -- see https://msys2.org/. ** Download and install MinGW-w64 and MSYS2 -Go to https://msys2.org and follow the instructions. It is not -necessary to install the packages suggested on those instructions. +Go to https://msys2.org and follow the Installation instructions, up +to where they say to use 'pacman -S' to install packages. Instead, +install the necessary packages as instructed in the next section. ** Download and install the necessary packages Run mingw64.exe in your MSYS2 directory and you will see a BASH window -opened. +open. In the BASH prompt, use the following command to install the necessary packages (you can copy and paste it into the shell with Shift + Insert): @@ -45,6 +46,8 @@ packages (you can copy and paste it into the shell with Shift + Insert): pacman -S --needed base-devel \ mingw-w64-x86_64-toolchain \ mingw-w64-x86_64-xpm-nox \ + mingw-w64-x86_64-gmp \ + mingw-w64-x86_64-gnutls \ mingw-w64-x86_64-libtiff \ mingw-w64-x86_64-giflib \ mingw-w64-x86_64-libpng \ @@ -54,16 +57,21 @@ packages (you can copy and paste it into the shell with Shift + Insert): mingw-w64-x86_64-lcms2 \ mingw-w64-x86_64-jansson \ mingw-w64-x86_64-libxml2 \ - mingw-w64-x86_64-gnutls \ mingw-w64-x86_64-zlib \ - mingw-w64-x86_64-harfbuzz - -The packages include the base developer tools (autoconf, grep, make, etc.), -the compiler toolchain (gcc, gdb, etc.), several image libraries, an XML -library, the GnuTLS (transport layer security) library, zlib for -decompressing text, and HarfBuzz for use as the shaping engine. Only the -first three packages are required (base-devel, toolchain, xpm-nox); the -rest are optional. You can select only part of the libraries if you don't + mingw-w64-x86_64-harfbuzz \ + mingw-w64-x86_64-libgccjit \ + mingw-w64-x86_64-sqlite3 \ + mingw-w64-x86_64-tree-sitter + +The packages include the base developer tools (autoconf, grep, make, +etc.), the compiler toolchain (gcc, gdb, etc.), several image +libraries, an XML library, the GnuTLS (transport layer security) +library, zlib for decompressing text, HarfBuzz for use as the shaping +engine, libgccjit for native-compilation support, SQLite3 for +accessing SQL databases, and the tree-sitter library used by some +major modes. Only the first four packages are required (base-devel, +toolchain, xpm-nox, GMP), and GnuTLS is highly recommended; the rest +are optional. You can select only part of the libraries if you don't need them all. You now have a complete build environment for Emacs. commit 26b2ec7cb8c81db7d8705cb87579b325901ed303 Author: Eli Zaretskii Date: Mon Dec 26 15:26:48 2022 +0200 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. 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 @@ internal--format-docstring-line (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. diff --git a/src/json.c b/src/json.c index d2105bc27b1..621c7d7c15f 100644 --- a/src/json.c +++ b/src/json.c @@ -555,37 +555,39 @@ json_parse_args (ptrdiff_t nargs, } } -#ifdef WINDOWSNT static bool json_available_p (void) { - if (json_initialized) - return true; - json_initialized = init_json_functions (); - Lisp_Object status = json_initialized ? Qt : Qnil; - Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); +#ifdef WINDOWSNT + if (!json_initialized) + { + Lisp_Object status; + json_initialized = init_json_functions (); + status = json_initialized ? Qt : Qnil; + Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); + } return json_initialized; -} +#else /* !WINDOWSNT */ + return true; #endif +} +#ifdef WINDOWSNT static void ensure_json_available (void) { -#ifdef WINDOWSNT if (!json_available_p ()) Fsignal (Qjson_unavailable, list1 (build_unibyte_string ("jansson library not found"))); -#endif } +#endif -#ifdef WINDOWSNT DEFUN ("json--available-p", Fjson__available_p, Sjson__available_p, 0, 0, NULL, - doc: /* Whether libjansson is available (internal). */) + doc: /* Return non-nil if libjansson is available (internal use only). */) (void) { return json_available_p () ? Qt : Qnil; } -#endif DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY, NULL, @@ -617,7 +619,10 @@ DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY, (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); + +#ifdef WINDOWSNT ensure_json_available (); +#endif struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; @@ -714,7 +719,10 @@ DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, MANY, (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); + +#ifdef WINDOWSNT ensure_json_available (); +#endif struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; @@ -959,7 +967,10 @@ DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY, (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); + +#ifdef WINDOWSNT ensure_json_available (); +#endif Lisp_Object string = args[0]; CHECK_STRING (string); @@ -1044,7 +1055,10 @@ DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer, (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); + +#ifdef WINDOWSNT ensure_json_available (); +#endif struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; @@ -1121,9 +1135,7 @@ syms_of_json (void) DEFSYM (Qplist, "plist"); DEFSYM (Qarray, "array"); -#ifdef WINDOWSNT defsubr (&Sjson__available_p); -#endif defsubr (&Sjson_serialize); defsubr (&Sjson_insert); defsubr (&Sjson_parse_string); commit 082fc6e3088354f16ab8293725cc727a9855359b Author: Mattias Engdegård Date: Sun Dec 25 15:32:06 2022 +0100 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. 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 @@ internal--format-docstring-line (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. diff --git a/src/json.c b/src/json.c index cdcc11358e6..d2105bc27b1 100644 --- a/src/json.c +++ b/src/json.c @@ -555,6 +555,38 @@ json_parse_args (ptrdiff_t nargs, } } +#ifdef WINDOWSNT +static bool +json_available_p (void) +{ + if (json_initialized) + return true; + json_initialized = init_json_functions (); + Lisp_Object status = json_initialized ? Qt : Qnil; + Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); + return json_initialized; +} +#endif + +static void +ensure_json_available (void) +{ +#ifdef WINDOWSNT + if (!json_available_p ()) + Fsignal (Qjson_unavailable, + list1 (build_unibyte_string ("jansson library not found"))); +#endif +} + +#ifdef WINDOWSNT +DEFUN ("json--available-p", Fjson__available_p, Sjson__available_p, 0, 0, NULL, + doc: /* Whether libjansson is available (internal). */) + (void) +{ + return json_available_p () ? Qt : Qnil; +} +#endif + DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY, NULL, doc: /* Return the JSON representation of OBJECT as a string. @@ -585,19 +617,7 @@ DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY, (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); - -#ifdef WINDOWSNT - if (!json_initialized) - { - Lisp_Object status; - json_initialized = init_json_functions (); - status = json_initialized ? Qt : Qnil; - Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); - } - if (!json_initialized) - Fsignal (Qjson_unavailable, - list1 (build_unibyte_string ("jansson library not found"))); -#endif + ensure_json_available (); struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; @@ -694,19 +714,7 @@ DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, MANY, (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); - -#ifdef WINDOWSNT - if (!json_initialized) - { - Lisp_Object status; - json_initialized = init_json_functions (); - status = json_initialized ? Qt : Qnil; - Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); - } - if (!json_initialized) - Fsignal (Qjson_unavailable, - list1 (build_unibyte_string ("jansson library not found"))); -#endif + ensure_json_available (); struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; @@ -951,19 +959,7 @@ DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY, (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); - -#ifdef WINDOWSNT - if (!json_initialized) - { - Lisp_Object status; - json_initialized = init_json_functions (); - status = json_initialized ? Qt : Qnil; - Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); - } - if (!json_initialized) - Fsignal (Qjson_unavailable, - list1 (build_unibyte_string ("jansson library not found"))); -#endif + ensure_json_available (); Lisp_Object string = args[0]; CHECK_STRING (string); @@ -1048,19 +1044,7 @@ DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer, (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref count = SPECPDL_INDEX (); - -#ifdef WINDOWSNT - if (!json_initialized) - { - Lisp_Object status; - json_initialized = init_json_functions (); - status = json_initialized ? Qt : Qnil; - Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache); - } - if (!json_initialized) - Fsignal (Qjson_unavailable, - list1 (build_unibyte_string ("jansson library not found"))); -#endif + ensure_json_available (); struct json_configuration conf = {json_object_hashtable, json_array_array, QCnull, QCfalse}; @@ -1137,6 +1121,9 @@ syms_of_json (void) DEFSYM (Qplist, "plist"); DEFSYM (Qarray, "array"); +#ifdef WINDOWSNT + defsubr (&Sjson__available_p); +#endif defsubr (&Sjson_serialize); defsubr (&Sjson_insert); defsubr (&Sjson_parse_string); commit 6c86faec29e7e9f12b71886dc66b62e1da43cdf7 Author: Kyle Meyer Date: Sun Dec 25 15:31:33 2022 -0500 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. 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 @@ loaddefs-generate (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 commit d90d7d15f2f78c37b9a5c775e617ab6f5cd5fb01 Author: Yuan Fu Date: Mon Dec 26 01:39:02 2022 -0800 ; 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. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 4b9cd18dd47..5d1b11935cf 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1715,17 +1715,14 @@ Tree-sitter major modes Currently, it sets up the following features: @itemize -@vindex treesit-font-lock-settings @item -If @code{treesit-font-lock-settings} is non-@code{nil}, it sets up -fontification. +If @code{treesit-font-lock-settings} (@pxref{Parser-based Font Lock}) +is non-@code{nil}, it sets up fontification. -@vindex treesit-simple-indent-rules @item -If @code{treesit-simple-indent-rules} is non-@code{nil}, it sets up -indentation. +If @code{treesit-simple-indent-rules} (@pxref{Parser-based Font Lock}) +is non-@code{nil}, it sets up indentation. -@vindex treesit-defun-type-regexp @item If @code{treesit-defun-type-regexp} is non-@code{nil}, it sets up navigation functions for @code{beginning-of-defun} and @@ -1782,6 +1779,17 @@ Tree-sitter major modes @code{nil}, it should return @code{nil}. @end defvar +@defvar treesit-defun-type-regexp +This variable determines which nodes are considered defuns by Emacs. +It can be a regexp that matches the type of defun nodes. + +Sometimes not all nodes matched by the regexp are valid defuns. +Therefore, this variable can also be a cons cell of the form +@w{(@var{regexp} . @var{pred})}, where @var{pred} should be a function +that takes a node as its argument, and returns @code{t} if the node is +valid defun, or @code{nil} if it is not valid. +@end defvar + @node Tree-sitter C API @section Tree-sitter C API Correspondence 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 @@ treesit-defun-type-regexp 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. commit eb268728376db081b61f47c635b7316938e63d5d Author: Yuan Fu Date: Mon Dec 26 01:01:41 2022 -0800 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. 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 @@ c-ts-mode--imenu-1 (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 @@ c-ts-mode--imenu ;;; 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. commit 8f68b6497ee17791c3a1084ebef164f11cb089c6 Author: Yuan Fu Date: Mon Dec 26 00:43:42 2022 -0800 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. 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 @@ python--treesit-settings :feature 'string :language 'python - :override t '((string) @python--treesit-fontify-string) :feature 'string-interpolation @@ -1130,7 +1129,7 @@ python--treesit-settings @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 @@ python--treesit-settings :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 @@ python--treesit-settings :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 @@ 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) commit 28f26b11a1ebd46b9f599babf843f91871efb629 Author: Yuan Fu Date: Sun Dec 25 11:21:50 2022 -0800 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. 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 @@ c-ts-mode--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 @@ c-ts-base-mode (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 @@ c-ts-mode ;; 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 @@ c++-ts-mode (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 @@ csharp-ts-mode--indent-rules ((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 @@ csharp-ts-mode (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 @@ java-ts-mode--indent-rules ((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 @@ java-ts-mode (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 @@ js--treesit-indent-rules ((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 @@ 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 @@ rust-ts-mode--indent-rules ((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 @@ rust-ts-mode (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 @@ typescript-ts-mode--indent-rules ((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 @@ typescript-ts-base-mode :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) commit c6b02826450e3d40b4a2ea4e6026a813d3679d8d Author: Yuan Fu Date: Sun Dec 25 11:11:00 2022 -0800 ; 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. 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 @@ c-ts-mode--imenu ;;; 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 @@ c-ts-mode ;; 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 @@ c++-ts-mode ;; 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) commit 6e52a9fcadc5b939396febffa9378c8b361d8313 Author: Yuan Fu Date: Sun Dec 25 10:44:53 2022 -0800 ; * doc/lispref/modes.texi (Parser-based Font Lock): Minor fixes. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 736c2d6841f..449529a4307 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -4023,11 +4023,12 @@ Parser-based Font Lock @var{:keyword}/@var{value} pairs. Each @var{query} is a tree-sitter query in either the string, s-expression or compiled form. +@c FIXME: Cross-ref treesit-font-lock-level to user manual. For each @var{query}, the @var{:keyword}/@var{value} pairs that precede it add meta information to it. The @code{:lang} keyword declares @var{query}'s language. The @code{:feature} keyword sets the feature name of @var{query}. Users can control which features are -enabled with @code{font-lock-maximum-decoration} and +enabled with @code{treesit-font-lock-level} and @code{treesit-font-lock-feature-list} (described below). These two keywords are mandatory. @@ -4067,10 +4068,11 @@ Parser-based Font Lock ignored. @end defun +@c FIXME: Cross-ref treesit-font-lock-level to user manual. @defvar treesit-font-lock-feature-list This is a list of lists of feature symbols. Each element of the list is a list that represents a decoration level. -@code{font-lock-maximum-decoration} controls which levels are +@code{treesit-font-lock-level} controls which levels are activated. Each element of the list is a list of the form @w{@code{(@var{feature} commit 2bcd1e9a99d5b1b67205d2cb914c98068104b83f Author: Yuan Fu Date: Sun Dec 25 10:38:05 2022 -0800 ; * doc/lispref/parsing.texi (Retrieving Nodes): Add notice. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 3744cf0b985..4b9cd18dd47 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -643,6 +643,10 @@ Retrieving Nodes @defun treesit-node-parent node This function returns the immediate parent of @var{node}. + +If @var{node} is more than 1000 levels deep in a parse tree, the +return value is undefined. Currently it returns @var{nil}, but that +could change in the future. @end defun @defun treesit-node-child node n &optional named commit 7c7950fe006fe19596011637610b934a786c1742 Author: Yuan Fu Date: Sun Dec 25 10:22:40 2022 -0800 Add maintainer stub for tree-sitter files * lisp/treesit.el: * src/treesit.c: Add maintainer. 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 diff --git a/src/treesit.c b/src/treesit.c index ce8a2804439..ecc977745a6 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2,6 +2,8 @@ Copyright (C) 2021-2022 Free Software Foundation, Inc. +Maintainer: Yuan Fu + This file is part of GNU Emacs. GNU Emacs is free software: you can redistribute it and/or modify commit cf327766226c1f2e71f02bcbbdb3ea9aedb4a8dd Author: Yuan Fu Date: Sun Dec 25 10:05:06 2022 -0800 ; * doc/lispref/parsing.texi (Using Parser): Remove deleted function. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index 6baa253cfdf..3744cf0b985 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -393,12 +393,6 @@ Using Parser when deciding whether to enable tree-sitter features. @end defvar -@defun treesit-can-enable-p -This function checks whether the current buffer is suitable for -activating tree-sitter features. It basically checks -@code{treesit-available-p} and @code{treesit-max-buffer-size}. -@end defun - @cindex creating tree-sitter parsers @cindex tree-sitter parser, creating @defun treesit-parser-create language &optional buffer no-reuse commit 2608e5edcca5094b61b4ccebcef160cc2bfd7f83 Author: Stefan Kangas Date: Fri Dec 23 18:21:10 2022 +0100 ; Fix typos (cherry picked from commit a5d39e11443fa30c8e8bc58254a1a59550dcd99e) diff --git a/ChangeLog.3 b/ChangeLog.3 index 4b3507bae31..bff2f7a66d9 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -3928,7 +3928,7 @@ * lisp/follow.el (follow-scroll-down): Do away with the optimization of doing vertical-motion over only one window. Instead move over all windows, to - checck for being close to point-min, and setting point accordingly. + check for being close to point-min, and setting point accordingly. 2021-11-13 Eli Zaretskii @@ -50632,7 +50632,7 @@ Allow for adding constraints targeting blocks with multiple predecessors - This commit remove the limitaiton we had not being able to add + This commit remove the limitation we had not being able to add constraints derived from conditional branches to basic blocks with multiple predecessors. When this condition is verified we add a new dedicated basic block to hold the constraints. @@ -75446,7 +75446,7 @@ According to RFC 3986 it should be percent-encoded and thus should not contain spaces. However, there are HTTP server implementation (notably nginx) that do not do that. This makes Emacs url-http.el behave like - most other HTTP client implementatios. Also remove the stripping of + most other HTTP client implementations. Also remove the stripping of angle bracket quotes as they are not valid according to the RFCs. 2020-07-19 Satoshi Nakagawa (tiny change) @@ -87619,7 +87619,7 @@ itself and reevaluates it in each stop to yield an address. We also add a warning (a red bold exclamation mark) on the header line when the content of the page doesn't represent the memory location - user requested for. That happends when some error occurs in + user requested for. That happens when some error occurs in evaluating the address, and we display the last successfully displayed memory page. * lisp/progmodes/gdb-mi.el (gdb-memory-address-expression) @@ -105227,7 +105227,7 @@ Sometimes, when finding files with icomplete-mode, backward-deleting the previous word or sexp (to move up a directory) doesn't actually refresh the file list of the new directory. Forcing redisplay in - icomplete-exhibit misteriously fixes the problem. + icomplete-exhibit mysteriously fixes the problem. * lisp/icomplete.el (icomplete-exhibit): Add call to redisplay. @@ -129725,7 +129725,7 @@ * lisp/delim-col.el: Use lexical-binding. * test/lisp/delim-col-tests.el: New file. - (delim-col-tests-delimit-colummns-before-after) + (delim-col-tests-delimit-columns-before-after) (delim-col-tests-delimit-columns) (delim-col-tests-delimit-columns-format/nil) (delim-col-tests-delimit-columns-format/padding) @@ -154614,7 +154614,7 @@ Fixes: Bug#31951 * lisp/server.el (server-save-buffers-kill-terminal): Only pass - PRED=t to save-some-bufers if ARG in non-nil. + PRED=t to save-some-buffers if ARG in non-nil. 2018-06-27 Vincent Belaïche @@ -221589,7 +221589,7 @@ (ses-define-if-new-local-printer): New defsubst. (ses-center, ses-center-span, ses-dashfill) (ses-dashfill-span, ses-tildefill-span): Allow to pass printer - as an optional argument to superseed column printer/default + as an optional argument to supersede column printer/default spreadsheet printer. (ses-prin1): New defun. diff --git a/admin/git-bisect-start b/admin/git-bisect-start index 945d4901c1b..227ea0ba059 100755 --- a/admin/git-bisect-start +++ b/admin/git-bisect-start @@ -66,7 +66,7 @@ $REAL_GIT bisect start "$@" ## already on master. In other words, it is the parent of the merge ## commit for which 'git rev-list --max-parents=0 ' does not ## include ce5584125c44a1a2fbb46e810459c50b227a95e2 (which is the root -## commit of the Emacs respository). +## commit of the Emacs repository). for C in $(cat $0 | grep '^# SKIP-BRANCH ' | sed 's/^# SKIP-BRANCH //') do diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 9ebb044652c..cd3244a9122 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -3166,7 +3166,7 @@ Bug Reference issue tracking software which assigns each report a unique and short number or identifier. Those are used to reference a given bug, e.g., in a source code comment above the code fixing some bug, in -documentation files, or in discussions on some mailinglist or IRC +documentation files, or in discussions on some mailing list or IRC channel. @findex bug-reference-mode diff --git a/doc/lispref/ChangeLog.1 b/doc/lispref/ChangeLog.1 index 82840aed1d6..361e816bc37 100644 --- a/doc/lispref/ChangeLog.1 +++ b/doc/lispref/ChangeLog.1 @@ -5150,7 +5150,7 @@ * backups.texi (Making Backups): * modes.texi (Example Major Modes): Use recommended coding style. - (Major Mode Basics, Derived Modes): Encourge more strongly use of + (Major Mode Basics, Derived Modes): Encourage more strongly use of define-derived-mode. Mention completion-at-point-functions. 2010-12-13 Chong Yidong diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index e67b99b769c..37434994548 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6294,7 +6294,7 @@ SVG Images work is done directly by librsvg. @lisp -;; Embeding /tmp/subdir/rms.jpg and /tmp/another/rms.jpg +;; Embedding /tmp/subdir/rms.jpg and /tmp/another/rms.jpg (svg-embed-base-uri-image svg "subdir/rms.jpg" :width "100px" :height "100px" :x "50px" :y "75px") diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 3a1f6de12b2..3216a353958 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -804,7 +804,7 @@ Documentation Tips preceded by @samp{URL}. For example, @smallexample -The GNU project wesite has more information (see URL +The GNU project website has more information (see URL `https://www.gnu.org/'). @end smallexample diff --git a/doc/misc/ChangeLog.1 b/doc/misc/ChangeLog.1 index 1c5e7c1e2fd..cd3f599b934 100644 --- a/doc/misc/ChangeLog.1 +++ b/doc/misc/ChangeLog.1 @@ -6012,7 +6012,7 @@ (Built-in table editor): Document M-e and M-a navigate inside table field. (Stuck projects): Docment that projects identified as - un-stuck will still be searchd for stuck sub-projects. + un-stuck will still be searched for stuck sub-projects. (Paragraphs): Document centering. (Creating timestamps, Agenda commands): Document new behavior when changing time stamps. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index a8f5248c4c8..eee8463a0fa 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -7149,7 +7149,7 @@ Indenting Directives it, whilst ``indent to body'' is active, you need to re-enable the feature by calling @code{c-toggle-cpp-indent-to-body} for these changes to take effect@footnote{Note that the removal of directives -doesn't work satisfactorally on XEmacs or on very old versions of +doesn't work satisfactorily on XEmacs or on very old versions of Emacs}. @end defopt diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 67889c0b109..6c50469d4d8 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -733,7 +733,7 @@ following snippet to allow multiple different ID formats in Org files. (and (or (org-uuidgen-p id) (string-match-p "[0-9a-z]\\{12\\}" id)) (org-attach-id-uuid-folder-format id))) - ;; When ID looks like a timestap-based ID. Group by year-month + ;; When ID looks like a timestamp-based ID. Group by year-month ;; folders. (lambda (id) (and (string-match-p "[0-9]\\{8\\}T[0-9]\\{6\\}\.[0-9]\\{6\\}" id) @@ -5431,9 +5431,9 @@ doing computation. There are now three lookup functions: -- [[doc:org-loopup-first][org-loopup-first]] -- [[doc:org-loopup-last][org-loopup-last]] -- [[doc:org-loopup-all][org-loopup-all]] +- [[doc:org-lookup-first][org-lookup-first]] +- [[doc:org-lookup-last][org-lookup-last]] +- [[doc:org-lookup-all][org-lookup-all]] See [[https://orgmode.org/org.html#Lookup-functions][the manual]] for details. *** Startup keywords diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 634480cce7d..c560f9246dd 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -3173,7 +3173,7 @@ something like the following in your init file: ** Native Compilation on macOS -Native complitation requires the libgccjit library to be installed and +Native compilation requires the libgccjit library to be installed and its path available to Emacs. Errors such as: libgccjit.so: error: error invoking gcc driver 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 @@ rmail-summary--split-header-field (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 @@ mh-search (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 @@ tramp-sh-handle-expand-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 @@ org-element--cache-gapless 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 @@ org-agenda-structure-secondary (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 @@ org-fold-core--optimise-for-huge-buffers 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 @@ c-after-change-unmark-ml-strings (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 @@ idlwave-help-mode 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 @@ python-pdbtrack-comint-input-filter-function (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 @@ list-matching-lines-prefix-face 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 @@ sort-subr 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...")) diff --git a/src/dispextern.h b/src/dispextern.h index df6134e68f0..e6c4270bebd 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -107,7 +107,7 @@ #define NativeRectangle XRectangle { int width, height; /* size of image */ char *data; /* pointer to image data */ - int bytes_per_line; /* accelarator to next line */ + int bytes_per_line; /* accelerator to next line */ int bits_per_pixel; /* bits per pixel (ZPixmap) */ } *Emacs_Pix_Container; typedef Emacs_Pix_Container Emacs_Pixmap; @@ -1712,7 +1712,7 @@ #define FONT_TOO_HIGH(ft) \ /* Non-zero means characters in this face have a box of that thickness around them. Vertical (left and right) and horizontal - (top and bottom) borders size can be set separatedly using an + (top and bottom) borders size can be set separately using an associated list of two ints in the form (vertical_size . horizontal_size). In case one of the value is negative, its absolute value indicates the thickness, and the diff --git a/src/haikufns.c b/src/haikufns.c index 5717d0354f8..ea12a144888 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -3245,7 +3245,7 @@ syms_of_haikufns (void) DEFVAR_LISP ("haiku-allowed-ui-colors", Vhaiku_allowed_ui_colors, doc: /* Vector of UI colors that Emacs can look up from the system. -If this is set up incorrectly, Emacs can crash when encoutering an +If this is set up incorrectly, Emacs can crash when encountering an invalid color. */); Vhaiku_allowed_ui_colors = Qnil; diff --git a/src/itree.c b/src/itree.c index 975f3a8e4fb..f582a6112a7 100644 --- a/src/itree.c +++ b/src/itree.c @@ -85,7 +85,7 @@ Copyright (C) 2017-2022 Free Software Foundation, Inc. this narrowing is O(K*log(N)) where K is the size of the result set. If we are interested in finding the node in a range with the smallest END, we might have to examine all K nodes in that range. - In the case of the *-overlay-channge functions, K may well be equal + In the case of the *-overlay-change functions, K may well be equal to N. Ideally, a tree based data structure for overlays would have diff --git a/src/xfaces.c b/src/xfaces.c index be4a7ca71cc..663386dc25b 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7280,7 +7280,7 @@ syms_of_xfaces (void) DEFVAR_BOOL ("face-filters-always-match", face_filters_always_match, doc: /* Non-nil means that face filters are always deemed to match. This variable is intended for use only by code that evaluates -the "specifity" of a face specification and should be let-bound +the "specificity" of a face specification and should be let-bound only for this purpose. */); DEFVAR_LISP ("face--new-frame-defaults", Vface_new_frame_defaults, diff --git a/src/xterm.c b/src/xterm.c index 44fad6e8d59..a4ce228e9e6 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -4513,7 +4513,7 @@ x_dnd_send_position (struct frame *f, Window target, Window toplevel, maintained by the original author of the protocol specifies it for all versions. Since at least one program supports these flags, but uses protocol v4 (and not v5), set them for all - protocool versions. */ + protocol versions. */ if (button >= 4 && button <= 7) { msg.xclient.data.l[1] |= (1 << 10); diff --git a/test/lisp/gnus/mml-sec-resources/trustlist.txt b/test/lisp/gnus/mml-sec-resources/trustlist.txt index f886572d283..947ec526199 100644 --- a/test/lisp/gnus/mml-sec-resources/trustlist.txt +++ b/test/lisp/gnus/mml-sec-resources/trustlist.txt @@ -2,7 +2,7 @@ # well as empty lines are ignored. Lines have a length limit but this # is not a serious limitation as the format of the entries is fixed and # checked by gpg-agent. A non-comment line starts with optional white -# space, followed by the SHA-1 fingerpint in hex, followed by a flag +# space, followed by the SHA-1 fingerprint in hex, followed by a flag # which may be one of 'P', 'S' or '*' and optionally followed by a list of # other flags. The fingerprint may be prefixed with a '!' to mark the # key as not trusted. You should give the gpg-agent a HUP or run the diff --git a/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl b/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl index fa328438cb1..6d3f478595e 100644 --- a/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl +++ b/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl @@ -1,4 +1,4 @@ -# The following Perl punctiation variables contain characters which +# The following Perl punctuation variables contain characters which # are classified as string delimiters in the syntax table. The mode # should not be confused by these. # The corresponding tests check that two consecutive '#' characters diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 1bb206e7040..96615c19383 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -114,7 +114,7 @@ cperl-test-indent-styles ;;; Fontification tests (ert-deftest cperl-test-fontify-punct-vars () - "Test fontification of Perl's punctiation variables. + "Test fontification of Perl's punctuation variables. Perl has variable names containing unbalanced quotes for the list separator $\" and pre- and postmatch $` and $'. A reference to these variables, for example \\$\", should not cause the dollar