commit 1518fc5d7c5bedbbe35053696c7ec06020c81b05 (HEAD, refs/remotes/origin/master) Merge: 083f7c753cf 973c1d24c6a Author: Stefan Kangas Date: Thu Feb 9 06:30:12 2023 +0100 Merge from origin/emacs-29 973c1d24c6a ruby-ts-mode: Also don't reindent 'identifier' when insid... a5651c0c403 ruby-ts-mode: Fix indentation inside empty if/unless/case... 0ec0a610ed2 * lisp/iimage.el (iimage-mode-buffer): Handle multiple re... d11d7aee1a6 ; Fix memory leak in treesit.c commit 083f7c753cf8eefbf8b7add5a598d55cdb9043b0 Merge: f0a6b64e9d6 21f3c7ef269 Author: Stefan Kangas Date: Thu Feb 9 06:30:12 2023 +0100 ; Merge from origin/emacs-29 The following commit was skipped: 21f3c7ef269 * lisp/edmacro.el (edit-kbd-macro): Fix thinko (bug#61333) commit f0a6b64e9d632e1afdabc640b99f80c6bbd3158e Merge: 680bc20553e 31bf35935f2 Author: Stefan Kangas Date: Thu Feb 9 06:30:12 2023 +0100 Merge from origin/emacs-29 31bf35935f2 ; Fix doc strings in iimage.el commit 973c1d24c6ab7515da7cda56200f7b8a1d91ad2f Author: Dmitry Gutov Date: Thu Feb 9 04:48:25 2023 +0200 ruby-ts-mode: Also don't reindent 'identifier' when inside ERROR * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules): Also don't reindent 'identifier' when inside ERROR. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 20ffb38fb88..01b0cd784a3 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -571,7 +571,7 @@ ruby-ts--indent-rules ;; Incomplete buffer state, better not reindent (bug#61017). ((and (parent-is "ERROR") (or (node-is ,ruby-ts--class-or-module-regex) - (node-is "\\`def\\'"))) + (node-is "\\`\\(?:def\\|identifier\\)\\'"))) no-indent 0) ;; if then else elseif notes: commit a5651c0c403bb6513e235056d787611059f6d568 Author: Dmitry Gutov Date: Thu Feb 9 04:15:41 2023 +0200 ruby-ts-mode: Fix indentation inside empty if/unless/case/def * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules): Add new rule. * test/lisp/progmodes/ruby-ts-mode-tests.el (ruby-ts-indent-empty-if-else): New test. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index e83bc2f9e11..20ffb38fb88 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -661,6 +661,13 @@ ruby-ts--indent-rules ((n-p-gp nil "body_statement" ,ruby-ts--method-regex) ;other statements (ruby-ts--align-keywords ruby-ts--grand-parent-node) ruby-indent-level) + ;; Quirk of the ruby parser: these "alignable" nodes don't + ;; have the "container" child node when there are no + ;; statements inside. Thus we have to have a separate rule + ;; for the "empty if/unless/case/def" situation. + ((match "\\`\\'" "\\`\\(?:if\\|unless\\|case\\|method\\)\\'") + (ruby-ts--align-keywords ruby-ts--parent-node) ruby-indent-level) + ;; Chained calls: ;; if `ruby-align-chained-calls' is true, the first query ;; matches and the node is aligned under the first dot (.); diff --git a/test/lisp/progmodes/ruby-ts-mode-tests.el b/test/lisp/progmodes/ruby-ts-mode-tests.el index 18e3e60a04a..c99e1a43063 100644 --- a/test/lisp/progmodes/ruby-ts-mode-tests.el +++ b/test/lisp/progmodes/ruby-ts-mode-tests.el @@ -122,6 +122,22 @@ ruby-ts-indent-call-no-args (funcall indent-line-function) (should (= (current-indentation) ruby-indent-level)))) +(ert-deftest ruby-ts-indent-empty-if-else () + (skip-unless (treesit-ready-p 'ruby t)) + (let* ((str "c = if foo + zz + else + zz + end +")) + (ruby-ts-with-temp-buffer str + (goto-char (point-min)) + (dotimes (_ 2) + (re-search-forward "^ *zz") + (replace-match "") + (funcall indent-line-function) + (should (= (current-indentation) 6)))))) + (ert-deftest ruby-ts-add-log-current-method-examples () (skip-unless (treesit-ready-p 'ruby t)) (let ((pairs '(("foo" . "#foo") commit 0ec0a610ed226419269f519021cbe8fb2dde2ed5 Author: LensPlaysGames Date: Wed Feb 8 20:56:48 2023 +0200 * lisp/iimage.el (iimage-mode-buffer): Handle multiple regexps. Go to the beginning of the buffer before searching every regexp in iimage-mode-image-regex-alist. Copyright-paperwork-exempt: yes diff --git a/lisp/iimage.el b/lisp/iimage.el index d7026331440..b4c175a7b63 100644 --- a/lisp/iimage.el +++ b/lisp/iimage.el @@ -118,8 +118,8 @@ iimage-mode-buffer file) (with-silent-modifications (save-excursion - (goto-char (point-min)) (dolist (pair iimage-mode-image-regex-alist) + (goto-char (point-min)) (while (re-search-forward (car pair) nil t) (when (and (setq file (match-string (cdr pair))) (setq file (locate-file file image-path))) commit d11d7aee1a6f4d675214353204a6f5655c1caa4b Author: Eli Zaretskii Date: Wed Feb 8 18:40:50 2023 +0200 ; Fix memory leak in treesit.c * src/treesit.c (treesit_load_language): Fix a memory leak. Reported by Eric Gillespie . diff --git a/src/treesit.c b/src/treesit.c index b15d44fca01..cfa3721b5e7 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -617,10 +617,14 @@ treesit_load_language (Lisp_Object language_symbol, eassume (handle != NULL); dynlib_error (); TSLanguage *(*langfn) (void); - char *c_name = xstrdup (SSDATA (base_name)); - treesit_symbol_to_c_name (c_name); + char *c_name; if (found_override) c_name = xstrdup (SSDATA (override_c_name)); + else + { + c_name = xstrdup (SSDATA (base_name)); + treesit_symbol_to_c_name (c_name); + } langfn = dynlib_sym (handle, c_name); xfree (c_name); error = dynlib_error (); commit 21f3c7ef269ddb83ed116ddc52b7ace72799d629 Author: Stefan Monnier Date: Tue Feb 7 18:10:33 2023 -0500 * lisp/edmacro.el (edit-kbd-macro): Fix thinko (bug#61333) Backported from commit 2273cdb40e1939f7c29a669f6a64e6a27738c1a5. diff --git a/lisp/edmacro.el b/lisp/edmacro.el index c0723dc8dfe..c995e2f89d7 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -156,9 +156,9 @@ edit-kbd-macro (setq mac cmd) (setq cmd nil))) (when (kmacro-p mac) - (setq mac (kmacro--keys mac) - mac-counter (kmacro--counter mac) - mac-format (kmacro--format mac))) + (setq mac-counter (kmacro--counter mac) + mac-format (kmacro--format mac) + mac (kmacro--keys mac))) (unless (arrayp mac) (error "Key sequence %s is not a keyboard macro" (key-description keys))) commit 31bf35935f2e1e8d19462e984549da1baf9befb6 Author: Eli Zaretskii Date: Wed Feb 8 14:56:42 2023 +0200 ; Fix doc strings in iimage.el * lisp/iimage.el (iimage-mode-image-regex-alist) (iimage-modification-hook): Doc fixes. diff --git a/lisp/iimage.el b/lisp/iimage.el index 96ab963bff4..d7026331440 100644 --- a/lisp/iimage.el +++ b/lisp/iimage.el @@ -64,9 +64,15 @@ iimage-mode-image-regex-alist `((,(concat "\\(`?file://\\|\\[\\[\\|<\\|`\\)?" "\\(" iimage-mode-image-filename-regex "\\)" "\\(\\]\\]\\|>\\|'\\)?") . 2)) - "Alist of filename REGEXP vs NUM. -Each element looks like (REGEXP . NUM). -NUM specifies which parenthesized expression in the regexp. + "Alist that specifies how to detect filenames of images to be displayed inline. +The value should be an alist whose elements have the form + + (REGEXP . NUM) + +where REGEXP is a regular expression to search buffer text for what +might be a specification of an inline image, and NUM is the number +of a parenthesized sub-expression of REGEXP which gives the name of +the image file to look up. Examples of image filename patterns to match: file://foo.png @@ -93,7 +99,7 @@ turn-off-iimage-mode (iimage-mode 0)) (defun iimage-modification-hook (beg end) - "Remove display property if a display region is modified." + "Remove display property if a display region BEG..END is modified." ;;(debug-print "ii1 begin %d, end %d\n" beg end) (let ((inhibit-modification-hooks t) (beg (previous-single-property-change end 'display commit 680bc20553ebf01375ab7957b6f0be066335fd6e Author: Mattias Engdegård Date: Wed Feb 8 13:45:57 2023 +0100 Flatten nested `concat` calls * lisp/emacs-lisp/byte-opt.el (byte-optimize-concat): Flatten nested forms; concat is associative. This reduces the number of calls and may coalesce adjacent constant strings. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index b7e21db688f..3eef8f385b5 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1132,21 +1132,31 @@ byte-optimize-memq form)) (defun byte-optimize-concat (form) - "Merge adjacent constant arguments to `concat'." + "Merge adjacent constant arguments to `concat' and flatten nested forms." (let ((args (cdr form)) (newargs nil)) (while args - (let ((strings nil) - val) - (while (and args (macroexp-const-p (car args)) - (progn - (setq val (byteopt--eval-const (car args))) - (and (or (stringp val) - (and (or (listp val) (vectorp val)) - (not (memq nil - (mapcar #'characterp val)))))))) - (push val strings) - (setq args (cdr args))) + (let ((strings nil)) + (while + (and args + (let ((arg (car args))) + (pcase arg + ;; Merge consecutive constant arguments. + ((pred macroexp-const-p) + (let ((val (byteopt--eval-const arg))) + (and (or (stringp val) + (and (or (listp val) (vectorp val)) + (not (memq nil + (mapcar #'characterp val))))) + (progn + (push val strings) + (setq args (cdr args)) + t)))) + ;; Flatten nested `concat' form. + (`(concat . ,nested-args) + (setq args (append nested-args (cdr args))) + t))))) + (when strings (let ((s (apply #'concat (nreverse strings)))) (when (not (zerop (length s))) commit f3fce3a71c7571be19a451403b46fa667bfa3c16 Author: Mattias Engdegård Date: Wed Feb 8 13:18:32 2023 +0100 Simplify and speed up parts of elisp optimiser * lisp/emacs-lisp/byte-opt.el (byte-optimize-constant-args): Simplify. (byte-optimize--constant-symbol-p): Speed up. (byteopt--eval-const): New. (byte-optimize-member, byte-optimize-concat, byte-optimize-append): Use byteopt--eval-const instead of eval which is much slower. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index e0c769c7e60..b7e21db688f 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1019,16 +1019,14 @@ byte-opt--nary-comparison (t form)))) (defun byte-optimize-constant-args (form) - (let ((ok t) - (rest (cdr form))) - (while (and rest ok) - (setq ok (macroexp-const-p (car rest)) - rest (cdr rest))) - (if ok - (condition-case () - (list 'quote (eval form)) - (error form)) - form))) + (let ((rest (cdr form))) + (while (and rest (macroexp-const-p (car rest))) + (setq rest (cdr rest))) + (if rest + form + (condition-case () + (list 'quote (eval form t)) + (error form))))) (defun byte-optimize-identity (form) (if (and (cdr form) (null (cdr (cdr form)))) @@ -1036,8 +1034,19 @@ byte-optimize-identity form)) (defun byte-optimize--constant-symbol-p (expr) - "Whether EXPR is a constant symbol." - (and (macroexp-const-p expr) (symbolp (eval expr)))) + "Whether EXPR is a constant symbol, like (quote hello), nil, t, or :keyword." + (if (consp expr) + (and (memq (car expr) '(quote function)) + (symbolp (cadr expr))) + (or (memq expr '(nil t)) + (keywordp expr)))) + +(defsubst byteopt--eval-const (expr) + "Evaluate EXPR which must be a constant (quoted or self-evaluating). +Ie, (macroexp-const-p EXPR) must be true." + (if (consp expr) + (cadr expr) ; assumed to be 'VALUE or #'SYMBOL + expr)) (defun byte-optimize--fixnump (o) "Return whether O is guaranteed to be a fixnum in all Emacsen. @@ -1074,7 +1083,7 @@ byte-optimize-member (byte-optimize--fixnump (nth 1 form)) (let ((arg2 (nth 2 form))) (and (macroexp-const-p arg2) - (let ((listval (eval arg2))) + (let ((listval (byteopt--eval-const arg2))) (and (listp listval) (not (memq nil (mapcar (lambda (o) @@ -1131,7 +1140,7 @@ byte-optimize-concat val) (while (and args (macroexp-const-p (car args)) (progn - (setq val (eval (car args))) + (setq val (byteopt--eval-const (car args))) (and (or (stringp val) (and (or (listp val) (vectorp val)) (not (memq nil @@ -1528,7 +1537,7 @@ byte-optimize-append (cond ((macroexp-const-p arg) ;; constant arg - (let ((val (eval arg))) + (let ((val (byteopt--eval-const arg))) (cond ;; Elide empty arguments (nil, empty string, etc). ((zerop (length val)) @@ -1538,7 +1547,7 @@ byte-optimize-append (loop (cdr args) (cons (list 'quote - (append (eval prev) val nil)) + (append (byteopt--eval-const prev) val nil)) (cdr newargs)))) (t (loop (cdr args) (cons arg newargs)))))) commit 643a11c6e5defc0a34da1a53b64aa1e097298923 Author: Juri Linkov Date: Wed Feb 8 09:34:49 2023 +0200 * lisp/progmodes/xref.el (xref--insert-xrefs): Remove extra space (bug#61340). diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 4db0df6c3b8..63e065e696e 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1126,7 +1126,7 @@ xref--insert-xrefs maximize (xref-location-line (xref-item-location xref))) for line-format = (and max-line - (format "%%%dd: " (1+ (floor (log max-line 10))))) + (format "%%%dd:" (1+ (floor (log max-line 10))))) with item-text-props = (list 'mouse-face 'highlight 'keymap xref--button-map 'help-echo commit d492be400e1676cee68432a1dc1009a0fa8b9a2b Merge: 2273cdb40e1 c9ba05af8df Author: Stefan Kangas Date: Wed Feb 8 06:30:15 2023 +0100 Merge from origin/emacs-29 c9ba05af8df Fix crashes inside 'xfree' called from treesit.c 746748f5c28 Make java-ts-mode use the c-ts-common-indent-type-regexp-... 87d39a30b12 Fix c-ts-mode indentation 7cb92b53987 Fix c-ts-mode indentation d68ff6016d0 Fix c-ts-mode indentation (bug#61291) 2ac8c4bbd6f (eglot-completion-at-point): Return correct values in :co... 321cbd9a601 Tighten and simplify typescript compilation-mode regexps ... 97533e73ad6 ; * lisp/progmodes/c-ts-common.el (treesit-node-prev-sibl... 9dfccb89fc5 Clarify bug-reference-auto-setup-functions docstring. 17ab426670a * lisp/treesit.el (treesit): Fix shortdoc example form (b... 5a6dfab1e4d Use c-ts-common-statement-offset in java-ts-mode (bug#61142) c3262216abb Add array_initializer to java-ts-mode 79ab62e0bb5 go-ts-mode: Highlight variable declarations 1fab91d852e go-ts-mode: Fix highlighting of function name in call_exp... 07ffe902c63 c-ts-mode: Highlight "property functions" as functions a529b0d6463 rust-ts-mode: Fix highlighting of function name in call_e... 088425538f2 rust-ts-mode--font-lock-settings: Improve consistency 793c24a6ac7 Make sure 'M-x show-paren-local-mode' turns on right away 60089dcfe06 Add to bug-reference-auto-setup-functions after its decla... 26e947ccb14 * lisp/vc/vc.el (vc-find-revision-no-save): Fix parens (b... 948e343496b ; Fix byte-compilation warning 6568a1aaf9a Fix inability to turn show-paren-local-mode on manually (... 24085ba6105 ; go-ts-mode--indent-rules: Indent to 0 at top level 0862a79fef5 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/... bb999df5d6f ; Fix whitespace of last change 929daafa1d6 ; Fix trivial mistake in emoji--choose-emoji d7b4a8487f6 ; * lisp/isearch.el (emoji--read-emoji): Avoid compilatio... e38ff004631 rust-ts-mode: Highlight variable declarations d12727057d4 rust-ts-mode--indent-rules: Indent to 0 at top level 85705a7059f ; Move misplaces parenthesis in emoji--choose-emoji 18c43bb9d6c Ensure upper bound of font-lock region is less than point... 94f291d1505 ; * lisp/paren.el (show-paren-predicate): Doc fix. (Bug#... 3ffd0eddce6 Highlight more complex function parameters 58dc03ba7e4 No longer use transient in isearch-emoji-by-name 0c125fcc67a Make highlighting more regular across TS modes (bug#61205) 1dd751c3ac4 ; Improve documentation of 'proper-list-p' 96181ed3f09 Document 'plistp' 03d9d18513b Fix display of raised/lowered composed text f13479d9556 Fix installation of tree-sitter grammar on MS-Windows 0358267204d Update the Emacs FAQ for Emacs 29 2c33e2889b4 Fix byte-compilation of *-ts-mode.el files b40a929a3f2 ; ruby-ts--syntax-propertize: Amend commentary b80f36b88c7 Make c-ts-mode-set-style's effect local (bug#61245) 671e5d9fad5 ; * lisp/treesit.el (treesit--font-lock-level-setter): Mi... 69380a88e92 c-ts-mode: Highlight name in parameter declarations 89b550eac29 Fix switch statement indentation for go-ts-mode (bug#61238) 1a123feb181 Fix bidi reordering of sequence of whitespace characters ... 8870b54db99 Add tests for compilation support for TypeScript (bug#61104) 873a0a15085 Add support for TypeScript compilation to compile.el (bug... 3a64f81ebc1 Don't clobber match data in 'y-or-n-p' 4c765d93ab3 Refine the previous change d99b5151f8c Add syntax-propertize-function to ruby-ts-mode f25c15ceb7d ; Fix typos 35e238cae8b Improve documentation of 'header-line-indent-mode' c3f58a66514 Don't casemap erc-sasl-user when set to :nick e444115d026 Improve keymap-global-set and keymap-local-set interactiv... # Conflicts: # etc/NEWS commit 2273cdb40e1939f7c29a669f6a64e6a27738c1a5 Author: Stefan Monnier Date: Tue Feb 7 18:10:33 2023 -0500 * lisp/edmacro.el (edit-kbd-macro): Fix thinko (bug#61333) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index c0723dc8dfe..c995e2f89d7 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -156,9 +156,9 @@ edit-kbd-macro (setq mac cmd) (setq cmd nil))) (when (kmacro-p mac) - (setq mac (kmacro--keys mac) - mac-counter (kmacro--counter mac) - mac-format (kmacro--format mac))) + (setq mac-counter (kmacro--counter mac) + mac-format (kmacro--format mac) + mac (kmacro--keys mac))) (unless (arrayp mac) (error "Key sequence %s is not a keyboard macro" (key-description keys))) commit 88d5327fe2ab6ecfde22fee8835c583bfd1f2ce2 Author: Stefan Monnier Date: Tue Feb 7 18:03:22 2023 -0500 (cconv-convert): Fix regression * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyze-form): Since we can't always remove the wrapper, make sure the wrapper accepts the expected calling convention (i.e. called with no args). diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index e8d639903c1..570c9e66060 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -483,7 +483,7 @@ cconv-convert (bf (if (stringp (car body)) (cdr body) body)) (if (when (eq 'interactive (car-safe (car bf))) (gethash form cconv--interactive-form-funs))) - (wrapped (pcase if (`#'(lambda (_cconv--dummy) .,_) t) (_ nil))) + (wrapped (pcase if (`#'(lambda (&rest _cconv--dummy) .,_) t) (_ nil))) (cif (when if (cconv-convert if env extend))) (_ (pcase cif ('nil nil) @@ -747,7 +747,7 @@ cconv-analyze-form (let ((if (cadr (car bf)))) (unless (macroexp-const-p if) ;Optimize this common case. (let ((f (if (eq 'function (car-safe if)) if - `#'(lambda (_cconv--dummy) ,if)))) + `#'(lambda (&rest _cconv--dummy) ,if)))) (setf (gethash form cconv--interactive-form-funs) f) (cconv-analyze-form f env)))))) (cconv--analyze-function vrs body-forms env form)) commit c9ba05af8dfabca00023bd2312dec4ec59497801 Author: Eli Zaretskii Date: Tue Feb 7 21:53:05 2023 +0200 Fix crashes inside 'xfree' called from treesit.c * src/treesit.c (treesit_load_language): Always xstrdup 'c_name', to avoid crashes inside xfree. (Bug#61351) diff --git a/src/treesit.c b/src/treesit.c index 8e772523cc7..b15d44fca01 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -620,7 +620,7 @@ treesit_load_language (Lisp_Object language_symbol, char *c_name = xstrdup (SSDATA (base_name)); treesit_symbol_to_c_name (c_name); if (found_override) - c_name = SSDATA (override_c_name); + c_name = xstrdup (SSDATA (override_c_name)); langfn = dynlib_sym (handle, c_name); xfree (c_name); error = dynlib_error (); commit a98d0daac473737da720c20f49f6f5abf36b074b Author: Mattias Engdegård Date: Tue Feb 7 13:16:40 2023 +0100 Remove unnecessary cons in lexical eval * src/eval.c (list_of_t): New. (Feval): Use list_of_t instead of consing every time. (syms_of_eval): Set list_of_t to (t) and staticpro it. diff --git a/src/eval.c b/src/eval.c index d42f7ffe894..e377e30c6fb 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2348,6 +2348,8 @@ DEFUN ("autoload-do-load", Fautoload_do_load, Sautoload_do_load, 1, 3, 0, } +static Lisp_Object list_of_t; /* Never-modified constant containing (t). */ + DEFUN ("eval", Feval, Seval, 1, 2, 0, doc: /* Evaluate FORM and return its value. If LEXICAL is t, evaluate using lexical scoping. @@ -2357,7 +2359,7 @@ DEFUN ("eval", Feval, Seval, 1, 2, 0, { specpdl_ref count = SPECPDL_INDEX (); specbind (Qinternal_interpreter_environment, - CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt)); + CONSP (lexical) || NILP (lexical) ? lexical : list_of_t); return unbind_to (count, eval_sub (form)); } @@ -4392,6 +4394,9 @@ syms_of_eval (void) Qcatch_all_memory_full = Fmake_symbol (build_pure_c_string ("catch-all-memory-full")); + staticpro (&list_of_t); + list_of_t = list1 (Qt); + defsubr (&Sor); defsubr (&Sand); defsubr (&Sif); commit 22f0159c5aa8aca3d650505b41adfbd03f719b11 Author: Michael Albinus Date: Tue Feb 7 19:28:15 2023 +0100 Fix last Tramp commit * lisp/net/tramp.el (tramp-completion-file-name-handler): Run only when `minibuffer-completing-file-name' is non-nil. * test/lisp/net/tramp-tests.el (tramp-test26-file-name-completion): Fix test. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 69812506e48..b75a1816fdb 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2773,7 +2773,7 @@ tramp-completion-file-name-handler "Invoke Tramp file name completion handler for OPERATION and ARGS. Falls back to normal file name handler if no Tramp file name handler exists." (if-let - ((fn (and tramp-mode + ((fn (and tramp-mode minibuffer-completing-file-name (assoc operation tramp-completion-file-name-handler-alist)))) (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d903ba626b9..eea59843d47 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4524,7 +4524,8 @@ tramp-test26-file-name-completion (let ((tramp-fuse-remove-hidden-files t) (method (file-remote-p ert-remote-temporary-file-directory 'method)) (host (file-remote-p ert-remote-temporary-file-directory 'host)) - (orig-syntax tramp-syntax)) + (orig-syntax tramp-syntax) + (minibuffer-completing-file-name t)) (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) (setq host (match-string 1 host))) commit 746748f5c283b98a221571e725833affe304a748 Author: Yuan Fu Date: Mon Feb 6 18:48:04 2023 -0800 Make java-ts-mode use the c-ts-common-indent-type-regexp-alist * lisp/progmodes/java-ts-mode.el: (java-ts-mode): Setup c-ts-common-indent-type-regexp-alist. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 1d7bdb07224..dc651c11a00 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -303,20 +303,22 @@ java-ts-mode (c-ts-common-comment-setup) ;; Indent. - (setq-local c-ts-common-indent-block-type-regexp - (regexp-opt '("class_body" - "array_initializer" - "constructor_body" - "annotation_type_body" - "interface_body" - "enum_body" - "switch_block" - "record_declaration_body" - "block"))) - (setq-local c-ts-common-indent-bracketless-type-regexp - (regexp-opt '("if_statement" - "for_statement" - "while_statement"))) + (setq-local c-ts-common-indent-type-regexp-alist + `((block . ,(rx (or "class_body" + "array_initializer" + "constructor_body" + "annotation_type_body" + "interface_body" + "enum_body" + "switch_block" + "record_declaration_body" + "block"))) + (close-bracket . "}") + (if . "if_statement") + (else . ("if_statement" . "alternative")) + (for . "for_statement") + (while . "while_statement") + (do . "do_statement"))) (setq-local c-ts-common-indent-offset 'java-ts-mode-indent-offset) (setq-local treesit-simple-indent-rules java-ts-mode--indent-rules) commit 87d39a30b1264e111cfd2f9cbdc95dcd0870684b Author: Yuan Fu Date: Sun Feb 5 19:32:24 2023 -0800 Fix c-ts-mode indentation Sign, ok, there's another edge case: else if statements. Because "else if" is usually implemented as just another if statement nested in the else branch, this creates additional levels that indentation needs to ignore. I converted c-ts-common-indent-block-type-regexp + c-ts-common-indent-bracketless-type-regexp into a new, more flexible variable, c-ts-common-indent-type-regexp-alist, to avoid adding yet more variables in order to recognize else and if statements. * lisp/progmodes/c-ts-common.el: (c-ts-common-indent-type-regexp-alist): New variable. (c-ts-common-indent-block-type-regexp) (c-ts-common-indent-bracketless-type-regexp): Remove variables. (c-ts-common--node-is): New function. (c-ts-common-statement-offset): Use the new variable, and add the "else if" special case. Also merge the code of c-ts-mode--fix-bracketless-indent, because now the code is much more succinct. (c-ts-mode--fix-bracketless-indent): Merge into c-ts-common-statement-offset. * lisp/progmodes/c-ts-mode.el: (c-ts-base-mode): Setup c-ts-common-indent-type-regexp-alist. * test/lisp/progmodes/c-ts-mode-resources/indent.erts: New test. diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 0b0a7ff7cd3..8262e6261d4 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -267,33 +267,52 @@ c-ts-common-indent-offset particular major mode. This cannot be nil for `c-ts-common' statement indent functions to work.") -(defvar c-ts-common-indent-block-type-regexp nil - "Regexp matching types of block nodes (i.e., {} blocks). +(defvar c-ts-common-indent-type-regexp-alist nil + "An alist of of node type regexps. -This cannot be nil for `c-ts-common' statement indent functions -to work.") +Each key in the alist is one of `if', `else', `do', `while', +`for', `block', `close-bracket'. Each value in the alist +is the regexp matching the type of that kind of node. Most of +these types are self-explanatory, e.g., `if' corresponds to +\"if_statement\" in C. `block' corresponds to the {} block. -(defvar c-ts-common-indent-bracketless-type-regexp nil - "A regexp matching types of bracketless constructs. +Some types, specifically `else', is usually not identified by a +standalone node, but a child under the \"if_statement\", under a +field name like \"alternative\", etc. In that case, use a +cons (TYPE . FIELD-NAME) as the value, where TYPE is the node's +parent's type, and FIELD-NAME is the field name of the node. -These constructs include if, while, do-while, for statements. In -these statements, the body can omit the bracket, which requires -special handling from our bracket-counting indent algorithm. +If the language doesn't have a particular type, it is fine to +omit it.") -This can be nil, meaning such special handling is not needed.") +(defun c-ts-common--node-is (node &rest types) + "Return non-nil if NODE is any one of the TYPES. -(defvar c-ts-common-if-statement-regexp "if_statement" - "Regexp used to select an if statement in a C like language. +TYPES can be any of `if', `else', `while', `do', `for', and +`block'. -This can be set to a different regexp if needed.") - -(defvar c-ts-common-nestable-if-statement-p t - "Does the current parser nest if-else statements? - -t if the current tree-sitter grammar nests the else if -statements, nil otherwise.") - -(defun c-ts-common-statement-offset (node parent bol &rest _) +If NODE is nil, return nil." + (declare (indent 2)) + (catch 'ret + (when (null node) + (throw 'ret nil)) + (dolist (type types) + (let ((regexp (alist-get + type c-ts-common-indent-type-regexp-alist)) + (parent (treesit-node-parent node))) + (when (and regexp + (if (consp regexp) + (and parent + (string-match-p (car regexp) + (treesit-node-type parent)) + (string-match-p (cdr regexp) + (treesit-node-field-name + node))) + (string-match-p regexp (treesit-node-type node)))) + (throw 'ret t)))) + nil)) + +(defun c-ts-common-statement-offset (node parent &rest _) "This anchor is used for children of a statement inside a block. This function basically counts the number of block nodes (i.e., @@ -311,10 +330,7 @@ c-ts-common-statement-offset ;; If NODE is a opening/closing bracket on its own line, take off ;; one level because the code below assumes NODE is a statement ;; _inside_ a {} block. - (when (and node - (or (string-match-p c-ts-common-indent-block-type-regexp - (treesit-node-type node)) - (save-excursion (goto-char bol) (looking-at-p "}")))) + (when (c-ts-common--node-is node 'block 'close-bracket) (cl-decf level)) ;; If point is on an empty line, NODE would be nil, but we pretend ;; there is a statement node. @@ -324,69 +340,35 @@ c-ts-common-statement-offset (while (if (eq node t) (setq node parent) node) - ;; Subtract one indent level if the language nests - ;; if-statements and node is if_statement. - (setq level (c-ts-common--fix-nestable-if-statement level node)) - (when (string-match-p c-ts-common-indent-block-type-regexp - (treesit-node-type node)) - (cl-incf level) - (save-excursion - (goto-char (treesit-node-start node)) - ;; Add an extra level if the opening bracket is on its own - ;; line, except (1) it's at top-level, or (2) it's immediate - ;; parent is another block. - (cond ((bolp) nil) ; Case (1). - ((let ((parent-type (treesit-node-type - (treesit-node-parent node)))) - ;; Case (2). - (and parent-type - (string-match-p - c-ts-common-indent-block-type-regexp - parent-type))) - nil) - ;; Add a level. - ((looking-back (rx bol (* whitespace)) - (line-beginning-position)) - (cl-incf level))))) - (setq level (c-ts-mode--fix-bracketless-indent level node)) + (let ((parent (treesit-node-parent node))) + ;; Increment level for every bracket (with exception). + (when (c-ts-common--node-is node 'block) + (cl-incf level) + (save-excursion + (goto-char (treesit-node-start node)) + ;; Add an extra level if the opening bracket is on its own + ;; line, except (1) it's at top-level, or (2) it's immediate + ;; parent is another block. + (cond ((bolp) nil) ; Case (1). + ((c-ts-common--node-is parent 'block) ; Case (2). + nil) + ;; Add a level. + ((looking-back (rx bol (* whitespace)) + (line-beginning-position)) + (cl-incf level))))) + ;; Fix bracketless statements. + (when (and (c-ts-common--node-is parent + 'if 'do 'while 'for) + (not (c-ts-common--node-is node 'block))) + (cl-incf level)) + ;; Flatten "else if" statements. + (when (and (c-ts-common--node-is node 'else) + (c-ts-common--node-is node 'if)) + (cl-decf level))) ;; Go up the tree. (setq node (treesit-node-parent node))) (* level (symbol-value c-ts-common-indent-offset)))) -(defun c-ts-mode--fix-bracketless-indent (level node) - "Takes LEVEL and NODE and return adjusted LEVEL. -This fixes indentation for cases shown in bug#61026. Basically -in C-like syntax, statements like if, for, while sometimes omit -the bracket in the body." - (let ((block-re c-ts-common-indent-block-type-regexp) - (statement-re - c-ts-common-indent-bracketless-type-regexp) - (node-type (treesit-node-type node)) - (parent-type (treesit-node-type (treesit-node-parent node)))) - (if (and block-re statement-re node-type parent-type - (not (string-match-p block-re node-type)) - (string-match-p statement-re parent-type)) - (1+ level) - level))) - -(defun c-ts-common--fix-nestable-if-statement (level node) - "Takes LEVEL and NODE and return adjusted LEVEL. -Look at the type of NODE, when it is an if-statement node, as -defined by `c-ts-common-if-statement-regexp' and its parent is -also an if-statement node, subtract one level. Otherwise return -the value unchanged. Whether or not if-statements are nestable -is controlled by `c-ts-common-nestable-if-statement-p'." - ;; This fixes indentation for cases shown in bug#61142. - (or (and node - (equal (treesit-node-type (treesit-node-prev-sibling node)) "else") - (treesit-node-parent node) - c-ts-common-nestable-if-statement-p - (equal (treesit-node-type node) c-ts-common-if-statement-regexp) - (equal (treesit-node-type (treesit-node-parent node)) - c-ts-common-if-statement-regexp) - (cl-decf level)) - level)) - (provide 'c-ts-common) ;;; c-ts-common.el ends here diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index f2d5a482009..b898f7d9ee3 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -765,14 +765,16 @@ c-ts-base-mode (when (eq c-ts-mode-indent-style 'linux) (setq-local indent-tabs-mode t)) (setq-local c-ts-common-indent-offset 'c-ts-mode-indent-offset) - (setq-local c-ts-common-indent-block-type-regexp - (rx (or "compound_statement" - "field_declaration_list" - "enumerator_list"))) - (setq-local c-ts-common-indent-bracketless-type-regexp - (rx (or "if_statement" "do_statement" - "for_statement" "while_statement"))) - + (setq-local c-ts-common-indent-type-regexp-alist + `((block . ,(rx (or "compound_statement" + "field_declaration_list" + "enumerator_list"))) + (if . "if_statement") + (else . ("if_statement" . "alternative")) + (do . "do_statement") + (while . "while_statement") + (for . "for_statement") + (close-bracket . "}"))) ;; Comment (c-ts-common-comment-setup) diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index 8c588f56f9a..21b84c2e7e3 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -169,6 +169,19 @@ do while (true) =-=-= +Name: Nested If-Else + +=-= +if (true) + return 0; +else if (false) + return 1; +else if (true) + return 2; +else if (false) + return 3; +=-=-= + Name: Multiline Block Comments 1 (bug#60270) =-= commit 7cb92b5398771b088450942d9eaefd53b5f91cf6 Author: Yuan Fu Date: Sun Feb 5 17:05:21 2023 -0800 Fix c-ts-mode indentation Turns out I shouldn't have removed the explicit rules. Anyway, now it indents properly. * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Add rules. * test/lisp/progmodes/c-ts-mode-resources/indent.erts: Add tests diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 1737b8c5715..f2d5a482009 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -287,6 +287,12 @@ c-ts-mode--indent-styles ((node-is "compound_statement") point-min c-ts-common-statement-offset) ;; Bug#61291. ((match "expression_statement" nil "body") point-min c-ts-common-statement-offset) + ;; These rules are for cases where the body is bracketless. + ;; Tested by the "Bracketless Simple Statement" test. + ((parent-is "if_statement") point-min c-ts-common-statement-offset) + ((parent-is "for_statement") point-min c-ts-common-statement-offset) + ((parent-is "while_statement") point-min c-ts-common-statement-offset) + ((parent-is "do_statement") point-min c-ts-common-statement-offset) ,@(when (eq mode 'cpp) `(((node-is "field_initializer_list") parent-bol ,(* c-ts-mode-indent-offset 2))))))) diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index 2750526f893..8c588f56f9a 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -155,6 +155,20 @@ for (int i = 0; ; =-=-= +Name: Bracketless Simple Statement + +=-= +for (int i = 0; i < 5; i++) + continue; + +while (true) + return 1; + +do + i++; +while (true) +=-=-= + Name: Multiline Block Comments 1 (bug#60270) =-= commit d68ff6016d0ca011b5bf0fd05578fe1abb2e53a9 Author: Yuan Fu Date: Sun Feb 5 15:20:52 2023 -0800 Fix c-ts-mode indentation (bug#61291) Fix indentation for the semicolon in while (str_a[i++] == str_b[j++]) ; * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): New rule. * test/lisp/progmodes/c-ts-mode-resources/indent.erts: New test. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 93816081666..1737b8c5715 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -285,6 +285,8 @@ c-ts-mode--indent-styles ((node-is "}") point-min c-ts-common-statement-offset) ;; Opening bracket. ((node-is "compound_statement") point-min c-ts-common-statement-offset) + ;; Bug#61291. + ((match "expression_statement" nil "body") point-min c-ts-common-statement-offset) ,@(when (eq mode 'cpp) `(((node-is "field_initializer_list") parent-bol ,(* c-ts-mode-indent-offset 2))))))) diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index 6f64e1e7953..2750526f893 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -144,6 +144,17 @@ int f2(int x, }; =-=-= +Name: Semi-colon in While Loop (bug#61291) + +=-= +while (true) + ; +for (int i = 0; + i < 5; + i++) + ; +=-=-= + Name: Multiline Block Comments 1 (bug#60270) =-= commit 2ac8c4bbd6f47751a68b0230310f6fddd7da8de5 Author: Dmitry Gutov Date: Tue Feb 7 00:28:25 2023 +0200 (eglot-completion-at-point): Return correct values in :company-kind * lisp/progmodes/eglot.el (eglot-completion-at-point): Return the correct values in :company-kind for "EnumMember" and "TypeParameter". The convention is to use kebab case rather than plain downcasing. Reported in https://github.com/company-mode/company-mode/issues/1370. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 3fc1d68422a..c906890c949 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2873,7 +2873,10 @@ eglot-completion-at-point (when-let* ((lsp-item (get-text-property 0 'eglot--lsp-item proxy)) (kind (alist-get (plist-get lsp-item :kind) eglot--kind-names))) - (intern (downcase kind)))) + (pcase kind + ("EnumMember" 'enum-member) + ("TypeParameter" 'type-parameter) + (_ (intern (downcase kind)))))) :company-deprecated (lambda (proxy) (when-let ((lsp-item (get-text-property 0 'eglot--lsp-item proxy))) commit 907fd1f7ff402f9d226ebb3b891ea5b54fac1d1c Author: Michael Albinus Date: Mon Feb 6 18:13:22 2023 +0100 Improve Tramp file name completion This fixes Bug#51386, Bug#52758, Bug#53513, Bug#54042 and Bug#60505. * doc/misc/tramp.texi (File name completion): Remove completion styles restrictions. * lisp/minibuffer.el (completion-styles): Fix docstring. * lisp/net/tramp.el (tramp-methods) <->: Add. (tramp-completion-file-name-handler-alist): Add `expand-file-name', `file-exists-p', `file-name-directory' and `file-name-nondirectory'. (tramp-dissect-file-name): Do not extra check for `tramp-default-method-marker'. (tramp-completion-handle-expand-file-name) (tramp-completion-handle-file-exists-p) (tramp-completion-handle-file-name-directory) (tramp-completion-handle-file-name-nondirectory): New defuns. (tramp-completion-handle-file-name-all-completions): Remove duplicates. * test/lisp/net/tramp-tests.el (tramp-test26-interactive-file-name-completion): New test. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index d344feb2d63..7f6182ae17c 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3469,12 +3469,7 @@ File name completion @value{tramp} can complete the following @value{tramp} file name components: method names, user names, host names, and file names -located on remote hosts. User name and host name completion is -activated only, if file name completion has one of the styles -@code{basic}, @code{emacs21}, or @code{emacs22}. -@ifinfo -@xref{Completion Styles, , , emacs}. -@end ifinfo +located on remote hosts. For example, type @kbd{C-x C-f @value{prefixwithspace} s @key{TAB}}, @value{tramp} completion choices show up as @@ -3508,10 +3503,7 @@ File name completion Type @kbd{s h @value{postfixhop}} for the minibuffer completion to @samp{@value{prefix}ssh@value{postfixhop}}. Typing @kbd{@key{TAB}} shows host names @value{tramp} extracts from @file{~/.ssh/config} -@c bug#50387 -file, for example@footnote{Some completion styles, like -@code{substring} or @code{flex}, require to type at least one -character after the trailing @samp{@value{postfixhop}}.}. +file, for example: @example @group diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 21d4607e7cf..01894689623 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1087,11 +1087,7 @@ completion-styles The available styles are listed in `completion-styles-alist'. Note that `completion-category-overrides' may override these -styles for specific categories, such as files, buffers, etc. - -Note that Tramp host name completion (e.g., \"/ssh:ho\") -currently doesn't work if this list doesn't contain at least one -of `basic', `emacs22' or `emacs21'." +styles for specific categories, such as files, buffers, etc." :type completion--styles-type :version "23.1") diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 21dbd40b1d2..69812506e48 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -441,6 +441,8 @@ tramp-default-method-alist (defconst tramp-default-method-marker "-" "Marker for default method in remote file names.") +(add-to-list 'tramp-methods `(,tramp-default-method-marker)) + (defcustom tramp-default-user nil "Default user to use for transferring files. It is nil by default; otherwise settings in configuration files like @@ -1414,9 +1416,13 @@ tramp-password-prompt-not-unique during direct remote copying with scp.") (defconst tramp-completion-file-name-handler-alist - '((file-name-all-completions + '((expand-file-name . tramp-completion-handle-expand-file-name) + (file-exists-p . tramp-completion-handle-file-exists-p) + (file-name-all-completions . tramp-completion-handle-file-name-all-completions) - (file-name-completion . tramp-completion-handle-file-name-completion)) + (file-name-completion . tramp-completion-handle-file-name-completion) + (file-name-directory . tramp-completion-handle-file-name-directory) + (file-name-nondirectory . tramp-completion-handle-file-name-nondirectory)) "Alist of completion handler functions. Used for file names matching `tramp-completion-file-name-regexp'. Operations not mentioned here will be handled by Tramp's file @@ -1707,7 +1713,6 @@ tramp-dissect-file-name :port port :localname localname :hop hop)) ;; The method must be known. (unless (or nodefault non-essential - (string-equal method tramp-default-method-marker) (assoc method tramp-methods)) (tramp-user-error v "Method `%s' is not known." method)) @@ -2941,6 +2946,50 @@ tramp-connectable-p (and vec (process-live-p (get-process (tramp-buffer-name vec)))) (not non-essential)))) +(defun tramp-completion-handle-expand-file-name (filename &optional directory) + "Like `expand-file-name' for partial Tramp files." + (if (file-name-absolute-p filename) + filename + (concat (or directory default-directory "/") filename))) + +(defun tramp-completion-handle-file-exists-p (filename) + "Like `file-exists-p' for partial Tramp files." + ;; We need special handling only when a method is needed. Then we + ;; regard all files "/method:" or "/[method/" as existent, if + ;; "method" is a valid Tramp method. And we regard all files + ;; "/method:user@host" or "/[method/user@host" as existent, if + ;; "user@host" is a valid file name completion. + (or (and (cond + ;; Completion styles like `flex' and `substring' check for + ;; the file name "/". This does exist. + ((string-equal filename "/")) + ;; Is it a valid method? + ((and (not (string-empty-p tramp-postfix-method-format)) + (string-match + (rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (? (regexp tramp-postfix-method-regexp)) + eos) + filename)) + (assoc (match-string 1 filename) tramp-methods)) + ;; Is it a valid user@host? + ((string-match + (rx + (regexp tramp-prefix-regexp) + (group (regexp tramp-remote-file-name-spec-regexp)) + eos) + filename) + (member + (concat + (file-name-nondirectory filename) tramp-postfix-host-format) + (file-name-all-completions + (file-name-nondirectory filename) + (file-name-directory filename))))) + t) + + (tramp-run-real-handler #'file-exists-p (list filename)))) + ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of ;; `tramp-file-name' structures. For all of them we return possible @@ -3014,11 +3063,12 @@ tramp-completion-handle-file-name-all-completions result1))) ;; Complete local parts. - (append - result1 - (ignore-errors - (tramp-run-real-handler - #'file-name-all-completions (list filename directory)))))) + (delete-dups + (append + result1 + (ignore-errors + (tramp-run-real-handler + #'file-name-all-completions (list filename directory))))))) ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion @@ -3176,6 +3226,34 @@ tramp-get-completion-user-host (unless (zerop (+ (length user) (length host))) (tramp-completion-make-tramp-file-name method user host nil))) +(defun tramp-completion-handle-file-name-directory (filename) + "Like `file-name-directory' for partial Tramp files." + ;; We need special handling only when a method is needed. Then we + ;; return "/method:" or "/[method/", if "method" is a valid Tramp + ;; method. In the `separate' file name syntax, we return "/[" when + ;; `filename' is "/[string" w/o a trailing method separator "/". + (cond + ((and (not (string-empty-p tramp-method-regexp)) + (string-match + (rx (group + (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp))) + filename) + ;; Is it a valid method? + (assoc (match-string 2 filename) tramp-methods)) + (match-string 1 filename)) + ((string-match + (rx (group (regexp tramp-prefix-regexp)) + (regexp tramp-completion-method-regexp) eos) + filename) + (match-string 1 filename)) + (t (tramp-run-real-handler #'file-name-directory (list filename))))) + +(defun tramp-completion-handle-file-name-nondirectory (filename) + "Like `file-name-nondirectory' for partial Tramp files." + (tramp-compat-string-replace (file-name-directory filename) "" filename)) + (defun tramp-parse-default-user-host (method) "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index cc93970be28..d903ba626b9 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4529,24 +4529,22 @@ tramp-test26-file-name-completion (setq host (match-string 1 host))) (unwind-protect - (dolist - (syntax - (if (tramp--test-expensive-test-p) - (tramp-syntax-values) `(,orig-syntax))) + (dolist (syntax (if (tramp--test-expensive-test-p) + (tramp-syntax-values) `(,orig-syntax))) (tramp-change-syntax syntax) ;; This has cleaned up all connection data, which are used ;; for completion. We must refill the cache. (tramp-set-connection-property tramp-test-vec "property" nil) - (let ;; This is needed for the `separate' syntax. - ((prefix-format (substring tramp-prefix-format 1)) - ;; This is needed for the IPv6 host name syntax. - (ipv6-prefix - (and (string-match-p tramp-ipv6-regexp host) - tramp-prefix-ipv6-format)) - (ipv6-postfix - (and (string-match-p tramp-ipv6-regexp host) - tramp-postfix-ipv6-format))) + (let (;; This is needed for the `separate' syntax. + (prefix-format (substring tramp-prefix-format 1)) + ;; This is needed for the IPv6 host name syntax. + (ipv6-prefix + (and (string-match-p tramp-ipv6-regexp host) + tramp-prefix-ipv6-format)) + (ipv6-postfix + (and (string-match-p tramp-ipv6-regexp host) + tramp-postfix-ipv6-format))) ;; Complete method name. (unless (or (tramp-string-empty-or-nil-p method) (string-empty-p tramp-method-regexp)) @@ -4637,6 +4635,132 @@ tramp-test26-file-name-completion ;; Cleanup. (ignore-errors (delete-directory tmp-name 'recursive))))))) +;; This test is inspired by Bug#51386, Bug#52758, Bug#53513, Bug#54042 +;; and Bug#60505. +;; TODO: Add tests for user names and multi-hop file names. +(ert-deftest tramp-test26-interactive-file-name-completion () + "Check interactive completion with different `completion-styles'." + ;; Method and host name in completion mode. This kind of completion + ;; does not work on MS Windows. + (unless (memq system-type '(cygwin windows-nt)) + (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) + (host (file-remote-p ert-remote-temporary-file-directory 'host)) + (orig-syntax tramp-syntax) + (non-essential t)) + (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) + (setq host (match-string 1 host))) + + (unwind-protect + (dolist (syntax (if (tramp--test-expensive-test-p) + (tramp-syntax-values) `(,orig-syntax))) + (tramp-change-syntax syntax) + ;; This has cleaned up all connection data, which are used + ;; for completion. We must refill the cache. + (tramp-set-connection-property tramp-test-vec "property" nil) + + (dolist + (style + (if (tramp--test-expensive-test-p) + ;; It doesn't work for `initials' and `shorthand' + ;; completion styles. Should it? + '(emacs21 emacs22 basic partial-completion substring flex) + '(basic))) + + (let (;; Force the real minibuffer in batch mode. + (executing-kbd-macro t) + (completion-styles `(,style)) + (completions-format 'one-column) + completion-category-defaults + completion-category-overrides + ;; This is needed for the `simplified' syntax, + (tramp-default-method method) + (method-string + (unless (string-empty-p tramp-method-regexp) + (concat method tramp-postfix-method-format))) + ;; This is needed for the IPv6 host name syntax. + (ipv6-prefix + (and (string-match-p tramp-ipv6-regexp host) + tramp-prefix-ipv6-format)) + (ipv6-postfix + (and (string-match-p tramp-ipv6-regexp host) + tramp-postfix-ipv6-format)) + test result completions) + + ;; Complete method name. + (unless (string-empty-p tramp-method-regexp) + (ignore-errors (kill-buffer "*Completions*")) + (discard-input) + (setq test (concat + tramp-prefix-format + (substring-no-properties method 0 2)) + unread-command-events + (mapcar #'identity (concat test "\t\n")) + completions nil + result (read-file-name "Prompt: ")) + (if (not (get-buffer "*Completions*")) + (progn + (tramp--test-message + "syntax: %s style: %s test: %s result: %s" + syntax style test result) + (should + (string-prefix-p + (concat tramp-prefix-format method-string) + result))) + (with-current-buffer "*Completions*" + (re-search-forward + (rx bol (1+ nonl) "possible completions:" eol)) + (forward-line 1) + (setq completions + (split-string + (buffer-substring-no-properties (point) (point-max)) + (rx (any "\r\n")) 'omit))) + (tramp--test-message + "syntax: %s style: %s test: %s result: %s completions: %S" + syntax style test result completions) + (should (member method-string completions)))) + + ;; Complete host name. + (unless (or (tramp-string-empty-or-nil-p host) + (tramp--test-gvfs-p method)) + (ignore-errors (kill-buffer "*Completions*")) + (discard-input) + (setq test (concat + tramp-prefix-format method-string + (substring-no-properties host 0 2)) + unread-command-events + (mapcar #'identity (concat test "\t\n")) + completions nil + result (read-file-name "Prompt: ")) + (if (not (get-buffer "*Completions*")) + (progn + (tramp--test-message + "syntax: %s style: %s test: %s result: %s" + syntax style test result) + (should + (string-equal + (concat + tramp-prefix-format method-string + ipv6-prefix host ipv6-postfix tramp-postfix-host-format) + result))) + (with-current-buffer "*Completions*" + (re-search-forward + (rx bol (1+ nonl) "possible completions:" eol)) + (forward-line 1) + (setq completions + (split-string + (buffer-substring-no-properties (point) (point-max)) + (rx (any "\r\n")) 'omit))) + (tramp--test-message + "syntax: %s style: %s test: %s result: %s completions: %S" + syntax style test result completions) + (should + (member + (concat host tramp-postfix-host-format) + completions))))))) + + ;; Cleanup. + (tramp-change-syntax orig-syntax))))) + (ert-deftest tramp-test27-load () "Check `load'." (skip-unless (tramp--test-enabled)) commit 321cbd9a6014bf0b70dc0b01aed27f36aec4051d Author: Mattias Engdegård Date: Mon Feb 6 11:45:33 2023 +0100 Tighten and simplify typescript compilation-mode regexps (bug#61104) * lisp/progmodes/compile.el (compilation-error-regexp-alist-alist): Tighten regexps and simplify. Translate to rx. * etc/compilation.txt: Add examples. In collaboration with Jostein Kjønigsen. diff --git a/etc/compilation.txt b/etc/compilation.txt index 672cbebafff..5f6ecb09cc2 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -639,6 +639,20 @@ symbol: weblint index.html (13:1) Unknown element +* Typescript prior to tsc version 2.7, "plain" format + +symbol: typescript-tsc-plain + +greeter.ts(30,12): error TS2339: Property 'foo' does not exist. + + +* Typescript after tsc version 2.7, "pretty" format + +symbol: typescript-tsc-pretty + +src/resources/document.ts:140:22 - error TS2362: something. + + * Directory tracking Directories are matched via 'compilation-directory-matcher'. Files which are diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 1e57d0b7bb2..ccf64fb670b 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -653,19 +653,31 @@ compilation-error-regexp-alist-alist ;; Typescript compilation prior to tsc version 2.7, "plain" format: ;; greeter.ts(30,12): error TS2339: Property 'foo' does not exist. (typescript-tsc-plain - ,(concat - "^[[:blank:]]*" - "\\([^(\r\n)]+\\)(\\([0-9]+\\),\\([0-9]+\\)):[[:blank:]]+" - "error [[:alnum:]]+: [^\r\n]+$") + ,(rx bol + (group (not (in " \t\n()")) ; 1: file + (* (not (in "\n()")))) + "(" + (group (+ (in "0-9"))) ; 2: line + "," + (group (+ (in "0-9"))) ; 3: column + "): error " + (+ (in "0-9A-Z")) ; error code + ": ") 1 2 3 2) ;; Typescript compilation after tsc version 2.7, "pretty" format: ;; src/resources/document.ts:140:22 - error TS2362: something. (typescript-tsc-pretty - ,(concat - "^[[:blank:]]*" - "\\([^(\r\n)]+\\):\\([0-9]+\\):\\([0-9]+\\) - [[:blank:]]*" - "error [[:alnum:]]+: [^\r\n]+$") + ,(rx bol + (group (not (in " \t\n()")) ; 1: file + (* (not (in "\n()")))) + ":" + (group (+ (in "0-9"))) ; 2: line + ":" + (group (+ (in "0-9"))) ; 3: column + " - error " + (+ (in "0-9A-Z")) ; error code + ": ") 1 2 3 2) )) "Alist of values for `compilation-error-regexp-alist'.") commit 97533e73ad68f8d9050f8ed349cf95f009e20b72 Author: Eli Zaretskii Date: Mon Feb 6 18:34:39 2023 +0200 ; * lisp/progmodes/c-ts-common.el (treesit-node-prev-sibling): Declare. diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 6767f10a9e7..0b0a7ff7cd3 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -51,6 +51,7 @@ (declare-function treesit-node-end "treesit.c") (declare-function treesit-node-type "treesit.c") (declare-function treesit-node-parent "treesit.c") +(declare-function treesit-node-prev-sibling "treesit.c") ;;; Comment indentation and filling commit 7f8f19da2492cd11b984c67259bfb645984d9c06 Author: Eli Zaretskii Date: Mon Feb 6 18:28:21 2023 +0200 Fix 'hack-local-variables' when EOL conversion is inhibited * lisp/files.el (hack-local-variables--find-variables): Replace CRs with newlines only if the original buffer is under explicit selective-display. (Bug#61321) diff --git a/lisp/files.el b/lisp/files.el index 9da82446112..b0ec6bb09d0 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4017,6 +4017,7 @@ hack-local-variables--find-variables (forward-line 1) (let ((startpos (point)) endpos + (selective-p (eq selective-display t)) (thisbuf (current-buffer))) (save-excursion (unless (let ((case-fold-search t)) @@ -4033,7 +4034,8 @@ hack-local-variables--find-variables (with-temp-buffer (insert-buffer-substring thisbuf startpos endpos) (goto-char (point-min)) - (subst-char-in-region (point) (point-max) ?\^m ?\n) + (if selective-p + (subst-char-in-region (point) (point-max) ?\r ?\n)) (while (not (eobp)) ;; Discard the prefix. (if (looking-at prefix) commit 9dfccb89fc576c89f48a89c95203c3bd68194154 Author: Tassilo Horn Date: Mon Feb 6 17:09:40 2023 +0100 Clarify bug-reference-auto-setup-functions docstring. * lisp/progmodes/bug-reference.el (bug-reference-auto-setup-functions): Add clarification to docstring that this variable is for packages, not for users. diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 2c5378fcbb5..9f1439e6a04 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -611,7 +611,21 @@ bug-reference-auto-setup-functions - `bug-reference-setup-from-mail-alist' for guessing based on mail group names or mail header values. - `bug-reference-setup-from-irc-alist' for guessing based on IRC - channel or network names.") + channel or network names. + +Note: This variable's purpose is to allow packages to provide +bug-reference auto-setup support in buffers managed by this +package. Therefore, such auto-setup function should check if the +current buffer is \"their\" buffer and only act if that's the +case, e.g., in terms of `derived-mode-p'. + +The variable is not intended for users. Those are advised to set +`bug-reference-bug-regexp' and `bug-reference-url-format' using +other means such as file-local variable sections, a +`.dir-locals.el' file, or compute and set their values in +`bug-reference-mode-hook' or `bug-reference-prog-mode-hook'. If +the bug regexp and URL format are already set after those hooks +have been run, the auto-setup is inhibited.") ;; Add the default auto-setup functions. We don't have them as ;; init value of bug-reference-auto-setup-functions because then commit 17ab426670af16f40334501d9018835bbd24a5db Author: Aleksandr Vityazev Date: Mon Feb 6 13:39:10 2023 +0300 * lisp/treesit.el (treesit): Fix shortdoc example form (bug#61318). diff --git a/lisp/treesit.el b/lisp/treesit.el index 7bd68c9a6d9..6015e78bbd5 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2963,7 +2963,7 @@ treesit "Parsers" (treesit-parser-create - :no-eval (treesit-parser-create) + :no-eval (treesit-parser-create 'c) :eg-result-string "#") (treesit-parser-delete :no-value (treesit-parser-delete parser)) commit 5a6dfab1e4d5d89e5d5ff3bef73279926f067dbc Author: Theodor Thornhill Date: Sun Feb 5 08:49:08 2023 +0100 Use c-ts-common-statement-offset in java-ts-mode (bug#61142) * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): Add new matchers to enable c-ts-common machinery. (java-ts-mode): Add regexps. * lisp/progmodes/c-ts-common.el (c-ts-common-statement-offset): Fix typo in documentation and use the new if statement helpers. (c-ts-common-if-statement-regexp): New defvar. (c-ts-common-nestable-if-statement-p): New defvar. (c-ts-common--fix-nestable-if-statement): New helper. * test/lisp/progmodes/c-ts-mode-resources/indent.erts: Add test for complicated bracket matching indentation. * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Add indent rules for bracketless statements. diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 8729cae4ba7..6767f10a9e7 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -281,11 +281,22 @@ c-ts-common-indent-bracketless-type-regexp This can be nil, meaning such special handling is not needed.") +(defvar c-ts-common-if-statement-regexp "if_statement" + "Regexp used to select an if statement in a C like language. + +This can be set to a different regexp if needed.") + +(defvar c-ts-common-nestable-if-statement-p t + "Does the current parser nest if-else statements? + +t if the current tree-sitter grammar nests the else if +statements, nil otherwise.") + (defun c-ts-common-statement-offset (node parent bol &rest _) "This anchor is used for children of a statement inside a block. This function basically counts the number of block nodes (i.e., -brackets) (defined by `c-ts-mode--indent-block-type-regexp') +brackets) (defined by `c-ts-common-indent-block-type-regexp') between NODE and the root node (not counting NODE itself), and multiply that by `c-ts-common-indent-offset'. @@ -312,6 +323,9 @@ c-ts-common-statement-offset (while (if (eq node t) (setq node parent) node) + ;; Subtract one indent level if the language nests + ;; if-statements and node is if_statement. + (setq level (c-ts-common--fix-nestable-if-statement level node)) (when (string-match-p c-ts-common-indent-block-type-regexp (treesit-node-type node)) (cl-incf level) @@ -354,6 +368,24 @@ c-ts-mode--fix-bracketless-indent (1+ level) level))) +(defun c-ts-common--fix-nestable-if-statement (level node) + "Takes LEVEL and NODE and return adjusted LEVEL. +Look at the type of NODE, when it is an if-statement node, as +defined by `c-ts-common-if-statement-regexp' and its parent is +also an if-statement node, subtract one level. Otherwise return +the value unchanged. Whether or not if-statements are nestable +is controlled by `c-ts-common-nestable-if-statement-p'." + ;; This fixes indentation for cases shown in bug#61142. + (or (and node + (equal (treesit-node-type (treesit-node-prev-sibling node)) "else") + (treesit-node-parent node) + c-ts-common-nestable-if-statement-p + (equal (treesit-node-type node) c-ts-common-if-statement-regexp) + (equal (treesit-node-type (treesit-node-parent node)) + c-ts-common-if-statement-regexp) + (cl-decf level)) + level)) + (provide 'c-ts-common) ;;; c-ts-common.el ends here diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 3740130be30..93816081666 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -238,6 +238,13 @@ c-ts-mode--indent-styles ((parent-is "labeled_statement") point-min c-ts-common-statement-offset) + ;; Bracketless statement matchers. + ((match nil "while_statement" "condition") parent-bol c-ts-mode-indent-offset) + ((match nil "if_statement" "consequence") parent-bol c-ts-mode-indent-offset) + ((match nil "if_statement" "alternative") parent-bol c-ts-mode-indent-offset) + ((match nil "do_statement" "body") parent-bol c-ts-mode-indent-offset) + ((match nil "for_statement" "body") parent-bol c-ts-mode-indent-offset) + ((match "preproc_ifdef" "compound_statement") point-min 0) ((match "#endif" "preproc_ifdef") point-min 0) ((match "preproc_if" "compound_statement") point-min 0) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index b9f78940957..1d7bdb07224 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -70,22 +70,25 @@ java-ts-mode--syntax-table (defvar java-ts-mode--indent-rules `((java ((parent-is "program") point-min 0) - ((node-is "}") (and parent parent-bol) 0) + ((match "}" "element_value_array_initializer") + parent-bol 0) + ((node-is "}") point-min c-ts-common-statement-offset) ((node-is ")") parent-bol 0) + ((node-is "else") parent-bol 0) ((node-is "]") parent-bol 0) ((and (parent-is "comment") c-ts-common-looking-at-star) c-ts-common-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 "class_body") point-min c-ts-common-statement-offset) ((parent-is "array_initializer") parent-bol java-ts-mode-indent-offset) - ((parent-is "annotation_type_body") parent-bol java-ts-mode-indent-offset) - ((parent-is "interface_body") parent-bol java-ts-mode-indent-offset) - ((parent-is "constructor_body") parent-bol java-ts-mode-indent-offset) + ((parent-is "annotation_type_body") point-min c-ts-common-statement-offset) + ((parent-is "interface_body") point-min c-ts-common-statement-offset) + ((parent-is "constructor_body") point-min c-ts-common-statement-offset) ((parent-is "enum_body_declarations") parent-bol 0) - ((parent-is "enum_body") parent-bol java-ts-mode-indent-offset) - ((parent-is "switch_block") parent-bol java-ts-mode-indent-offset) - ((parent-is "record_declaration_body") parent-bol java-ts-mode-indent-offset) + ((parent-is "enum_body") point-min c-ts-common-statement-offset) + ((parent-is "switch_block") point-min c-ts-common-statement-offset) + ((parent-is "record_declaration_body") point-min c-ts-common-statement-offset) ((query "(method_declaration (block _ @indent))") parent-bol java-ts-mode-indent-offset) ((query "(method_declaration (block (_) @indent))") parent-bol java-ts-mode-indent-offset) ((parent-is "local_variable_declaration") parent-bol java-ts-mode-indent-offset) @@ -118,7 +121,7 @@ java-ts-mode--indent-rules ((parent-is "case_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "labeled_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "do_statement") parent-bol java-ts-mode-indent-offset) - ((parent-is "block") (and parent parent-bol) java-ts-mode-indent-offset))) + ((parent-is "block") point-min c-ts-common-statement-offset))) "Tree-sitter indent rules.") (defvar java-ts-mode--keywords @@ -300,6 +303,21 @@ java-ts-mode (c-ts-common-comment-setup) ;; Indent. + (setq-local c-ts-common-indent-block-type-regexp + (regexp-opt '("class_body" + "array_initializer" + "constructor_body" + "annotation_type_body" + "interface_body" + "enum_body" + "switch_block" + "record_declaration_body" + "block"))) + (setq-local c-ts-common-indent-bracketless-type-regexp + (regexp-opt '("if_statement" + "for_statement" + "while_statement"))) + (setq-local c-ts-common-indent-offset 'java-ts-mode-indent-offset) (setq-local treesit-simple-indent-rules java-ts-mode--indent-rules) ;; Electric diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index 7dcc3b0fb3a..6f64e1e7953 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -244,3 +244,48 @@ int main() { } } =-=-= + +Name: Complicated mixed bracket matching indentation (bug#61142) + +=-= +void foo( + int foo) { + for (;;) + return 5; + + if (a == 0 + && b == 1 + && foo) + { + return 0; + } + else if (a == 1) + { + return 1; + } + else if (true) + return 5; + else + { + if (a == 0 + && b == 1 + && foo) + for ( + int i = 0; + i < 5; + i++) + if (true) + do + i = 5; + while (true); + else if (false) + { + return 6; + } + else + if (true + && false) + return 6; + } +} +=-=-= commit c3262216abbb9ea04e1d3af25df1f9743efd1513 Author: Theodor Thornhill Date: Sun Feb 5 08:24:14 2023 +0100 Add array_initializer to java-ts-mode Indent strings inside arrray_initializer one step: public class Java { void foo() { return new String[]{ "foo", // These "bar" } } } * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): New matcher. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index fc264f448af..b9f78940957 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -78,6 +78,7 @@ java-ts-mode--indent-rules ((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 "array_initializer") parent-bol java-ts-mode-indent-offset) ((parent-is "annotation_type_body") parent-bol java-ts-mode-indent-offset) ((parent-is "interface_body") parent-bol java-ts-mode-indent-offset) ((parent-is "constructor_body") parent-bol java-ts-mode-indent-offset) commit 79ab62e0bb5d6185a358a2473c65b6461ea97793 Author: Dmitry Gutov Date: Mon Feb 6 04:42:12 2023 +0200 go-ts-mode: Highlight variable declarations * lisp/progmodes/go-ts-mode.el (go-ts-mode--font-lock-settings): Highlight variable declarations in 'definition' feature. diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index dbb08c81447..7802c1fbfcc 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -135,7 +135,13 @@ go-ts-mode--font-lock-settings (field_declaration name: (field_identifier) @font-lock-property-face) (parameter_declaration - name: (identifier) @font-lock-variable-name-face)) + name: (identifier) @font-lock-variable-name-face) + (short_var_declaration + left: (expression_list + (identifier) @font-lock-variable-name-face + ("," (identifier) @font-lock-variable-name-face)*)) + (var_spec name: (identifier) @font-lock-variable-name-face + ("," name: (identifier) @font-lock-variable-name-face)*)) :language 'go :feature 'function commit 1fab91d852e461ae8091e906b3c6c4f17143068d Author: Dmitry Gutov Date: Mon Feb 6 04:12:25 2023 +0200 go-ts-mode: Fix highlighting of function name in call_expression * lisp/progmodes/go-ts-mode.el (go-ts-mode--font-lock-settings): Remove :override from the 'property' rules and move them above 'variable' (bug#61302). Just like in rust-ts-mode. diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index e5b7bcca9aa..dbb08c81447 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -169,6 +169,11 @@ go-ts-mode--font-lock-settings :feature 'type '([(package_identifier) (type_identifier)] @font-lock-type-face) + :language 'go + :feature 'property + '((field_identifier) @font-lock-property-face + (keyed_element (_ (identifier) @font-lock-property-face))) + :language 'go :feature 'variable '((identifier) @font-lock-variable-name-face) @@ -178,12 +183,6 @@ go-ts-mode--font-lock-settings :override t '((escape_sequence) @font-lock-escape-face) - :language 'go - :feature 'property - :override t - '((field_identifier) @font-lock-property-face - (keyed_element (_ (identifier) @font-lock-property-face))) - :language 'go :feature 'error :override t commit 07ffe902c638d58b677820aa26c16db94510eca3 Author: Dmitry Gutov Date: Mon Feb 6 04:05:19 2023 +0200 c-ts-mode: Highlight "property functions" as functions * lisp/progmodes/c-ts-mode.el (c-ts-mode--font-lock-settings): Highlight "property functions" as functions (bug#61302). diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 5093c3980b6..3740130be30 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -470,7 +470,9 @@ c-ts-mode--font-lock-settings :language mode :feature 'function '((call_expression - function: (identifier) @font-lock-function-name-face)) + function: + [(identifier) @font-lock-function-name-face + (field_expression field: (field_identifier) @font-lock-function-name-face)])) :language mode :feature 'variable commit a529b0d6463de109fb467c1a8c29722251d31925 Author: Dmitry Gutov Date: Sun Feb 5 23:42:18 2023 +0200 rust-ts-mode: Fix highlighting of function name in call_expression * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--font-lock-settings): Remove :override from the 'property' rules and move them above 'variable' (bug#61302). diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 18b42b9eced..5c71a8ad461 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -234,6 +234,11 @@ rust-ts-mode--font-lock-settings (use_as_clause alias: (identifier) @font-lock-type-face) (use_list (identifier) @font-lock-type-face)) + :language 'rust + :feature 'property + '((field_identifier) @font-lock-property-face + (shorthand_field_initializer (identifier) @font-lock-property-face)) + :language 'rust :feature 'variable '((identifier) @font-lock-variable-name-face @@ -245,12 +250,6 @@ rust-ts-mode--font-lock-settings :override t '((escape_sequence) @font-lock-escape-face) - :language 'rust - :feature 'property - :override t - '((field_identifier) @font-lock-property-face - (shorthand_field_initializer (identifier) @font-lock-property-face)) - :language 'rust :feature 'error :override t commit 088425538f2122d88a4f4e132dbb2f1139648531 Author: Dmitry Gutov Date: Sun Feb 5 21:34:12 2023 +0200 rust-ts-mode--font-lock-settings: Improve consistency * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--font-lock-settings): Remove the rule that highlighted scope identifier in a function call as type. The existing rules will handle it when it does look like a type (capitalized). diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 571e268c221..18b42b9eced 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -206,10 +206,7 @@ rust-ts-mode--font-lock-settings :language 'rust :feature 'type - `((call_expression - function: (scoped_identifier - path: (identifier) @font-lock-type-face)) - (enum_variant name: (identifier) @font-lock-type-face) + `((enum_variant name: (identifier) @font-lock-type-face) (match_arm pattern: (match_pattern (_ type: (identifier) @font-lock-type-face))) (match_arm commit 793c24a6ac72aada1981907185dbfbf6e82a0124 Author: Dmitry Gutov Date: Sun Feb 5 21:07:45 2023 +0200 Make sure 'M-x show-paren-local-mode' turns on right away * lisp/paren.el (show-paren--enabled-p): Extract from 'show-paren-function'. (show-paren-local-mode): Use it in the :variable getter (bug#61098). diff --git a/lisp/paren.el b/lisp/paren.el index 7ee4e9ae682..4c91fd29490 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -161,8 +161,9 @@ show-paren--delete-overlays ;;;###autoload (define-minor-mode show-paren-local-mode "Toggle `show-paren-mode' only in this buffer." - :variable ( show-paren-mode . - (lambda (val) (setq-local show-paren-mode val))) + :variable ((show-paren--enabled-p) + . + (lambda (val) (setq-local show-paren-mode val))) (cond ((eq show-paren-mode (default-value 'show-paren-mode)) (unless show-paren-mode @@ -428,14 +429,17 @@ show-paren--show-context-in-overlay ;; `show-paren-delay'. (defvar-local show-paren--last-pos nil) +(defun show-paren--enabled-p () + (and show-paren-mode + ;; If we're using `show-paren-local-mode', then + ;; always heed the value. + (or (local-variable-p 'show-paren-mode) + ;; If not, check that the predicate matches. + (buffer-match-p show-paren-predicate (current-buffer))))) + (defun show-paren-function () "Highlight the parentheses until the next input arrives." - (let ((data (and show-paren-mode - ;; If we're using `show-paren-local-mode', then - ;; always heed the value. - (or (local-variable-p 'show-paren-mode) - ;; If not, check that the predicate matches. - (buffer-match-p show-paren-predicate (current-buffer))) + (let ((data (and (show-paren--enabled-p) (funcall show-paren-data-function)))) (if (not data) (progn commit 60089dcfe06c64ff75d14f042fda1b052d0bad69 Author: Tassilo Horn Date: Sun Feb 5 19:54:17 2023 +0100 Add to bug-reference-auto-setup-functions after its declaring defvar If it's the init-value of the defvar, add-hook from a third-party package will suppress the default functions if it takes place before bug-reference is loaded. * lisp/progmodes/bug-reference.el (bug-reference-auto-setup-functions): Add to bug-reference-auto-setup-functions after its declaring defvar. diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index d7dd3ed1c9a..2c5378fcbb5 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -599,12 +599,7 @@ bug-reference-try-setup-from-erc (erc-format-target) (erc-network-name)))) -(defvar bug-reference-auto-setup-functions - (list #'bug-reference-try-setup-from-vc - #'bug-reference-try-setup-from-gnus - #'bug-reference-try-setup-from-rmail - #'bug-reference-try-setup-from-rcirc - #'bug-reference-try-setup-from-erc) +(defvar bug-reference-auto-setup-functions nil "Functions trying to auto-setup `bug-reference-mode'. These functions are run after `bug-reference-mode' has been activated in a buffer and try to guess suitable values for @@ -618,6 +613,21 @@ bug-reference-auto-setup-functions - `bug-reference-setup-from-irc-alist' for guessing based on IRC channel or network names.") +;; Add the default auto-setup functions. We don't have them as +;; init value of bug-reference-auto-setup-functions because then +;; they wouldn't be added if some package uses +;; +;; (add-hook 'bug-reference-auto-setup-functions +;; #'my-pkg--bug-reference-try-setup-from-my-pkg) +;; +;; before bug-reference.el is loaded. +(dolist (fn (list #'bug-reference-try-setup-from-vc + #'bug-reference-try-setup-from-gnus + #'bug-reference-try-setup-from-rmail + #'bug-reference-try-setup-from-rcirc + #'bug-reference-try-setup-from-erc)) + (add-hook 'bug-reference-auto-setup-functions fn)) + (defun bug-reference--run-auto-setup () (when (or bug-reference-mode bug-reference-prog-mode) commit 26e947ccb1453defcfce080cdc5ea7ca2cb8917e Author: Juri Linkov Date: Sun Feb 5 20:23:57 2023 +0200 * lisp/vc/vc.el (vc-find-revision-no-save): Fix parens (bug#61256). Move '(setq failed nil)' from UNWINDFORMS of 'unwind-protect' to BODYFORM. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index a181765eac3..4ba62c0b3c7 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2342,8 +2342,8 @@ vc-find-revision-no-save (ignore-errors (delay-mode-hooks (set-auto-mode)))) (normal-mode)) (set-buffer-modified-p nil) - (setq buffer-read-only t)) - (setq failed nil) + (setq buffer-read-only t) + (setq failed nil)) (when (and failed (unless buffer (get-file-buffer filename))) (with-current-buffer (get-file-buffer filename) (set-buffer-modified-p nil)) commit 013655811aa1c89754372610c8c6ccccec166035 Author: Alan Mackenzie Date: Sun Feb 5 18:01:09 2023 +0000 CC Mode: Prevent infinite recursion in c-determine-limit. This was happening particularly with long-lines, possibly because the position was inside a literal when calling c-determine-limit. * lisp/progmodes/cc-engine.el (c-determine-limit): Guard a recursive call by checking (- base try-size). diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 86bc35baa7c..1899b522ab0 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -5915,19 +5915,21 @@ c-determine-limit (cond ((> pos start) ; Nothing but literals base) - ((> base (point-min)) + ((and + (> base (point-min)) + (> (- base try-size) (point-min))) ; prevent infinite recursion. (c-determine-limit how-far-back base (* 2 try-size) org-start)) (t base))) ((>= count how-far-back) (c-determine-limit-no-macro - (+ (car elt) (- count how-far-back)) - org-start)) + (+ (car elt) (- count how-far-back)) + org-start)) ((eq base (point-min)) (point-min)) ((> base (- start try-size)) ; Can only happen if we hit point-min. (c-determine-limit-no-macro - (car elt) - org-start)) + (car elt) + org-start)) (t (c-determine-limit (- how-far-back count) base (* 2 try-size) org-start)))))) commit 948e343496bce96fcc5f2ccb702e4be2c549096e Author: Eli Zaretskii Date: Sun Feb 5 19:10:39 2023 +0200 ; Fix byte-compilation warning * lisp/progmodes/rust-ts-mode.el (treesit-query-compile): Avoid byte-compilation warning. diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 3beaa741605..571e268c221 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -38,6 +38,7 @@ (declare-function treesit-node-start "treesit.c") (declare-function treesit-node-type "treesit.c") (declare-function treesit-node-parent "treesit.c") +(declare-function treesit-query-compile "treesit.c") (defcustom rust-ts-mode-indent-offset 4 "Number of spaces for each indentation step in `rust-ts-mode'." commit 6568a1aaf9a97107947e801d1c3328a3119f0957 Author: Dmitry Gutov Date: Sun Feb 5 19:06:47 2023 +0200 Fix inability to turn show-paren-local-mode on manually (bug#61098) * lisp/paren.el (show-paren-local-mode): Don't kill the local value when both local and global are t. Because the show-paren-predicate check in show-paren-function also checks whether a local (non-nil) value of this variable exists. diff --git a/lisp/paren.el b/lisp/paren.el index d1623a2b248..7ee4e9ae682 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -166,8 +166,8 @@ show-paren-local-mode (cond ((eq show-paren-mode (default-value 'show-paren-mode)) (unless show-paren-mode - (show-paren--delete-overlays)) - (kill-local-variable 'show-paren-mode)) + (show-paren--delete-overlays) + (kill-local-variable 'show-paren-mode))) ((not (default-value 'show-paren-mode)) ;; Locally enabled, but globally disabled. (show-paren-mode 1) ; Setup the timer. commit 24085ba6105712ec601f94a5941da5c7f034f5fb Author: Dmitry Gutov Date: Sun Feb 5 18:52:57 2023 +0200 ; go-ts-mode--indent-rules: Indent to 0 at top level diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 4b14e55281e..e5b7bcca9aa 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -66,6 +66,7 @@ go-ts-mode--syntax-table (defvar go-ts-mode--indent-rules `((go + ((parent-is "source_file") point-min 0) ((node-is ")") parent-bol 0) ((node-is "]") parent-bol 0) ((node-is "}") parent-bol 0) commit 0862a79fef57b0954c9c47ac3783b40d6aeaef98 Merge: bb999df5d6f 929daafa1d6 Author: Eli Zaretskii Date: Sun Feb 5 18:53:36 2023 +0200 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/emacs into emacs-29 commit bb999df5d6f26bb1214ffad844a8b6fbf18c682e Author: Eli Zaretskii Date: Sun Feb 5 18:52:59 2023 +0200 ; Fix whitespace of last change diff --git a/lisp/isearch.el b/lisp/isearch.el index 62ac6f129fc..094e02d605e 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2773,6 +2773,7 @@ isearch-char-by-name isearch-new-message (concat isearch-message (mapconcat 'isearch-text-char-description string "")))))))) + (autoload 'emoji--read-emoji "emoji") (defun isearch-emoji-by-name (&optional count) "Read an Emoji name and add it to the search string COUNT times. commit 929daafa1d6ca786507e726e21aa295c3b4afe00 Author: Jonas Bernoulli Date: Sun Feb 5 17:50:10 2023 +0100 ; Fix trivial mistake in emoji--choose-emoji * lisp/international/emoji.el (emoji--choose-emoji): The derived versions are in the cdr not cadr. diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index 18fc167974c..bcd4aac4f29 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -685,7 +685,7 @@ emoji--read-emoji (cons glyph (gethash glyph emoji--derived)))))) (defun emoji--choose-emoji () - (pcase-let ((`(,glyph ,derived) (emoji--read-emoji))) + (pcase-let ((`(,glyph . ,derived) (emoji--read-emoji))) (if (not derived) ;; Simple glyph with no derivations. (progn commit d7b4a8487f64527d5913f7094b12266d012180c1 Author: Eli Zaretskii Date: Sun Feb 5 18:51:11 2023 +0200 ; * lisp/isearch.el (emoji--read-emoji): Avoid compilation warning. diff --git a/lisp/isearch.el b/lisp/isearch.el index bfa71756146..62ac6f129fc 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2773,7 +2773,7 @@ isearch-char-by-name isearch-new-message (concat isearch-message (mapconcat 'isearch-text-char-description string "")))))))) - +(autoload 'emoji--read-emoji "emoji") (defun isearch-emoji-by-name (&optional count) "Read an Emoji name and add it to the search string COUNT times. COUNT (interactively, the prefix argument) defaults to 1. commit e38ff004631805672aa07e3e7a87ae2e8d948a02 Author: Dmitry Gutov Date: Sun Feb 5 18:49:24 2023 +0200 rust-ts-mode: Highlight variable declarations (rust-ts-mode--font-lock-settings): Change scoped_type_identifier highlight to match similar cases. Highlight variable declarations inside all kinds of destructuring patterns, not just function definitions. * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--fontify-pattern): Rename from 'rust-ts-mode--fontify-parameter'. Check the id node's parent to avoid touching type identifiers. diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index f7a8a97cc5a..3beaa741605 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -162,7 +162,11 @@ rust-ts-mode--font-lock-settings (macro_definition "macro_rules!" @font-lock-constant-face) (macro_definition (identifier) @font-lock-preprocessor-face) (field_declaration name: (field_identifier) @font-lock-property-face) - (parameter) @rust-ts-mode--fontify-parameter) + (parameter) @rust-ts-mode--fontify-pattern + (let_declaration) @rust-ts-mode--fontify-pattern + (for_expression) @rust-ts-mode--fontify-pattern + (let_condition) @rust-ts-mode--fontify-pattern + (match_arm) @rust-ts-mode--fontify-pattern) :language 'rust :feature 'function @@ -227,7 +231,7 @@ rust-ts-mode--font-lock-settings (scoped_identifier name: (identifier) @font-lock-type-face)]) (:match "^[A-Z]" @font-lock-type-face)) - (scoped_type_identifier path: (identifier) @font-lock-constant-face) + (scoped_type_identifier path: (identifier) @font-lock-type-face) (type_identifier) @font-lock-type-face (use_as_clause alias: (identifier) @font-lock-type-face) (use_list (identifier) @font-lock-type-face)) @@ -255,17 +259,21 @@ rust-ts-mode--font-lock-settings '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `rust-ts-mode'.") -(defalias 'rust-ts-mode--fontify-parameter +(defalias 'rust-ts-mode--fontify-pattern (and (treesit-available-p) `(lambda (node override start end &rest _) (let ((captures (treesit-query-capture (treesit-node-child-by-field-name node "pattern") - ,(treesit-query-compile 'rust '((identifier) @id))))) + ,(treesit-query-compile 'rust '((identifier) @id + (shorthand_field_identifier) @id))))) (pcase-dolist (`(_name . ,id) captures) - (treesit-fontify-with-override - (treesit-node-start id) (treesit-node-end id) - 'font-lock-variable-name-face override start end)))))) + (unless (string-match-p "\\`scoped_\\(?:type_\\)?identifier\\'" + (treesit-node-type + (treesit-node-parent id))) + (treesit-fontify-with-override + (treesit-node-start id) (treesit-node-end id) + 'font-lock-variable-name-face override start end))))))) (defun rust-ts-mode--defun-name (node) "Return the defun name of NODE. commit d12727057d49df72df9da185e62e8a2caece249b Author: Dmitry Gutov Date: Sun Feb 5 18:19:04 2023 +0200 rust-ts-mode--indent-rules: Indent to 0 at top level diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index e46fa0342dd..f7a8a97cc5a 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -69,6 +69,7 @@ rust-ts-mode--syntax-table (defvar rust-ts-mode--indent-rules `((rust + ((parent-is "source_file") point-min 0) ((node-is ")") parent-bol 0) ((node-is "]") parent-bol 0) ((node-is "}") (and parent parent-bol) 0) commit 85705a7059f33e43b2395552beb9a01d32d76a5e Author: Jonas Bernoulli Date: Sun Feb 5 17:19:15 2023 +0100 ; Move misplaces parenthesis in emoji--choose-emoji * lisp/international/emoji.el (emoji--choose-emoji): Move misplaced parenthesis. diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index f75bd877991..18fc167974c 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -685,7 +685,7 @@ emoji--read-emoji (cons glyph (gethash glyph emoji--derived)))))) (defun emoji--choose-emoji () - (pcase-let ((`(,glyph ,derived)) (emoji--read-emoji)) + (pcase-let ((`(,glyph ,derived) (emoji--read-emoji))) (if (not derived) ;; Simple glyph with no derivations. (progn commit 18c43bb9d6ced167aa315b4485b6283247e8b127 Author: Alan Mackenzie Date: Sun Feb 5 15:59:44 2023 +0000 Ensure upper bound of font-lock region is less than point-max This fixes bug #61298. The new long-lines code may have narrowed a buffer before font-lock-default-fontify-region gets called. * lisp/font-lock.el (font-lock-default-fontify-region): Set `end' to point-max if it is greater that it. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 1fa45379b9f..9e944fe188a 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1154,6 +1154,8 @@ font-lock-default-fontify-region "Fontify the text between BEG and END. If LOUDLY is non-nil, print status messages while fontifying. This function is the default `font-lock-fontify-region-function'." + (or (<= end (point-max)) + (setq end (point-max))) (with-silent-modifications ;; Use the fontification syntax table, if any. (with-syntax-table (or font-lock-syntax-table (syntax-table)) commit 94f291d1505a6eccc3d7503992265f9e15101c86 Author: Eli Zaretskii Date: Sun Feb 5 17:27:43 2023 +0200 ; * lisp/paren.el (show-paren-predicate): Doc fix. (Bug#61098) diff --git a/lisp/paren.el b/lisp/paren.el index b2a79624c0f..d1623a2b248 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -122,7 +122,8 @@ show-paren-predicate "Whether to use `show-paren-mode' in a buffer. The default is to enable the mode in all buffers that don't derive from `special-mode', which means that it's on (by default) -in all editing buffers." +in all editing buffers. +The predicate is passed as argument to `buffer-match-p', which see." :type 'buffer-predicate :safe #'booleanp :version "29.1") commit 0f4c7060e46d279b0da315a8d0961225a7eefa6a Author: Mattias Engdegård Date: Sun Feb 5 12:27:32 2023 +0100 Fix misleading LAP optimiser debug log message * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Correct message in a conditional jump threading rule. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index feff233998d..e0c769c7e60 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -2368,9 +2368,11 @@ byte-optimize-lapcode (eq (car tmp) 'byte-goto)) (not (eq (cdr tmp) (cdr lap0))) (progn - ;; FIXME: inaccurate log message when lap0 = goto-if-* (byte-compile-log-lap " %s [%s]\t-->\t%s" - (car lap0) tmp tmp) + (car lap0) tmp + (if (eq (car tmp) 'byte-return) + tmp + (cons (car lap0) (cdr tmp)))) (when (eq (car tmp) 'byte-return) (setcar lap0 'byte-return)) (setcdr lap0 (cdr tmp)) commit 17784bbf3f933dc7ed6aa286794ad7a32651e3ce Author: Mattias Engdegård Date: Sun Feb 5 12:14:23 2023 +0100 Allow unbind to commute with discardN and discardN-preserve-tos * lisp/emacs-lisp/byte-opt.el (byte-after-unbind-ops): Add discardN and discardN-preserve-tos, both of which commute with unbind. This enables subsequent optimisations. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index a54f6595b46..feff233998d 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1955,8 +1955,8 @@ byte-conditional-ops byte-goto-if-not-nil-else-pop)) (defconst byte-after-unbind-ops - ;; FIXME: add discardN, discardN-preserve-tos '(byte-constant byte-dup byte-stack-ref byte-stack-set byte-discard + byte-discardN byte-discardN-preserve-tos byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp byte-eq byte-not byte-cons byte-list1 byte-list2 byte-list3 byte-list4 byte-listN commit a50d5b219f81104e3a5928d4917608fcb4db88d2 Author: Mattias Engdegård Date: Sun Feb 5 11:56:06 2023 +0100 Remove compatibility hacks in LAP optimiser * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Remove code forcing forward motion after applying certain transformations; these were only there to keep output identical across refactorings. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 148b8f60ff7..a54f6595b46 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -2145,7 +2145,6 @@ byte-optimize-lapcode (setq keep-going t) (setcdr prev (cdr rest)) ; remove dup (setcdr (cdr rest) (cdddr rest)) ; remove discard - (setq prev (cdr rest)) ; FIXME: temporary compat hack (cond ((not (eq (car lap1) 'byte-stack-set)) (byte-compile-log-lap " %s %s %s\t-->\t%s" lap0 lap1 lap2 lap1)) @@ -2218,9 +2217,7 @@ byte-optimize-lapcode (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 lap0 (cons 'byte-goto (cdr lap1))) - (setcar lap1 'byte-goto) - (setq prev (cdr prev)) ; FIXME: temporary compat hack - )) + (setcar lap1 'byte-goto))) (setq keep-going t)) ;; ;; varref-X varref-X --> varref-X dup @@ -2321,7 +2318,6 @@ byte-optimize-lapcode lap0 i (if (= i 1) "" "s") tagstr lap0 tagstr)))) (setcdr rest tmp) - (setq prev rest) ; FIXME: temporary compat hack (setq keep-going t))) ;; ;; unbind --> unbind @@ -2378,7 +2374,6 @@ byte-optimize-lapcode (when (eq (car tmp) 'byte-return) (setcar lap0 'byte-return)) (setcdr lap0 (cdr tmp)) - (setq prev (cdr prev)) ; FIXME: temporary compat hack (setq keep-going t) t))))) @@ -2447,7 +2442,6 @@ byte-optimize-lapcode (car lap0) tmp2 (nth 1 tmp3)) (setcar lap0 (nth 1 tmp3)) (setcdr lap0 (nth 1 tmp))) - (setq prev (cdr prev)) ; FIXME: temporary compat hack (setq keep-going t) t))))) ;; @@ -2588,9 +2582,7 @@ byte-optimize-lapcode (+ (cdr lap0) (cdr lap1))))) (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 new-op) (setcar rest new-op) - (setcdr rest (cddr rest)) - (setq prev rest) ; FIXME: temporary compat hack - )) + (setcdr rest (cddr rest)))) ;; ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos @@ -2627,7 +2619,7 @@ byte-optimize-lapcode (setcdr (cdr rest) tmp) (byte-compile-log-lap " %s [discard/discardN]...\t-->\t%s" lap0 lap1) - ;; FIXME: shouldn't we do (setq keep-going t) here? + (setq keep-going t) t ))))) @@ -2694,9 +2686,7 @@ byte-optimize-lapcode (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 newdiscard lap0) (setf (car rest) newdiscard) - (setf (cadr rest) lap0)) - (setq prev (cdr prev)) ; FIXME: temporary compat hack - ) + (setf (cadr rest) lap0))) (t ;; If no rule matched, advance and try again. (setq prev (cdr prev)))))))) commit 9926b44f9ee75b50c50133b0d1292db5c20175f0 Author: Mattias Engdegård Date: Sun Feb 5 11:18:26 2023 +0100 LAP optimiser: bind local variables instead of mutating them This is a refactoring step: there is no change in how the optimiser works. * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Instead of re-using local variables through mutation, bind them at point of use. This ensures that there is no value leakage by mistake and actually reduces the static size of the bytecode of this function somewhat. The lousy variable names (tmp, tmp2 etc) are retained but can at least now be changed into something more descriptive. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 5ffaf4adedd..148b8f60ff7 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -2027,641 +2027,679 @@ byte-optimize-lapcode (keep-going 'first-time) ;; Create a cons cell as head of the list so that removing the first ;; element does not need special-casing: `setcdr' always works. - (lap-head (cons nil lap)) - lap0 lap1 lap2 - rest prev tmp tmp2 tmp3) + (lap-head (cons nil lap))) (while keep-going - (or (eq keep-going 'first-time) - (byte-compile-log-lap " ---- next pass")) - (setq prev lap-head) + (byte-compile-log-lap " ---- %s pass" + (if (eq keep-going 'first-time) "first" "next")) (setq keep-going nil) - (while (cdr prev) - (setq rest (cdr prev)) - (setq lap0 (car rest) - lap1 (nth 1 rest) - lap2 (nth 2 rest)) - - ;; You may notice that sequences like "dup varset discard" are - ;; optimized but sequences like "dup varset TAG1: discard" are not. - ;; You may be tempted to change this; resist that temptation. - - ;; Each clause in this `cond' statement must keep `prev' the - ;; predecessor of the remainder of the list for inspection. - (cond - ;; - ;; PUSH(K) discard(N) --> discard(N-K), N>K - ;; PUSH(K) discard(N) --> , N=K - ;; where PUSH(K) is a side-effect-free op such as const, varref, dup - ;; - ((and (memq (car lap1) '(byte-discard byte-discardN)) - (memq (car lap0) side-effect-free)) - (setq keep-going t) - (let* ((pushes (aref byte-stack+-info (symbol-value (car lap0)))) - (pops (if (eq (car lap1) 'byte-discardN) (cdr lap1) 1)) - (net-pops (- pops pushes))) - (cond ((= net-pops 0) - (byte-compile-log-lap " %s %s\t-->\t" lap0 lap1) - (setcdr prev (cddr rest))) - ((> net-pops 0) - (byte-compile-log-lap - " %s %s\t-->\t discard(%d)" lap0 lap1 net-pops) - (setcar rest (if (eql net-pops 1) + (let ((prev lap-head)) + (while (cdr prev) + (let* ((rest (cdr prev)) + (lap0 (car rest)) + (lap1 (nth 1 rest)) + (lap2 (nth 2 rest))) + + ;; You may notice that sequences like "dup varset discard" are + ;; optimized but sequences like "dup varset TAG1: discard" are not. + ;; You may be tempted to change this; resist that temptation. + + ;; Each clause in this `cond' statement must keep `prev' the + ;; predecessor of the remainder of the list for inspection. + (cond + ;; + ;; PUSH(K) discard(N) --> discard(N-K), N>K + ;; PUSH(K) discard(N) --> , N=K + ;; where PUSH(K) is a side-effect-free op such as + ;; const, varref, dup + ;; + ((and (memq (car lap1) '(byte-discard byte-discardN)) + (memq (car lap0) side-effect-free)) + (setq keep-going t) + (let* ((pushes (aref byte-stack+-info (symbol-value (car lap0)))) + (pops (if (eq (car lap1) 'byte-discardN) (cdr lap1) 1)) + (net-pops (- pops pushes))) + (cond ((= net-pops 0) + (byte-compile-log-lap " %s %s\t-->\t" + lap0 lap1) + (setcdr prev (cddr rest))) + ((> net-pops 0) + (byte-compile-log-lap + " %s %s\t-->\t discard(%d)" + lap0 lap1 net-pops) + (setcar rest (if (eql net-pops 1) + (cons 'byte-discard nil) + (cons 'byte-discardN net-pops))) + (setcdr rest (cddr rest))) + (t (error "Optimizer error: too much on the stack"))))) + ;; + ;; goto(X) X: --> X: + ;; goto-if-[not-]nil(X) X: --> discard X: + ;; + ((and (memq (car lap0) byte-goto-ops) + (eq (cdr lap0) lap1)) + (cond ((eq (car lap0) 'byte-goto) + (byte-compile-log-lap " %s %s\t-->\t %s" + lap0 lap1 lap1) + (setcdr prev (cdr rest))) + ((memq (car lap0) byte-goto-always-pop-ops) + (byte-compile-log-lap " %s %s\t-->\tdiscard %s" + lap0 lap1 lap1) + (setcar lap0 'byte-discard) + (setcdr lap0 0)) + ;; goto-*-else-pop(X) cannot occur here because it would + ;; be a depth conflict. + (t (error "Depth conflict at tag %d" (nth 2 lap0)))) + (setq keep-going t)) + ;; + ;; varset-X varref-X --> dup varset-X + ;; varbind-X varref-X --> dup varbind-X + ;; const/dup varset-X varref-X --> const/dup varset-X const/dup + ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup + ;; The latter two can enable other optimizations. + ;; + ;; For lexical variables, we could do the same + ;; stack-set-X+1 stack-ref-X --> dup stack-set-X+2 + ;; but this is a very minor gain, since dup is stack-ref-0, + ;; i.e. it's only better if X>5, and even then it comes + ;; at the cost of an extra stack slot. Let's not bother. + ((and (eq 'byte-varref (car lap2)) + (eq (cdr lap1) (cdr lap2)) + (memq (car lap1) '(byte-varset byte-varbind)) + (let ((tmp (memq (car (cdr lap2)) byte-boolean-vars))) + (and + (not (and tmp (not (eq (car lap0) 'byte-constant)))) + (progn + (setq keep-going t) + (if (memq (car lap0) '(byte-constant byte-dup)) + (let ((tmp (if (or (not tmp) + (macroexp--const-symbol-p + (car (cdr lap0)))) + (cdr lap0) + (byte-compile-get-constant t)))) + (byte-compile-log-lap " %s %s %s\t-->\t%s %s %s" + lap0 lap1 lap2 lap0 lap1 + (cons (car lap0) tmp)) + (setcar lap2 (car lap0)) + (setcdr lap2 tmp)) + (byte-compile-log-lap " %s %s\t-->\tdup %s" + lap1 lap2 lap1) + (setcar lap2 (car lap1)) + (setcar lap1 'byte-dup) + (setcdr lap1 0) + ;; The stack depth gets locally increased, so we will + ;; increase maxdepth in case depth = maxdepth here. + ;; This can cause the third argument to byte-code to + ;; be larger than necessary. + (setq add-depth 1)) + t))))) + ;; + ;; dup varset-X discard --> varset-X + ;; dup varbind-X discard --> varbind-X + ;; dup stack-set-X discard --> stack-set-X-1 + ;; (the varbind variant can emerge from other optimizations) + ;; + ((and (eq 'byte-dup (car lap0)) + (eq 'byte-discard (car lap2)) + (memq (car lap1) '(byte-varset byte-varbind + byte-stack-set))) + (setq keep-going t) + (setcdr prev (cdr rest)) ; remove dup + (setcdr (cdr rest) (cdddr rest)) ; remove discard + (setq prev (cdr rest)) ; FIXME: temporary compat hack + (cond ((not (eq (car lap1) 'byte-stack-set)) + (byte-compile-log-lap " %s %s %s\t-->\t%s" + lap0 lap1 lap2 lap1)) + ((eql (cdr lap1) 1) + (byte-compile-log-lap " %s %s %s\t-->\t" + lap0 lap1 lap2)) + (t + (let ((n (1- (cdr lap1)))) + (byte-compile-log-lap " %s %s %s\t-->\t%s" + lap0 lap1 lap2 + (cons (car lap1) n)) + (setcdr lap1 n))))) + ;; + ;; not goto-X-if-nil --> goto-X-if-non-nil + ;; not goto-X-if-non-nil --> goto-X-if-nil + ;; + ;; it is wrong to do the same thing for the -else-pop variants. + ;; + ((and (eq 'byte-not (car lap0)) + (memq (car lap1) '(byte-goto-if-nil byte-goto-if-not-nil))) + (let ((not-goto (if (eq (car lap1) 'byte-goto-if-nil) + 'byte-goto-if-not-nil + 'byte-goto-if-nil))) + (byte-compile-log-lap " not %s\t-->\t%s" + lap1 (cons not-goto (cdr lap1))) + (setcar lap1 not-goto) + (setcdr prev (cdr rest)) ; delete not + (setq keep-going t))) + ;; + ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X: + ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X: + ;; + ;; it is wrong to do the same thing for the -else-pop variants. + ;; + ((and (memq (car lap0) + '(byte-goto-if-nil byte-goto-if-not-nil)) ; gotoX + (eq 'byte-goto (car lap1)) ; gotoY + (eq (cdr lap0) lap2)) ; TAG X + (let ((inverse (if (eq 'byte-goto-if-nil (car lap0)) + 'byte-goto-if-not-nil 'byte-goto-if-nil))) + (byte-compile-log-lap " %s %s %s\t-->\t%s %s" + lap0 lap1 lap2 + (cons inverse (cdr lap1)) lap2) + (setcdr prev (cdr rest)) + (setcar lap1 inverse) + (setq keep-going t))) + ;; + ;; const goto-if-* --> whatever + ;; + ((and (eq 'byte-constant (car lap0)) + (memq (car lap1) byte-conditional-ops) + ;; Must be an actual constant, not a closure variable. + (consp (cdr lap0))) + (cond ((if (memq (car lap1) '(byte-goto-if-nil + byte-goto-if-nil-else-pop)) + (car (cdr lap0)) + (not (car (cdr lap0)))) + ;; Branch not taken. + (byte-compile-log-lap " %s %s\t-->\t" + lap0 lap1) + (setcdr prev (cddr rest))) ; delete both + ((memq (car lap1) byte-goto-always-pop-ops) + ;; Always-pop branch taken. + (byte-compile-log-lap " %s %s\t-->\t%s" + lap0 lap1 + (cons 'byte-goto (cdr lap1))) + (setcdr prev (cdr rest)) ; delete const + (setcar lap1 'byte-goto)) + (t ; -else-pop branch taken: keep const + (byte-compile-log-lap " %s %s\t-->\t%s %s" + lap0 lap1 + lap0 (cons 'byte-goto (cdr lap1))) + (setcar lap1 'byte-goto) + (setq prev (cdr prev)) ; FIXME: temporary compat hack + )) + (setq keep-going t)) + ;; + ;; varref-X varref-X --> varref-X dup + ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup + ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup + ;; We don't optimize the const-X variations on this here, + ;; because that would inhibit some goto optimizations; we + ;; optimize the const-X case after all other optimizations. + ;; + ((and (memq (car lap0) '(byte-varref byte-stack-ref)) + (let ((tmp (cdr rest)) + (tmp2 0)) + (while (eq (car (car tmp)) 'byte-dup) + (setq tmp2 (1+ tmp2)) + (setq tmp (cdr tmp))) + (and (eq (if (eq 'byte-stack-ref (car lap0)) + (+ tmp2 1 (cdr lap0)) + (cdr lap0)) + (cdr (car tmp))) + (eq (car lap0) (car (car tmp))) + (progn + (when (memq byte-optimize-log '(t byte)) + (let ((str "") + (tmp2 (cdr rest))) + (while (not (eq tmp tmp2)) + (setq tmp2 (cdr tmp2)) + (setq str (concat str " dup"))) + (byte-compile-log-lap " %s%s %s\t-->\t%s%s dup" + lap0 str lap0 lap0 str))) + (setq keep-going t) + (setcar (car tmp) 'byte-dup) + (setcdr (car tmp) 0) + t))))) + ;; + ;; TAG1: TAG2: --> TAG2: + ;; (and other references to TAG1 are replaced with TAG2) + ;; + ((and (eq (car lap0) 'TAG) + (eq (car lap1) 'TAG)) + (byte-compile-log-lap " adjacent tags %d and %d merged" + (nth 1 lap1) (nth 1 lap0)) + (let ((tmp3 (cdr lap-head))) + (while (let ((tmp2 (rassq lap0 tmp3))) + (and tmp2 + (progn + (setcdr tmp2 lap1) + (setq tmp3 (cdr (memq tmp2 tmp3))) + t)))) + (setcdr prev (cdr rest)) + (setq keep-going t) + ;; replace references to tag in jump tables, if any + (dolist (table byte-compile-jump-tables) + (maphash #'(lambda (value tag) + (when (equal tag lap0) + (puthash value lap1 table))) + table)))) + ;; + ;; unused-TAG: --> + ;; + ((and (eq 'TAG (car lap0)) + (not (rassq lap0 (cdr lap-head))) + ;; make sure this tag isn't used in a jump-table + (cl-loop for table in byte-compile-jump-tables + when (member lap0 (hash-table-values table)) + return nil finally return t)) + (byte-compile-log-lap " unused tag %d removed" (nth 1 lap0)) + (setcdr prev (cdr rest)) + (setq keep-going t)) + ;; + ;; goto ... --> goto + ;; return ... --> return + ;; + ((and (memq (car lap0) '(byte-goto byte-return)) + (not (memq (car lap1) '(TAG nil)))) + (let ((i 0) + (tmp rest) + (opt-p (memq byte-optimize-log '(t byte))) + str deleted) + (while (and (setq tmp (cdr tmp)) + (not (eq 'TAG (car (car tmp))))) + (if opt-p (setq deleted (cons (car tmp) deleted) + str (concat str " %s") + i (1+ i)))) + (if opt-p + (let ((tagstr + (if (eq 'TAG (car (car tmp))) + (format "%d:" (car (cdr (car tmp)))) + (or (car tmp) "")))) + (if (< i 6) + (apply 'byte-compile-log-lap-1 + (concat " %s" str + " %s\t-->\t%s %s") + lap0 + (nconc (nreverse deleted) + (list tagstr lap0 tagstr))) + (byte-compile-log-lap + " %s <%d unreachable op%s> %s\t-->\t%s %s" + lap0 i (if (= i 1) "" "s") + tagstr lap0 tagstr)))) + (setcdr rest tmp) + (setq prev rest) ; FIXME: temporary compat hack + (setq keep-going t))) + ;; + ;; unbind --> unbind + ;; (this may enable other optimizations.) + ;; + ((and (eq 'byte-unbind (car lap1)) + (memq (car lap0) byte-after-unbind-ops)) + (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0) + (setcar rest lap1) + (setcar (cdr rest) lap0) + (setq keep-going t)) + ;; + ;; varbind-X unbind-N --> discard unbind-(N-1) + ;; save-excursion unbind-N --> unbind-(N-1) + ;; save-restriction unbind-N --> unbind-(N-1) + ;; save-current-buffer unbind-N --> unbind-(N-1) + ;; + ((and (eq 'byte-unbind (car lap1)) + (memq (car lap0) '(byte-varbind byte-save-excursion + byte-save-restriction + byte-save-current-buffer)) + (< 0 (cdr lap1))) + (setcdr lap1 (1- (cdr lap1))) + (when (zerop (cdr lap1)) + (setcdr rest (cddr rest))) + (if (eq (car lap0) 'byte-varbind) + (setcar rest (cons 'byte-discard 0)) + (setcdr prev (cddr prev))) + (byte-compile-log-lap " %s %s\t-->\t%s %s" + lap0 (cons (car lap1) (1+ (cdr lap1))) + (if (eq (car lap0) 'byte-varbind) + (car rest) + (car (cdr rest))) + (if (and (/= 0 (cdr lap1)) + (eq (car lap0) 'byte-varbind)) + (car (cdr rest)) + "")) + (setq keep-going t)) + ;; + ;; goto*-X ... X: goto-Y --> goto*-Y + ;; goto-X ... X: return --> return + ;; + ((and (memq (car lap0) byte-goto-ops) + (let ((tmp (nth 1 (memq (cdr lap0) (cdr lap-head))))) + (and + (memq (car tmp) '(byte-goto byte-return)) + (or (eq (car lap0) 'byte-goto) + (eq (car tmp) 'byte-goto)) + (not (eq (cdr tmp) (cdr lap0))) + (progn + ;; FIXME: inaccurate log message when lap0 = goto-if-* + (byte-compile-log-lap " %s [%s]\t-->\t%s" + (car lap0) tmp tmp) + (when (eq (car tmp) 'byte-return) + (setcar lap0 'byte-return)) + (setcdr lap0 (cdr tmp)) + (setq prev (cdr prev)) ; FIXME: temporary compat hack + (setq keep-going t) + t))))) + + ;; + ;; OP goto(X) Y: OP X: -> Y: OP X: + ;; + ((and (eq (car lap1) 'byte-goto) + (eq (car lap2) 'TAG) + (let ((lap3 (nth 3 rest))) + (and (eq (car lap0) (car lap3)) + (eq (cdr lap0) (cdr lap3)) + (eq (cdr lap1) (nth 4 rest))))) + (byte-compile-log-lap " %s %s %s %s %s\t-->\t%s %s %s" + lap0 lap1 lap2 + (nth 3 rest) (nth 4 rest) + lap2 (nth 3 rest) (nth 4 rest)) + (setcdr prev (cddr rest)) + (setq keep-going t)) + + ;; + ;; OP const return --> const return + ;; where OP is side-effect-free (or mere stack manipulation). + ;; + ((and (eq (car lap1) 'byte-constant) + (eq (car (nth 2 rest)) 'byte-return) + (or (memq (car lap0) '( byte-discard byte-discardN + byte-discardN-preserve-tos + byte-stack-set)) + (memq (car lap0) side-effect-free))) + (setq keep-going t) + (setq add-depth 1) + (setcdr prev (cdr rest)) + (byte-compile-log-lap " %s %s %s\t-->\t%s %s" + lap0 lap1 (nth 2 rest) lap1 (nth 2 rest))) + + ;; + ;; goto-*-else-pop X ... X: goto-if-* --> whatever + ;; goto-*-else-pop X ... X: discard --> whatever + ;; + ((and (memq (car lap0) '(byte-goto-if-nil-else-pop + byte-goto-if-not-nil-else-pop)) + (let ((tmp (cdr (memq (cdr lap0) (cdr lap-head))))) + (and + (memq (caar tmp) + (eval-when-compile + (cons 'byte-discard byte-conditional-ops))) + (not (eq lap0 (car tmp))) + (let ((tmp2 (car tmp)) + (tmp3 (assq (car lap0) + '((byte-goto-if-nil-else-pop + byte-goto-if-nil) + (byte-goto-if-not-nil-else-pop + byte-goto-if-not-nil))))) + (if (memq (car tmp2) tmp3) + (progn (setcar lap0 (car tmp2)) + (setcdr lap0 (cdr tmp2)) + (byte-compile-log-lap + " %s-else-pop [%s]\t-->\t%s" + (car lap0) tmp2 lap0)) + ;; Get rid of the -else-pop's and jump one + ;; step further. + (or (eq 'TAG (car (nth 1 tmp))) + (setcdr tmp (cons (byte-compile-make-tag) + (cdr tmp)))) + (byte-compile-log-lap " %s [%s]\t-->\t%s " + (car lap0) tmp2 (nth 1 tmp3)) + (setcar lap0 (nth 1 tmp3)) + (setcdr lap0 (nth 1 tmp))) + (setq prev (cdr prev)) ; FIXME: temporary compat hack + (setq keep-going t) + t))))) + ;; + ;; const goto-X ... X: goto-if-* --> whatever + ;; const goto-X ... X: discard --> whatever + ;; + ((and (eq (car lap0) 'byte-constant) + (eq (car lap1) 'byte-goto) + (let ((tmp (cdr (memq (cdr lap1) (cdr lap-head))))) + (and + (memq (caar tmp) + (eval-when-compile + (cons 'byte-discard byte-conditional-ops))) + (not (eq lap1 (car tmp))) + (let ((tmp2 (car tmp))) + (cond ((and (consp (cdr lap0)) + (memq (car tmp2) + (if (null (car (cdr lap0))) + '(byte-goto-if-nil + byte-goto-if-nil-else-pop) + '(byte-goto-if-not-nil + byte-goto-if-not-nil-else-pop)))) + (byte-compile-log-lap + " %s goto [%s]\t-->\t%s %s" + lap0 tmp2 lap0 tmp2) + (setcar lap1 (car tmp2)) + (setcdr lap1 (cdr tmp2)) + ;; Let next step fix the (const,goto-if*) seq. + (setq keep-going t)) + ((or (consp (cdr lap0)) + (eq (car tmp2) 'byte-discard)) + ;; Jump one step further + (byte-compile-log-lap + " %s goto [%s]\t-->\t goto " + lap0 tmp2) + (or (eq 'TAG (car (nth 1 tmp))) + (setcdr tmp (cons (byte-compile-make-tag) + (cdr tmp)))) + (setcdr lap1 (car (cdr tmp))) + (setcdr prev (cdr rest)) + (setq keep-going t)) + (t + (setq prev (cdr prev)))) + t))))) + ;; + ;; X: varref-Y ... varset-Y goto-X --> + ;; X: varref-Y Z: ... dup varset-Y goto-Z + ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.) + ;; (This is so usual for while loops that it is worth handling). + ;; + ;; Here again, we could do it for stack-ref/stack-set, but + ;; that's replacing a stack-ref-Y with a stack-ref-0, which + ;; is a very minor improvement (if any), at the cost of + ;; more stack use and more byte-code. Let's not do it. + ;; + ((and (eq (car lap1) 'byte-varset) + (eq (car lap2) 'byte-goto) + (not (memq (cdr lap2) rest)) ;Backwards jump + (let ((tmp (cdr (memq (cdr lap2) (cdr lap-head))))) + (and + (eq (car (car tmp)) 'byte-varref) + (eq (cdr (car tmp)) (cdr lap1)) + (not (memq (car (cdr lap1)) byte-boolean-vars)) + (let ((newtag (byte-compile-make-tag))) + (byte-compile-log-lap + " %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s" + (nth 1 (cdr lap2)) (car tmp) + lap1 lap2 + (nth 1 (cdr lap2)) (car tmp) + (nth 1 newtag) 'byte-dup lap1 + (cons 'byte-goto newtag) + ) + (setcdr rest (cons (cons 'byte-dup 0) (cdr rest))) + (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp))) + (setq add-depth 1) + (setq keep-going t) + t))))) + ;; + ;; goto-X Y: ... X: goto-if*-Y --> goto-if-not-*-X+1 Y: + ;; (This can pull the loop test to the end of the loop) + ;; + ((and (eq (car lap0) 'byte-goto) + (eq (car lap1) 'TAG) + (let ((tmp (cdr (memq (cdr lap0) (cdr lap-head))))) + (and + (eq lap1 (cdar tmp)) + (memq (car (car tmp)) + '( byte-goto byte-goto-if-nil byte-goto-if-not-nil + byte-goto-if-nil-else-pop)) + (let ((newtag (byte-compile-make-tag))) + (byte-compile-log-lap + " %s %s ... %s %s\t-->\t%s ... %s" + lap0 lap1 (cdr lap0) (car tmp) + (cons (cdr (assq (car (car tmp)) + '((byte-goto-if-nil + . byte-goto-if-not-nil) + (byte-goto-if-not-nil + . byte-goto-if-nil) + (byte-goto-if-nil-else-pop + . byte-goto-if-not-nil-else-pop) + (byte-goto-if-not-nil-else-pop + . byte-goto-if-nil-else-pop)))) + newtag) + newtag) + (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp))) + (when (eq (car (car tmp)) 'byte-goto-if-nil-else-pop) + ;; We can handle this case but not the + ;; -if-not-nil case, because we won't know + ;; which non-nil constant to push. + (setcdr rest + (cons (cons 'byte-constant + (byte-compile-get-constant nil)) + (cdr rest)))) + (setcar lap0 (nth 1 (memq (car (car tmp)) + '(byte-goto-if-nil-else-pop + byte-goto-if-not-nil + byte-goto-if-nil + byte-goto-if-not-nil + byte-goto byte-goto)))) + (setq keep-going t) + t))))) + + ;; + ;; discardN-preserve-tos(X) discardN-preserve-tos(Y) + ;; --> discardN-preserve-tos(X+Y) + ;; where stack-set(1) is accepted as discardN-preserve-tos(1) + ;; + ((and (or (eq (car lap0) 'byte-discardN-preserve-tos) + (and (eq (car lap0) 'byte-stack-set) + (eql (cdr lap0) 1))) + (or (eq (car lap1) 'byte-discardN-preserve-tos) + (and (eq (car lap1) 'byte-stack-set) + (eql (cdr lap1) 1)))) + (setq keep-going t) + (let ((new-op (cons 'byte-discardN-preserve-tos + ;; This happens to work even when either + ;; op is stack-set(1). + (+ (cdr lap0) (cdr lap1))))) + (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 new-op) + (setcar rest new-op) + (setcdr rest (cddr rest)) + (setq prev rest) ; FIXME: temporary compat hack + )) + + ;; + ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos + ;; stack-set-M [discard/discardN ...] --> discardN + ;; + ((and (eq (car lap0) 'byte-stack-set) + (memq (car lap1) '(byte-discard byte-discardN)) + (let ((tmp2 (1- (cdr lap0))) + (tmp3 0) + (tmp (cdr rest))) + ;; See if enough discard operations follow to expose or + ;; destroy the value stored by the stack-set. + (while (memq (car (car tmp)) '(byte-discard byte-discardN)) + (setq tmp3 + (+ tmp3 (if (eq (car (car tmp)) 'byte-discard) + 1 + (cdr (car tmp))))) + (setq tmp (cdr tmp))) + (and + (>= tmp3 tmp2) + (progn + ;; Do the optimization. + (setcdr prev (cdr rest)) + (setcar lap1 + (if (= tmp2 tmp3) + ;; The value stored is the new TOS, so pop + ;; one more value (to get rid of the old + ;; value) using TOS-preserving discard. + 'byte-discardN-preserve-tos + ;; Otherwise, the value stored is lost, + ;; so just use a normal discard. + 'byte-discardN)) + (setcdr lap1 (1+ tmp3)) + (setcdr (cdr rest) tmp) + (byte-compile-log-lap + " %s [discard/discardN]...\t-->\t%s" lap0 lap1) + ;; FIXME: shouldn't we do (setq keep-going t) here? + t + ))))) + + ;; + ;; discardN-preserve-tos return --> return + ;; dup return --> return + ;; stack-set(1) return --> return + ;; + ((and (eq (car lap1) 'byte-return) + (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup)) + (and (eq (car lap0) 'byte-stack-set) + (= (cdr lap0) 1)))) + (setq keep-going t) + ;; The byte-code interpreter will pop the stack for us, so + ;; we can just leave stuff on it. + (setcdr prev (cdr rest)) + (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 lap1)) + + ;; + ;; goto-X ... X: discard ==> discard goto-Y ... X: discard Y: + ;; + ((and (eq (car lap0) 'byte-goto) + (let ((tmp (cdr (memq (cdr lap0) (cdr lap-head))))) + (and + tmp + (or (memq (caar tmp) '(byte-discard byte-discardN)) + ;; Make sure we don't hoist a discardN-preserve-tos + ;; that really should be merged or deleted instead. + (and (eq (caar tmp) 'byte-discardN-preserve-tos) + (let ((next (cadr tmp))) + (not (or (memq (car next) + '(byte-discardN-preserve-tos + byte-return)) + (and (eq (car next) 'byte-stack-set) + (eql (cdr next) 1))))))) + (progn + (byte-compile-log-lap + " goto-X .. X: \t-->\t%s goto-X.. X: %s Y:" + (car tmp) (car tmp)) + (setq keep-going t) + (let* ((newtag (byte-compile-make-tag)) + ;; Make a copy, since we sometimes modify + ;; insts in-place! + (newdiscard (cons (caar tmp) (cdar tmp))) + (newjmp (cons (car lap0) newtag))) + ;; Push new tag after the discard. + (push newtag (cdr tmp)) + (setcar rest newdiscard) + (push newjmp (cdr rest))) + t))))) + + ;; + ;; const discardN-preserve-tos ==> discardN const + ;; const stack-set(1) ==> discard const + ;; + ((and (eq (car lap0) 'byte-constant) + (or (eq (car lap1) 'byte-discardN-preserve-tos) + (and (eq (car lap1) 'byte-stack-set) + (eql (cdr lap1) 1)))) + (setq keep-going t) + (let ((newdiscard (if (eql (cdr lap1) 1) (cons 'byte-discard nil) - (cons 'byte-discardN net-pops))) - (setcdr rest (cddr rest))) - (t (error "Optimizer error: too much on the stack"))))) - ;; - ;; goto(X) X: --> X: - ;; goto-if-[not-]nil(X) X: --> discard X: - ;; - ((and (memq (car lap0) byte-goto-ops) - (eq (cdr lap0) lap1)) - (cond ((eq (car lap0) 'byte-goto) - (byte-compile-log-lap " %s %s\t-->\t %s" - lap0 lap1 lap1) - (setcdr prev (cdr rest))) - ((memq (car lap0) byte-goto-always-pop-ops) - (byte-compile-log-lap " %s %s\t-->\tdiscard %s" - lap0 lap1 lap1) - (setcar lap0 'byte-discard) - (setcdr lap0 0)) - ;; goto-*-else-pop(X) cannot occur here because it would - ;; be a depth conflict. - (t (error "Depth conflict at tag %d" (nth 2 lap0)))) - (setq keep-going t)) - ;; - ;; varset-X varref-X --> dup varset-X - ;; varbind-X varref-X --> dup varbind-X - ;; const/dup varset-X varref-X --> const/dup varset-X const/dup - ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup - ;; The latter two can enable other optimizations. - ;; - ;; For lexical variables, we could do the same - ;; stack-set-X+1 stack-ref-X --> dup stack-set-X+2 - ;; but this is a very minor gain, since dup is stack-ref-0, - ;; i.e. it's only better if X>5, and even then it comes - ;; at the cost of an extra stack slot. Let's not bother. - ((and (eq 'byte-varref (car lap2)) - (eq (cdr lap1) (cdr lap2)) - (memq (car lap1) '(byte-varset byte-varbind)) - (not (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars)) - (not (eq (car lap0) 'byte-constant))))) - (setq keep-going t) - (if (memq (car lap0) '(byte-constant byte-dup)) - (progn - (setq tmp (if (or (not tmp) - (macroexp--const-symbol-p - (car (cdr lap0)))) - (cdr lap0) - (byte-compile-get-constant t))) - (byte-compile-log-lap " %s %s %s\t-->\t%s %s %s" - lap0 lap1 lap2 lap0 lap1 - (cons (car lap0) tmp)) - (setcar lap2 (car lap0)) - (setcdr lap2 tmp)) - (byte-compile-log-lap " %s %s\t-->\tdup %s" lap1 lap2 lap1) - (setcar lap2 (car lap1)) - (setcar lap1 'byte-dup) - (setcdr lap1 0) - ;; The stack depth gets locally increased, so we will - ;; increase maxdepth in case depth = maxdepth here. - ;; This can cause the third argument to byte-code to - ;; be larger than necessary. - (setq add-depth 1))) - ;; - ;; dup varset-X discard --> varset-X - ;; dup varbind-X discard --> varbind-X - ;; dup stack-set-X discard --> stack-set-X-1 - ;; (the varbind variant can emerge from other optimizations) - ;; - ((and (eq 'byte-dup (car lap0)) - (eq 'byte-discard (car lap2)) - (memq (car lap1) '(byte-varset byte-varbind - byte-stack-set))) - (setq keep-going t) - (setcdr prev (cdr rest)) ; remove dup - (setcdr (cdr rest) (cdddr rest)) ; remove discard - (setq prev (cdr rest)) ; FIXME: temporary compat hack - (cond ((not (eq (car lap1) 'byte-stack-set)) - (byte-compile-log-lap " %s %s %s\t-->\t%s" - lap0 lap1 lap2 lap1)) - ((eql (cdr lap1) 1) - (byte-compile-log-lap " %s %s %s\t-->\t" - lap0 lap1 lap2)) - (t - (let ((n (1- (cdr lap1)))) - (byte-compile-log-lap " %s %s %s\t-->\t%s" - lap0 lap1 lap2 - (cons (car lap1) n)) - (setcdr lap1 n))))) - ;; - ;; not goto-X-if-nil --> goto-X-if-non-nil - ;; not goto-X-if-non-nil --> goto-X-if-nil - ;; - ;; it is wrong to do the same thing for the -else-pop variants. - ;; - ((and (eq 'byte-not (car lap0)) - (memq (car lap1) '(byte-goto-if-nil byte-goto-if-not-nil))) - (let ((not-goto (if (eq (car lap1) 'byte-goto-if-nil) - 'byte-goto-if-not-nil - 'byte-goto-if-nil))) - (byte-compile-log-lap " not %s\t-->\t%s" - lap1 (cons not-goto (cdr lap1))) - (setcar lap1 not-goto) - (setcdr prev (cdr rest)) ; delete not - (setq keep-going t))) - ;; - ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X: - ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X: - ;; - ;; it is wrong to do the same thing for the -else-pop variants. - ;; - ((and (memq (car lap0) - '(byte-goto-if-nil byte-goto-if-not-nil)) ; gotoX - (eq 'byte-goto (car lap1)) ; gotoY - (eq (cdr lap0) lap2)) ; TAG X - (let ((inverse (if (eq 'byte-goto-if-nil (car lap0)) - 'byte-goto-if-not-nil 'byte-goto-if-nil))) - (byte-compile-log-lap " %s %s %s\t-->\t%s %s" - lap0 lap1 lap2 - (cons inverse (cdr lap1)) lap2) - (setcdr prev (cdr rest)) - (setcar lap1 inverse) - (setq keep-going t))) - ;; - ;; const goto-if-* --> whatever - ;; - ((and (eq 'byte-constant (car lap0)) - (memq (car lap1) byte-conditional-ops) - ;; Must be an actual constant, not a closure variable. - (consp (cdr lap0))) - (cond ((if (memq (car lap1) '(byte-goto-if-nil - byte-goto-if-nil-else-pop)) - (car (cdr lap0)) - (not (car (cdr lap0)))) - ;; Branch not taken. - (byte-compile-log-lap " %s %s\t-->\t" - lap0 lap1) - (setcdr prev (cddr rest))) ; delete both - ((memq (car lap1) byte-goto-always-pop-ops) - ;; Always-pop branch taken. - (byte-compile-log-lap " %s %s\t-->\t%s" - lap0 lap1 - (cons 'byte-goto (cdr lap1))) - (setcdr prev (cdr rest)) ; delete const - (setcar lap1 'byte-goto)) - (t ; -else-pop branch taken: keep const - (byte-compile-log-lap " %s %s\t-->\t%s %s" - lap0 lap1 - lap0 (cons 'byte-goto (cdr lap1))) - (setcar lap1 'byte-goto) - (setq prev (cdr prev)) ; FIXME: temporary compat hack - )) - (setq keep-going t)) - ;; - ;; varref-X varref-X --> varref-X dup - ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup - ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup - ;; We don't optimize the const-X variations on this here, - ;; because that would inhibit some goto optimizations; we - ;; optimize the const-X case after all other optimizations. - ;; - ((and (memq (car lap0) '(byte-varref byte-stack-ref)) - (progn - (setq tmp (cdr rest)) - (setq tmp2 0) - (while (eq (car (car tmp)) 'byte-dup) - (setq tmp2 (1+ tmp2)) - (setq tmp (cdr tmp))) - t) - (eq (if (eq 'byte-stack-ref (car lap0)) - (+ tmp2 1 (cdr lap0)) - (cdr lap0)) - (cdr (car tmp))) - (eq (car lap0) (car (car tmp)))) - (if (memq byte-optimize-log '(t byte)) - (let ((str "")) - (setq tmp2 (cdr rest)) - (while (not (eq tmp tmp2)) - (setq tmp2 (cdr tmp2) - str (concat str " dup"))) - (byte-compile-log-lap " %s%s %s\t-->\t%s%s dup" - lap0 str lap0 lap0 str))) - (setq keep-going t) - (setcar (car tmp) 'byte-dup) - (setcdr (car tmp) 0)) - ;; - ;; TAG1: TAG2: --> TAG2: - ;; (and other references to TAG1 are replaced with TAG2) - ;; - ((and (eq (car lap0) 'TAG) - (eq (car lap1) 'TAG)) - (byte-compile-log-lap " adjacent tags %d and %d merged" - (nth 1 lap1) (nth 1 lap0)) - (setq tmp3 (cdr lap-head)) - (while (setq tmp2 (rassq lap0 tmp3)) - (setcdr tmp2 lap1) - (setq tmp3 (cdr (memq tmp2 tmp3)))) - (setcdr prev (cdr rest)) - (setq keep-going t) - ;; replace references to tag in jump tables, if any - (dolist (table byte-compile-jump-tables) - (maphash #'(lambda (value tag) - (when (equal tag lap0) - (puthash value lap1 table))) - table))) - ;; - ;; unused-TAG: --> - ;; - ((and (eq 'TAG (car lap0)) - (not (rassq lap0 (cdr lap-head))) - ;; make sure this tag isn't used in a jump-table - (cl-loop for table in byte-compile-jump-tables - when (member lap0 (hash-table-values table)) - return nil finally return t)) - (byte-compile-log-lap " unused tag %d removed" (nth 1 lap0)) - (setcdr prev (cdr rest)) - (setq keep-going t)) - ;; - ;; goto ... --> goto - ;; return ... --> return - ;; - ((and (memq (car lap0) '(byte-goto byte-return)) - (not (memq (car lap1) '(TAG nil)))) - (setq tmp rest) - (let ((i 0) - (opt-p (memq byte-optimize-log '(t byte))) - str deleted) - (while (and (setq tmp (cdr tmp)) - (not (eq 'TAG (car (car tmp))))) - (if opt-p (setq deleted (cons (car tmp) deleted) - str (concat str " %s") - i (1+ i)))) - (if opt-p - (let ((tagstr - (if (eq 'TAG (car (car tmp))) - (format "%d:" (car (cdr (car tmp)))) - (or (car tmp) "")))) - (if (< i 6) - (apply 'byte-compile-log-lap-1 - (concat " %s" str - " %s\t-->\t%s %s") - lap0 - (nconc (nreverse deleted) - (list tagstr lap0 tagstr))) - (byte-compile-log-lap - " %s <%d unreachable op%s> %s\t-->\t%s %s" - lap0 i (if (= i 1) "" "s") - tagstr lap0 tagstr)))) - (setcdr rest tmp)) - (setq prev rest) ; FIXME: temporary compat hack - (setq keep-going t)) - ;; - ;; unbind --> unbind - ;; (this may enable other optimizations.) - ;; - ((and (eq 'byte-unbind (car lap1)) - (memq (car lap0) byte-after-unbind-ops)) - (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0) - (setcar rest lap1) - (setcar (cdr rest) lap0) - (setq keep-going t)) - ;; - ;; varbind-X unbind-N --> discard unbind-(N-1) - ;; save-excursion unbind-N --> unbind-(N-1) - ;; save-restriction unbind-N --> unbind-(N-1) - ;; save-current-buffer unbind-N --> unbind-(N-1) - ;; - ((and (eq 'byte-unbind (car lap1)) - (memq (car lap0) '(byte-varbind byte-save-excursion - byte-save-restriction - byte-save-current-buffer)) - (< 0 (cdr lap1))) - (setcdr lap1 (1- (cdr lap1))) - (when (zerop (cdr lap1)) - (setcdr rest (cddr rest))) - (if (eq (car lap0) 'byte-varbind) - (setcar rest (cons 'byte-discard 0)) - (setcdr prev (cddr prev))) - (byte-compile-log-lap " %s %s\t-->\t%s %s" - lap0 (cons (car lap1) (1+ (cdr lap1))) - (if (eq (car lap0) 'byte-varbind) - (car rest) - (car (cdr rest))) - (if (and (/= 0 (cdr lap1)) - (eq (car lap0) 'byte-varbind)) - (car (cdr rest)) - "")) - (setq keep-going t)) - ;; - ;; goto*-X ... X: goto-Y --> goto*-Y - ;; goto-X ... X: return --> return - ;; - ((and (memq (car lap0) byte-goto-ops) - (memq (car (setq tmp (nth 1 (memq (cdr lap0) (cdr lap-head))))) - '(byte-goto byte-return)) - (or (eq (car lap0) 'byte-goto) - (eq (car tmp) 'byte-goto)) - (not (eq (cdr tmp) (cdr lap0)))) - ;; FIXME: inaccurate log message when lap0 = goto-if-* - (byte-compile-log-lap " %s [%s]\t-->\t%s" (car lap0) tmp tmp) - (when (eq (car tmp) 'byte-return) - (setcar lap0 'byte-return)) - (setcdr lap0 (cdr tmp)) - (setq prev (cdr prev)) ; FIXME: temporary compat hack - (setq keep-going t)) - - ;; - ;; OP goto(X) Y: OP X: -> Y: OP X: - ;; - ((and (eq (car lap1) 'byte-goto) - (eq (car lap2) 'TAG) - (let ((lap3 (nth 3 rest))) - (and (eq (car lap0) (car lap3)) - (eq (cdr lap0) (cdr lap3)) - (eq (cdr lap1) (nth 4 rest))))) - (byte-compile-log-lap " %s %s %s %s %s\t-->\t%s %s %s" - lap0 lap1 lap2 - (nth 3 rest) (nth 4 rest) - lap2 (nth 3 rest) (nth 4 rest)) - (setcdr prev (cddr rest)) - (setq keep-going t)) - - ;; - ;; OP const return --> const return - ;; where OP is side-effect-free (or mere stack manipulation). - ;; - ((and (eq (car lap1) 'byte-constant) - (eq (car (nth 2 rest)) 'byte-return) - (or (memq (car lap0) '( byte-discard byte-discardN - byte-discardN-preserve-tos - byte-stack-set)) - (memq (car lap0) side-effect-free))) - (setq keep-going t) - (setq add-depth 1) ; in case we get rid of too much stack reduction - (setcdr prev (cdr rest)) - (byte-compile-log-lap " %s %s %s\t-->\t%s %s" - lap0 lap1 (nth 2 rest) lap1 (nth 2 rest))) - - ;; - ;; goto-*-else-pop X ... X: goto-if-* --> whatever - ;; goto-*-else-pop X ... X: discard --> whatever - ;; - ((and (memq (car lap0) '(byte-goto-if-nil-else-pop - byte-goto-if-not-nil-else-pop)) - (memq (caar (setq tmp (cdr (memq (cdr lap0) (cdr lap-head))))) - (eval-when-compile - (cons 'byte-discard byte-conditional-ops))) - (not (eq lap0 (car tmp)))) - (setq tmp2 (car tmp)) - (setq tmp3 (assq (car lap0) '((byte-goto-if-nil-else-pop - byte-goto-if-nil) - (byte-goto-if-not-nil-else-pop - byte-goto-if-not-nil)))) - (if (memq (car tmp2) tmp3) - (progn (setcar lap0 (car tmp2)) - (setcdr lap0 (cdr tmp2)) - (byte-compile-log-lap " %s-else-pop [%s]\t-->\t%s" - (car lap0) tmp2 lap0)) - ;; Get rid of the -else-pop's and jump one step further. - (or (eq 'TAG (car (nth 1 tmp))) - (setcdr tmp (cons (byte-compile-make-tag) - (cdr tmp)))) - (byte-compile-log-lap " %s [%s]\t-->\t%s " - (car lap0) tmp2 (nth 1 tmp3)) - (setcar lap0 (nth 1 tmp3)) - (setcdr lap0 (nth 1 tmp))) - (setq prev (cdr prev)) ; FIXME: temporary compat hack - (setq keep-going t)) - ;; - ;; const goto-X ... X: goto-if-* --> whatever - ;; const goto-X ... X: discard --> whatever - ;; - ((and (eq (car lap0) 'byte-constant) - (eq (car lap1) 'byte-goto) - (memq (caar (setq tmp (cdr (memq (cdr lap1) (cdr lap-head))))) - (eval-when-compile - (cons 'byte-discard byte-conditional-ops))) - (not (eq lap1 (car tmp)))) - (setq tmp2 (car tmp)) - (cond ((when (consp (cdr lap0)) - (memq (car tmp2) - (if (null (car (cdr lap0))) - '(byte-goto-if-nil byte-goto-if-nil-else-pop) - '(byte-goto-if-not-nil - byte-goto-if-not-nil-else-pop)))) - (byte-compile-log-lap " %s goto [%s]\t-->\t%s %s" - lap0 tmp2 lap0 tmp2) - (setcar lap1 (car tmp2)) - (setcdr lap1 (cdr tmp2)) - ;; Let next step fix the (const,goto-if*) sequence. - (setq keep-going t)) - ((or (consp (cdr lap0)) - (eq (car tmp2) 'byte-discard)) - ;; Jump one step further - (byte-compile-log-lap - " %s goto [%s]\t-->\t goto " - lap0 tmp2) - (or (eq 'TAG (car (nth 1 tmp))) - (setcdr tmp (cons (byte-compile-make-tag) - (cdr tmp)))) - (setcdr lap1 (car (cdr tmp))) - (setcdr prev (cdr rest)) - (setq keep-going t)) - (t - (setq prev (cdr prev))))) - ;; - ;; X: varref-Y ... varset-Y goto-X --> - ;; X: varref-Y Z: ... dup varset-Y goto-Z - ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.) - ;; (This is so usual for while loops that it is worth handling). - ;; - ;; Here again, we could do it for stack-ref/stack-set, but - ;; that's replacing a stack-ref-Y with a stack-ref-0, which - ;; is a very minor improvement (if any), at the cost of - ;; more stack use and more byte-code. Let's not do it. - ;; - ((and (eq (car lap1) 'byte-varset) - (eq (car lap2) 'byte-goto) - (not (memq (cdr lap2) rest)) ;Backwards jump - (eq (car (car (setq tmp (cdr (memq (cdr lap2) (cdr lap-head)))))) - 'byte-varref) - (eq (cdr (car tmp)) (cdr lap1)) - (not (memq (car (cdr lap1)) byte-boolean-vars))) - ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp)) - (let ((newtag (byte-compile-make-tag))) - (byte-compile-log-lap - " %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s" - (nth 1 (cdr lap2)) (car tmp) - lap1 lap2 - (nth 1 (cdr lap2)) (car tmp) - (nth 1 newtag) 'byte-dup lap1 - (cons 'byte-goto newtag) - ) - (setcdr rest (cons (cons 'byte-dup 0) (cdr rest))) - (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp)))) - (setq add-depth 1) - (setq keep-going t)) - ;; - ;; goto-X Y: ... X: goto-if*-Y --> goto-if-not-*-X+1 Y: - ;; (This can pull the loop test to the end of the loop) - ;; - ((and (eq (car lap0) 'byte-goto) - (eq (car lap1) 'TAG) - (eq lap1 - (cdar (setq tmp (cdr (memq (cdr lap0) (cdr lap-head)))))) - (memq (car (car tmp)) - '(byte-goto byte-goto-if-nil byte-goto-if-not-nil - byte-goto-if-nil-else-pop))) - (let ((newtag (byte-compile-make-tag))) - (byte-compile-log-lap - " %s %s ... %s %s\t-->\t%s ... %s" - lap0 lap1 (cdr lap0) (car tmp) - (cons (cdr (assq (car (car tmp)) - '((byte-goto-if-nil . byte-goto-if-not-nil) - (byte-goto-if-not-nil . byte-goto-if-nil) - (byte-goto-if-nil-else-pop . - byte-goto-if-not-nil-else-pop) - (byte-goto-if-not-nil-else-pop . - byte-goto-if-nil-else-pop)))) - newtag) - - newtag) - (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp))) - (if (eq (car (car tmp)) 'byte-goto-if-nil-else-pop) - ;; We can handle this case but not the -if-not-nil case, - ;; because we won't know which non-nil constant to push. - (setcdr rest (cons (cons 'byte-constant - (byte-compile-get-constant nil)) - (cdr rest)))) - (setcar lap0 (nth 1 (memq (car (car tmp)) - '(byte-goto-if-nil-else-pop - byte-goto-if-not-nil - byte-goto-if-nil - byte-goto-if-not-nil - byte-goto byte-goto)))) - ) - (setq keep-going t)) - - ;; - ;; discardN-preserve-tos(X) discardN-preserve-tos(Y) - ;; --> discardN-preserve-tos(X+Y) - ;; where stack-set(1) is accepted as discardN-preserve-tos(1) - ;; - ((and (or (eq (car lap0) 'byte-discardN-preserve-tos) - (and (eq (car lap0) 'byte-stack-set) (eql (cdr lap0) 1))) - (or (eq (car lap1) 'byte-discardN-preserve-tos) - (and (eq (car lap1) 'byte-stack-set) (eql (cdr lap1) 1)))) - (setq keep-going t) - (let ((new-op (cons 'byte-discardN-preserve-tos - ;; This happens to work even when either - ;; op is stack-set(1). - (+ (cdr lap0) (cdr lap1))))) - (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 new-op) - (setcar rest new-op) - (setcdr rest (cddr rest)) - (setq prev rest) ; FIXME: temporary compat hack - )) - - ;; - ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos - ;; stack-set-M [discard/discardN ...] --> discardN - ;; - ((and (eq (car lap0) 'byte-stack-set) - (memq (car lap1) '(byte-discard byte-discardN)) - (progn - ;; See if enough discard operations follow to expose or - ;; destroy the value stored by the stack-set. - (setq tmp (cdr rest)) - (setq tmp2 (1- (cdr lap0))) - (setq tmp3 0) - (while (memq (car (car tmp)) '(byte-discard byte-discardN)) - (setq tmp3 - (+ tmp3 (if (eq (car (car tmp)) 'byte-discard) - 1 - (cdr (car tmp))))) - (setq tmp (cdr tmp))) - (>= tmp3 tmp2))) - ;; Do the optimization. - (setcdr prev (cdr rest)) - (setcar lap1 - (if (= tmp2 tmp3) - ;; The value stored is the new TOS, so pop one more - ;; value (to get rid of the old value) using the - ;; TOS-preserving discard operator. - 'byte-discardN-preserve-tos - ;; Otherwise, the value stored is lost, so just use a - ;; normal discard. - 'byte-discardN)) - (setcdr lap1 (1+ tmp3)) - (setcdr (cdr rest) tmp) - (byte-compile-log-lap " %s [discard/discardN]...\t-->\t%s" - lap0 lap1) - ;; FIXME: shouldn't we do (setq keep-going t) here? - ) - - ;; - ;; discardN-preserve-tos return --> return - ;; dup return --> return - ;; stack-set(1) return --> return - ;; - ((and (eq (car lap1) 'byte-return) - (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup)) - (and (eq (car lap0) 'byte-stack-set) - (= (cdr lap0) 1)))) - (setq keep-going t) - ;; The byte-code interpreter will pop the stack for us, so - ;; we can just leave stuff on it. - (setcdr prev (cdr rest)) - (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 lap1)) - - ;; - ;; goto-X ... X: discard ==> discard goto-Y ... X: discard Y: - ;; - ((and (eq (car lap0) 'byte-goto) - (setq tmp (cdr (memq (cdr lap0) (cdr lap-head)))) - (or (memq (caar tmp) '(byte-discard byte-discardN)) - ;; Make sure we don't hoist a discardN-preserve-tos - ;; that really should be merged or deleted instead. - (and (eq (caar tmp) 'byte-discardN-preserve-tos) - (let ((next (cadr tmp))) - (not (or (memq (car next) '(byte-discardN-preserve-tos - byte-return)) - (and (eq (car next) 'byte-stack-set) - (eql (cdr next) 1)))))))) - (byte-compile-log-lap - " goto-X .. X: \t-->\t%s goto-X.. X: %s Y:" - (car tmp) (car tmp)) - (setq keep-going t) - (let* ((newtag (byte-compile-make-tag)) - ;; Make a copy, since we sometimes modify insts in-place! - (newdiscard (cons (caar tmp) (cdar tmp))) - (newjmp (cons (car lap0) newtag))) - (push newtag (cdr tmp)) ;Push new tag after the discard. - (setcar rest newdiscard) - (push newjmp (cdr rest)))) - - ;; - ;; const discardN-preserve-tos ==> discardN const - ;; const stack-set(1) ==> discard const - ;; - ((and (eq (car lap0) 'byte-constant) - (or (eq (car lap1) 'byte-discardN-preserve-tos) - (and (eq (car lap1) 'byte-stack-set) - (eql (cdr lap1) 1)))) - (setq keep-going t) - (let ((newdiscard (if (eql (cdr lap1) 1) - (cons 'byte-discard nil) - (cons 'byte-discardN (cdr lap1))))) - (byte-compile-log-lap - " %s %s\t-->\t%s %s" lap0 lap1 newdiscard lap0) - (setf (car rest) newdiscard) - (setf (cadr rest) lap0)) - (setq prev (cdr prev)) ; FIXME: temporary compat hack - ) - (t - ;; If no rule matched, advance and try again. - (setq prev (cdr prev)))))) + (cons 'byte-discardN (cdr lap1))))) + (byte-compile-log-lap + " %s %s\t-->\t%s %s" lap0 lap1 newdiscard lap0) + (setf (car rest) newdiscard) + (setf (cadr rest) lap0)) + (setq prev (cdr prev)) ; FIXME: temporary compat hack + ) + (t + ;; If no rule matched, advance and try again. + (setq prev (cdr prev)))))))) ;; Cleanup stage: ;; Rebuild byte-compile-constants / byte-compile-variables. ;; Simple optimizations that would inhibit other optimizations if they @@ -2669,81 +2707,82 @@ byte-optimize-lapcode ;; need to do more than once. (setq byte-compile-constants nil byte-compile-variables nil) - (setq prev lap-head) (byte-compile-log-lap " ---- final pass") - (while (cdr prev) - (setq rest (cdr prev)) - (setq lap0 (car rest) - lap1 (nth 1 rest)) - ;; FIXME: Would there ever be a `byte-constant2' op here? - (if (memq (car lap0) byte-constref-ops) - (if (memq (car lap0) '(byte-constant byte-constant2)) - (unless (memq (cdr lap0) byte-compile-constants) - (setq byte-compile-constants (cons (cdr lap0) - byte-compile-constants))) - (unless (memq (cdr lap0) byte-compile-variables) - (setq byte-compile-variables (cons (cdr lap0) - byte-compile-variables))))) - (cond (;; - ;; const-C varset-X const-C --> const-C dup varset-X - ;; const-C varbind-X const-C --> const-C dup varbind-X - ;; - (and (eq (car lap0) 'byte-constant) - (eq (car (nth 2 rest)) 'byte-constant) - (eq (cdr lap0) (cdr (nth 2 rest))) - (memq (car lap1) '(byte-varbind byte-varset))) - (byte-compile-log-lap " %s %s %s\t-->\t%s dup %s" - lap0 lap1 lap0 lap0 lap1) - (setcar (cdr (cdr rest)) (cons (car lap1) (cdr lap1))) - (setcar (cdr rest) (cons 'byte-dup 0)) - (setq add-depth 1)) - ;; - ;; const-X [dup/const-X ...] --> const-X [dup ...] dup - ;; varref-X [dup/varref-X ...] --> varref-X [dup ...] dup - ;; - ((memq (car lap0) '(byte-constant byte-varref)) - (setq tmp rest - tmp2 nil) - (while (progn - (while (eq 'byte-dup (car (car (setq tmp (cdr tmp)))))) - (and (eq (cdr lap0) (cdr (car tmp))) - (eq (car lap0) (car (car tmp))))) - (setcar tmp (cons 'byte-dup 0)) - (setq tmp2 t)) - (if tmp2 - (byte-compile-log-lap - " %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0) - (setq prev (cdr prev)))) - ;; - ;; unbind-N unbind-M --> unbind-(N+M) - ;; - ((and (eq 'byte-unbind (car lap0)) - (eq 'byte-unbind (car lap1))) - (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 - (cons 'byte-unbind - (+ (cdr lap0) (cdr lap1)))) - (setcdr prev (cdr rest)) - (setcdr lap1 (+ (cdr lap1) (cdr lap0)))) - - ;; - ;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y --> - ;; discardN-(X+Y) - ;; - ((and (memq (car lap0) - '(byte-discard byte-discardN - byte-discardN-preserve-tos)) - (memq (car lap1) '(byte-discard byte-discardN))) - (setcdr prev (cdr rest)) - (byte-compile-log-lap - " %s %s\t-->\t(discardN %s)" - lap0 lap1 - (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0)) - (if (eq (car lap1) 'byte-discard) 1 (cdr lap1)))) - (setcdr lap1 (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0)) - (if (eq (car lap1) 'byte-discard) 1 (cdr lap1)))) - (setcar lap1 'byte-discardN)) - (t - (setq prev (cdr prev))))) + (let ((prev lap-head)) + (while (cdr prev) + (let* ((rest (cdr prev)) + (lap0 (car rest)) + (lap1 (nth 1 rest))) + ;; FIXME: Would there ever be a `byte-constant2' op here? + (if (memq (car lap0) byte-constref-ops) + (if (memq (car lap0) '(byte-constant byte-constant2)) + (unless (memq (cdr lap0) byte-compile-constants) + (setq byte-compile-constants (cons (cdr lap0) + byte-compile-constants))) + (unless (memq (cdr lap0) byte-compile-variables) + (setq byte-compile-variables (cons (cdr lap0) + byte-compile-variables))))) + (cond + ;; + ;; const-C varset-X const-C --> const-C dup varset-X + ;; const-C varbind-X const-C --> const-C dup varbind-X + ;; + ((and (eq (car lap0) 'byte-constant) + (eq (car (nth 2 rest)) 'byte-constant) + (eq (cdr lap0) (cdr (nth 2 rest))) + (memq (car lap1) '(byte-varbind byte-varset))) + (byte-compile-log-lap " %s %s %s\t-->\t%s dup %s" + lap0 lap1 lap0 lap0 lap1) + (setcar (cdr (cdr rest)) (cons (car lap1) (cdr lap1))) + (setcar (cdr rest) (cons 'byte-dup 0)) + (setq add-depth 1)) + ;; + ;; const-X [dup/const-X ...] --> const-X [dup ...] dup + ;; varref-X [dup/varref-X ...] --> varref-X [dup ...] dup + ;; + ((memq (car lap0) '(byte-constant byte-varref)) + (let ((tmp rest) + (tmp2 nil)) + (while (progn + (while (eq 'byte-dup (car (car (setq tmp (cdr tmp)))))) + (and (eq (cdr lap0) (cdr (car tmp))) + (eq (car lap0) (car (car tmp))))) + (setcar tmp (cons 'byte-dup 0)) + (setq tmp2 t)) + (if tmp2 + (byte-compile-log-lap + " %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0) + (setq prev (cdr prev))))) + ;; + ;; unbind-N unbind-M --> unbind-(N+M) + ;; + ((and (eq 'byte-unbind (car lap0)) + (eq 'byte-unbind (car lap1))) + (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 + (cons 'byte-unbind + (+ (cdr lap0) (cdr lap1)))) + (setcdr prev (cdr rest)) + (setcdr lap1 (+ (cdr lap1) (cdr lap0)))) + + ;; + ;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y --> + ;; discardN-(X+Y) + ;; + ((and (memq (car lap0) + '(byte-discard byte-discardN + byte-discardN-preserve-tos)) + (memq (car lap1) '(byte-discard byte-discardN))) + (setcdr prev (cdr rest)) + (byte-compile-log-lap + " %s %s\t-->\t(discardN %s)" + lap0 lap1 + (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0)) + (if (eq (car lap1) 'byte-discard) 1 (cdr lap1)))) + (setcdr lap1 (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0)) + (if (eq (car lap1) 'byte-discard) 1 (cdr lap1)))) + (setcar lap1 'byte-discardN)) + (t + (setq prev (cdr prev))))))) (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)) (cdr lap-head))) commit 929099cbb435f8bc9461b8f0ba99a5f8c2093222 Author: Mattias Engdegård Date: Sat Feb 4 18:58:48 2023 +0100 Get rid of delq in LAP optimiser * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Instead of using the O(n) `delq' to remove single instructions, use the O(1) `setcdr'. To do this, anchor the instruction list in a cons cell and use the predecessor cell in iteration. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 861cf95b1ff..5ffaf4adedd 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1955,6 +1955,7 @@ byte-conditional-ops byte-goto-if-not-nil-else-pop)) (defconst byte-after-unbind-ops + ;; FIXME: add discardN, discardN-preserve-tos '(byte-constant byte-dup byte-stack-ref byte-stack-set byte-discard byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp byte-eq byte-not @@ -2019,21 +2020,23 @@ byte-compile-side-effect-free-ops (defun byte-optimize-lapcode (lap &optional _for-effect) "Simple peephole optimizer. LAP is both modified and returned. If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." - (let (lap0 - lap1 - lap2 - (keep-going 'first-time) - (add-depth 0) - rest tmp tmp2 tmp3 - (side-effect-free (if byte-compile-delete-errors + (let ((side-effect-free (if byte-compile-delete-errors byte-compile-side-effect-free-ops - byte-compile-side-effect-and-error-free-ops))) + byte-compile-side-effect-and-error-free-ops)) + (add-depth 0) + (keep-going 'first-time) + ;; Create a cons cell as head of the list so that removing the first + ;; element does not need special-casing: `setcdr' always works. + (lap-head (cons nil lap)) + lap0 lap1 lap2 + rest prev tmp tmp2 tmp3) (while keep-going (or (eq keep-going 'first-time) (byte-compile-log-lap " ---- next pass")) - (setq rest lap - keep-going nil) - (while rest + (setq prev lap-head) + (setq keep-going nil) + (while (cdr prev) + (setq rest (cdr prev)) (setq lap0 (car rest) lap1 (nth 1 rest) lap2 (nth 2 rest)) @@ -2041,6 +2044,9 @@ byte-optimize-lapcode ;; You may notice that sequences like "dup varset discard" are ;; optimized but sequences like "dup varset TAG1: discard" are not. ;; You may be tempted to change this; resist that temptation. + + ;; Each clause in this `cond' statement must keep `prev' the + ;; predecessor of the remainder of the list for inspection. (cond ;; ;; PUSH(K) discard(N) --> discard(N-K), N>K @@ -2055,8 +2061,7 @@ byte-optimize-lapcode (net-pops (- pops pushes))) (cond ((= net-pops 0) (byte-compile-log-lap " %s %s\t-->\t" lap0 lap1) - (setcdr rest (cddr rest)) - (setq lap (delq lap0 lap))) + (setcdr prev (cddr rest))) ((> net-pops 0) (byte-compile-log-lap " %s %s\t-->\t discard(%d)" lap0 lap1 net-pops) @@ -2066,19 +2071,23 @@ byte-optimize-lapcode (setcdr rest (cddr rest))) (t (error "Optimizer error: too much on the stack"))))) ;; - ;; goto*-X X: --> X: + ;; goto(X) X: --> X: + ;; goto-if-[not-]nil(X) X: --> discard X: ;; ((and (memq (car lap0) byte-goto-ops) (eq (cdr lap0) lap1)) (cond ((eq (car lap0) 'byte-goto) - (setq lap (delq lap0 lap)) - (setq tmp "")) + (byte-compile-log-lap " %s %s\t-->\t %s" + lap0 lap1 lap1) + (setcdr prev (cdr rest))) ((memq (car lap0) byte-goto-always-pop-ops) - (setcar lap0 (setq tmp 'byte-discard)) + (byte-compile-log-lap " %s %s\t-->\tdiscard %s" + lap0 lap1 lap1) + (setcar lap0 'byte-discard) (setcdr lap0 0)) - ((error "Depth conflict at tag %d" (nth 2 lap0)))) - (byte-compile-log-lap " %s %s\t-->\t%s %s" - lap0 lap1 tmp lap1) + ;; goto-*-else-pop(X) cannot occur here because it would + ;; be a depth conflict. + (t (error "Depth conflict at tag %d" (nth 2 lap0)))) (setq keep-going t)) ;; ;; varset-X varref-X --> dup varset-X @@ -2094,32 +2103,31 @@ byte-optimize-lapcode ;; at the cost of an extra stack slot. Let's not bother. ((and (eq 'byte-varref (car lap2)) (eq (cdr lap1) (cdr lap2)) - (memq (car lap1) '(byte-varset byte-varbind))) - (if (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars)) - (not (eq (car lap0) 'byte-constant))) - nil - (setq keep-going t) - (if (memq (car lap0) '(byte-constant byte-dup)) - (progn - (setq tmp (if (or (not tmp) - (macroexp--const-symbol-p - (car (cdr lap0)))) - (cdr lap0) - (byte-compile-get-constant t))) - (byte-compile-log-lap " %s %s %s\t-->\t%s %s %s" - lap0 lap1 lap2 lap0 lap1 - (cons (car lap0) tmp)) - (setcar lap2 (car lap0)) - (setcdr lap2 tmp)) - (byte-compile-log-lap " %s %s\t-->\tdup %s" lap1 lap2 lap1) - (setcar lap2 (car lap1)) - (setcar lap1 'byte-dup) - (setcdr lap1 0) - ;; The stack depth gets locally increased, so we will - ;; increase maxdepth in case depth = maxdepth here. - ;; This can cause the third argument to byte-code to - ;; be larger than necessary. - (setq add-depth 1)))) + (memq (car lap1) '(byte-varset byte-varbind)) + (not (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars)) + (not (eq (car lap0) 'byte-constant))))) + (setq keep-going t) + (if (memq (car lap0) '(byte-constant byte-dup)) + (progn + (setq tmp (if (or (not tmp) + (macroexp--const-symbol-p + (car (cdr lap0)))) + (cdr lap0) + (byte-compile-get-constant t))) + (byte-compile-log-lap " %s %s %s\t-->\t%s %s %s" + lap0 lap1 lap2 lap0 lap1 + (cons (car lap0) tmp)) + (setcar lap2 (car lap0)) + (setcdr lap2 tmp)) + (byte-compile-log-lap " %s %s\t-->\tdup %s" lap1 lap2 lap1) + (setcar lap2 (car lap1)) + (setcar lap1 'byte-dup) + (setcdr lap1 0) + ;; The stack depth gets locally increased, so we will + ;; increase maxdepth in case depth = maxdepth here. + ;; This can cause the third argument to byte-code to + ;; be larger than necessary. + (setq add-depth 1))) ;; ;; dup varset-X discard --> varset-X ;; dup varbind-X discard --> varbind-X @@ -2129,12 +2137,23 @@ byte-optimize-lapcode ((and (eq 'byte-dup (car lap0)) (eq 'byte-discard (car lap2)) (memq (car lap1) '(byte-varset byte-varbind - byte-stack-set))) - (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1) - (setq keep-going t - rest (cdr rest)) - (if (eq 'byte-stack-set (car lap1)) (cl-decf (cdr lap1))) - (setq lap (delq lap0 (delq lap2 lap)))) + byte-stack-set))) + (setq keep-going t) + (setcdr prev (cdr rest)) ; remove dup + (setcdr (cdr rest) (cdddr rest)) ; remove discard + (setq prev (cdr rest)) ; FIXME: temporary compat hack + (cond ((not (eq (car lap1) 'byte-stack-set)) + (byte-compile-log-lap " %s %s %s\t-->\t%s" + lap0 lap1 lap2 lap1)) + ((eql (cdr lap1) 1) + (byte-compile-log-lap " %s %s %s\t-->\t" + lap0 lap1 lap2)) + (t + (let ((n (1- (cdr lap1)))) + (byte-compile-log-lap " %s %s %s\t-->\t%s" + lap0 lap1 lap2 + (cons (car lap1) n)) + (setcdr lap1 n))))) ;; ;; not goto-X-if-nil --> goto-X-if-non-nil ;; not goto-X-if-non-nil --> goto-X-if-nil @@ -2143,18 +2162,14 @@ byte-optimize-lapcode ;; ((and (eq 'byte-not (car lap0)) (memq (car lap1) '(byte-goto-if-nil byte-goto-if-not-nil))) - (byte-compile-log-lap " not %s\t-->\t%s" - lap1 - (cons - (if (eq (car lap1) 'byte-goto-if-nil) - 'byte-goto-if-not-nil - 'byte-goto-if-nil) - (cdr lap1))) - (setcar lap1 (if (eq (car lap1) 'byte-goto-if-nil) - 'byte-goto-if-not-nil - 'byte-goto-if-nil)) - (setq lap (delq lap0 lap)) - (setq keep-going t)) + (let ((not-goto (if (eq (car lap1) 'byte-goto-if-nil) + 'byte-goto-if-not-nil + 'byte-goto-if-nil))) + (byte-compile-log-lap " not %s\t-->\t%s" + lap1 (cons not-goto (cdr lap1))) + (setcar lap1 not-goto) + (setcdr prev (cdr rest)) ; delete not + (setq keep-going t))) ;; ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X: ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X: @@ -2170,7 +2185,7 @@ byte-optimize-lapcode (byte-compile-log-lap " %s %s %s\t-->\t%s %s" lap0 lap1 lap2 (cons inverse (cdr lap1)) lap2) - (setq lap (delq lap0 lap)) + (setcdr prev (cdr rest)) (setcar lap1 inverse) (setq keep-going t))) ;; @@ -2178,28 +2193,30 @@ byte-optimize-lapcode ;; ((and (eq 'byte-constant (car lap0)) (memq (car lap1) byte-conditional-ops) - ;; If the `byte-constant's cdr is not a cons cell, it has - ;; to be an index into the constant pool); even though - ;; it'll be a constant, that constant is not known yet - ;; (it's typically a free variable of a closure, so will - ;; only be known when the closure will be built at - ;; run-time). + ;; Must be an actual constant, not a closure variable. (consp (cdr lap0))) (cond ((if (memq (car lap1) '(byte-goto-if-nil byte-goto-if-nil-else-pop)) (car (cdr lap0)) (not (car (cdr lap0)))) + ;; Branch not taken. (byte-compile-log-lap " %s %s\t-->\t" lap0 lap1) - (setq rest (cdr rest) - lap (delq lap0 (delq lap1 lap)))) - (t + (setcdr prev (cddr rest))) ; delete both + ((memq (car lap1) byte-goto-always-pop-ops) + ;; Always-pop branch taken. (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 (cons 'byte-goto (cdr lap1))) - (when (memq (car lap1) byte-goto-always-pop-ops) - (setq lap (delq lap0 lap))) - (setcar lap1 'byte-goto))) + (setcdr prev (cdr rest)) ; delete const + (setcar lap1 'byte-goto)) + (t ; -else-pop branch taken: keep const + (byte-compile-log-lap " %s %s\t-->\t%s %s" + lap0 lap1 + lap0 (cons 'byte-goto (cdr lap1))) + (setcar lap1 'byte-goto) + (setq prev (cdr prev)) ; FIXME: temporary compat hack + )) (setq keep-going t)) ;; ;; varref-X varref-X --> varref-X dup @@ -2232,22 +2249,21 @@ byte-optimize-lapcode lap0 str lap0 lap0 str))) (setq keep-going t) (setcar (car tmp) 'byte-dup) - (setcdr (car tmp) 0) - (setq rest tmp)) + (setcdr (car tmp) 0)) ;; - ;; TAG1: TAG2: --> TAG1: - ;; (and other references to TAG2 are replaced with TAG1) + ;; TAG1: TAG2: --> TAG2: + ;; (and other references to TAG1 are replaced with TAG2) ;; ((and (eq (car lap0) 'TAG) (eq (car lap1) 'TAG)) (byte-compile-log-lap " adjacent tags %d and %d merged" (nth 1 lap1) (nth 1 lap0)) - (setq tmp3 lap) + (setq tmp3 (cdr lap-head)) (while (setq tmp2 (rassq lap0 tmp3)) (setcdr tmp2 lap1) (setq tmp3 (cdr (memq tmp2 tmp3)))) - (setq lap (delq lap0 lap) - keep-going t) + (setcdr prev (cdr rest)) + (setq keep-going t) ;; replace references to tag in jump tables, if any (dolist (table byte-compile-jump-tables) (maphash #'(lambda (value tag) @@ -2258,14 +2274,14 @@ byte-optimize-lapcode ;; unused-TAG: --> ;; ((and (eq 'TAG (car lap0)) - (not (rassq lap0 lap)) + (not (rassq lap0 (cdr lap-head))) ;; make sure this tag isn't used in a jump-table (cl-loop for table in byte-compile-jump-tables when (member lap0 (hash-table-values table)) return nil finally return t)) (byte-compile-log-lap " unused tag %d removed" (nth 1 lap0)) - (setq lap (delq lap0 lap) - keep-going t)) + (setcdr prev (cdr rest)) + (setq keep-going t)) ;; ;; goto ... --> goto ;; return ... --> return @@ -2297,7 +2313,8 @@ byte-optimize-lapcode " %s <%d unreachable op%s> %s\t-->\t%s %s" lap0 i (if (= i 1) "" "s") tagstr lap0 tagstr)))) - (rplacd rest tmp)) + (setcdr rest tmp)) + (setq prev rest) ; FIXME: temporary compat hack (setq keep-going t)) ;; ;; unbind --> unbind @@ -2320,11 +2337,12 @@ byte-optimize-lapcode byte-save-restriction byte-save-current-buffer)) (< 0 (cdr lap1))) - (if (zerop (setcdr lap1 (1- (cdr lap1)))) - (delq lap1 rest)) + (setcdr lap1 (1- (cdr lap1))) + (when (zerop (cdr lap1)) + (setcdr rest (cddr rest))) (if (eq (car lap0) 'byte-varbind) (setcar rest (cons 'byte-discard 0)) - (setq lap (delq lap0 lap))) + (setcdr prev (cddr prev))) (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 (cons (car lap1) (1+ (cdr lap1))) (if (eq (car lap0) 'byte-varbind) @@ -2340,17 +2358,18 @@ byte-optimize-lapcode ;; goto-X ... X: return --> return ;; ((and (memq (car lap0) byte-goto-ops) - (memq (car (setq tmp (nth 1 (memq (cdr lap0) lap)))) - '(byte-goto byte-return))) - (cond ((and (or (eq (car lap0) 'byte-goto) - (eq (car tmp) 'byte-goto)) - (not (eq (cdr tmp) (cdr lap0)))) - (byte-compile-log-lap " %s [%s]\t-->\t%s" - (car lap0) tmp tmp) - (if (eq (car tmp) 'byte-return) - (setcar lap0 'byte-return)) - (setcdr lap0 (cdr tmp)) - (setq keep-going t)))) + (memq (car (setq tmp (nth 1 (memq (cdr lap0) (cdr lap-head))))) + '(byte-goto byte-return)) + (or (eq (car lap0) 'byte-goto) + (eq (car tmp) 'byte-goto)) + (not (eq (cdr tmp) (cdr lap0)))) + ;; FIXME: inaccurate log message when lap0 = goto-if-* + (byte-compile-log-lap " %s [%s]\t-->\t%s" (car lap0) tmp tmp) + (when (eq (car tmp) 'byte-return) + (setcar lap0 'byte-return)) + (setcdr lap0 (cdr tmp)) + (setq prev (cdr prev)) ; FIXME: temporary compat hack + (setq keep-going t)) ;; ;; OP goto(X) Y: OP X: -> Y: OP X: @@ -2365,8 +2384,7 @@ byte-optimize-lapcode lap0 lap1 lap2 (nth 3 rest) (nth 4 rest) lap2 (nth 3 rest) (nth 4 rest)) - (setcdr rest (cddr rest)) - (setq lap (delq lap0 lap)) + (setcdr prev (cddr rest)) (setq keep-going t)) ;; @@ -2381,7 +2399,7 @@ byte-optimize-lapcode (memq (car lap0) side-effect-free))) (setq keep-going t) (setq add-depth 1) ; in case we get rid of too much stack reduction - (setq lap (delq lap0 lap)) + (setcdr prev (cdr rest)) (byte-compile-log-lap " %s %s %s\t-->\t%s %s" lap0 lap1 (nth 2 rest) lap1 (nth 2 rest))) @@ -2391,7 +2409,7 @@ byte-optimize-lapcode ;; ((and (memq (car lap0) '(byte-goto-if-nil-else-pop byte-goto-if-not-nil-else-pop)) - (memq (car (car (setq tmp (cdr (memq (cdr lap0) lap))))) + (memq (caar (setq tmp (cdr (memq (cdr lap0) (cdr lap-head))))) (eval-when-compile (cons 'byte-discard byte-conditional-ops))) (not (eq lap0 (car tmp)))) @@ -2413,6 +2431,7 @@ byte-optimize-lapcode (car lap0) tmp2 (nth 1 tmp3)) (setcar lap0 (nth 1 tmp3)) (setcdr lap0 (nth 1 tmp))) + (setq prev (cdr prev)) ; FIXME: temporary compat hack (setq keep-going t)) ;; ;; const goto-X ... X: goto-if-* --> whatever @@ -2420,7 +2439,7 @@ byte-optimize-lapcode ;; ((and (eq (car lap0) 'byte-constant) (eq (car lap1) 'byte-goto) - (memq (car (car (setq tmp (cdr (memq (cdr lap1) lap))))) + (memq (caar (setq tmp (cdr (memq (cdr lap1) (cdr lap-head))))) (eval-when-compile (cons 'byte-discard byte-conditional-ops))) (not (eq lap1 (car tmp)))) @@ -2436,7 +2455,6 @@ byte-optimize-lapcode (setcar lap1 (car tmp2)) (setcdr lap1 (cdr tmp2)) ;; Let next step fix the (const,goto-if*) sequence. - (setq rest (cons nil rest)) (setq keep-going t)) ((or (consp (cdr lap0)) (eq (car tmp2) 'byte-discard)) @@ -2448,8 +2466,10 @@ byte-optimize-lapcode (setcdr tmp (cons (byte-compile-make-tag) (cdr tmp)))) (setcdr lap1 (car (cdr tmp))) - (setq lap (delq lap0 lap)) - (setq keep-going t)))) + (setcdr prev (cdr rest)) + (setq keep-going t)) + (t + (setq prev (cdr prev))))) ;; ;; X: varref-Y ... varset-Y goto-X --> ;; X: varref-Y Z: ... dup varset-Y goto-Z @@ -2464,7 +2484,7 @@ byte-optimize-lapcode ((and (eq (car lap1) 'byte-varset) (eq (car lap2) 'byte-goto) (not (memq (cdr lap2) rest)) ;Backwards jump - (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap))))) + (eq (car (car (setq tmp (cdr (memq (cdr lap2) (cdr lap-head)))))) 'byte-varref) (eq (cdr (car tmp)) (cdr lap1)) (not (memq (car (cdr lap1)) byte-boolean-vars))) @@ -2489,7 +2509,7 @@ byte-optimize-lapcode ((and (eq (car lap0) 'byte-goto) (eq (car lap1) 'TAG) (eq lap1 - (cdr (car (setq tmp (cdr (memq (cdr lap0) lap)))))) + (cdar (setq tmp (cdr (memq (cdr lap0) (cdr lap-head)))))) (memq (car (car tmp)) '(byte-goto byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop))) @@ -2539,7 +2559,9 @@ byte-optimize-lapcode (+ (cdr lap0) (cdr lap1))))) (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 new-op) (setcar rest new-op) - (setcdr rest (cddr rest)))) + (setcdr rest (cddr rest)) + (setq prev rest) ; FIXME: temporary compat hack + )) ;; ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos @@ -2561,7 +2583,7 @@ byte-optimize-lapcode (setq tmp (cdr tmp))) (>= tmp3 tmp2))) ;; Do the optimization. - (setq lap (delq lap0 lap)) + (setcdr prev (cdr rest)) (setcar lap1 (if (= tmp2 tmp3) ;; The value stored is the new TOS, so pop one more @@ -2574,7 +2596,9 @@ byte-optimize-lapcode (setcdr lap1 (1+ tmp3)) (setcdr (cdr rest) tmp) (byte-compile-log-lap " %s [discard/discardN]...\t-->\t%s" - lap0 lap1)) + lap0 lap1) + ;; FIXME: shouldn't we do (setq keep-going t) here? + ) ;; ;; discardN-preserve-tos return --> return @@ -2588,14 +2612,14 @@ byte-optimize-lapcode (setq keep-going t) ;; The byte-code interpreter will pop the stack for us, so ;; we can just leave stuff on it. - (setq lap (delq lap0 lap)) + (setcdr prev (cdr rest)) (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 lap1)) ;; ;; goto-X ... X: discard ==> discard goto-Y ... X: discard Y: ;; ((and (eq (car lap0) 'byte-goto) - (setq tmp (cdr (memq (cdr lap0) lap))) + (setq tmp (cdr (memq (cdr lap0) (cdr lap-head)))) (or (memq (caar tmp) '(byte-discard byte-discardN)) ;; Make sure we don't hoist a discardN-preserve-tos ;; that really should be merged or deleted instead. @@ -2632,10 +2656,12 @@ byte-optimize-lapcode (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 newdiscard lap0) (setf (car rest) newdiscard) - (setf (cadr rest) lap0))) - ) - (setq rest (cdr rest))) - ) + (setf (cadr rest) lap0)) + (setq prev (cdr prev)) ; FIXME: temporary compat hack + ) + (t + ;; If no rule matched, advance and try again. + (setq prev (cdr prev)))))) ;; Cleanup stage: ;; Rebuild byte-compile-constants / byte-compile-variables. ;; Simple optimizations that would inhibit other optimizations if they @@ -2643,11 +2669,13 @@ byte-optimize-lapcode ;; need to do more than once. (setq byte-compile-constants nil byte-compile-variables nil) - (setq rest lap) + (setq prev lap-head) (byte-compile-log-lap " ---- final pass") - (while rest + (while (cdr prev) + (setq rest (cdr prev)) (setq lap0 (car rest) lap1 (nth 1 rest)) + ;; FIXME: Would there ever be a `byte-constant2' op here? (if (memq (car lap0) byte-constref-ops) (if (memq (car lap0) '(byte-constant byte-constant2)) (unless (memq (cdr lap0) byte-compile-constants) @@ -2684,7 +2712,8 @@ byte-optimize-lapcode (setq tmp2 t)) (if tmp2 (byte-compile-log-lap - " %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0))) + " %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0) + (setq prev (cdr prev)))) ;; ;; unbind-N unbind-M --> unbind-(N+M) ;; @@ -2693,7 +2722,7 @@ byte-optimize-lapcode (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 (cons 'byte-unbind (+ (cdr lap0) (cdr lap1)))) - (setq lap (delq lap0 lap)) + (setcdr prev (cdr rest)) (setcdr lap1 (+ (cdr lap1) (cdr lap0)))) ;; @@ -2704,7 +2733,7 @@ byte-optimize-lapcode '(byte-discard byte-discardN byte-discardN-preserve-tos)) (memq (car lap1) '(byte-discard byte-discardN))) - (setq lap (delq lap0 lap)) + (setcdr prev (cdr rest)) (byte-compile-log-lap " %s %s\t-->\t(discardN %s)" lap0 lap1 @@ -2713,10 +2742,10 @@ byte-optimize-lapcode (setcdr lap1 (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0)) (if (eq (car lap1) 'byte-discard) 1 (cdr lap1)))) (setcar lap1 'byte-discardN)) - ) - (setq rest (cdr rest))) - (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth))) - lap) + (t + (setq prev (cdr prev))))) + (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)) + (cdr lap-head))) (provide 'byte-opt) commit 3ffd0eddce651aabefedf10249ebd9d6e7b5b8fa Author: Dmitry Gutov Date: Sun Feb 5 16:43:59 2023 +0200 Highlight more complex function parameters * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--fontify-parameter): New function. (rust-ts-mode--font-lock-settings): Use it. diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 5722d037bba..e46fa0342dd 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -161,9 +161,7 @@ rust-ts-mode--font-lock-settings (macro_definition "macro_rules!" @font-lock-constant-face) (macro_definition (identifier) @font-lock-preprocessor-face) (field_declaration name: (field_identifier) @font-lock-property-face) - (parameter pattern: (identifier) @font-lock-variable-name-face) - (parameter - pattern: (reference_pattern (identifier) @font-lock-variable-name-face))) + (parameter) @rust-ts-mode--fontify-parameter) :language 'rust :feature 'function @@ -256,6 +254,18 @@ rust-ts-mode--font-lock-settings '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `rust-ts-mode'.") +(defalias 'rust-ts-mode--fontify-parameter + (and + (treesit-available-p) + `(lambda (node override start end &rest _) + (let ((captures (treesit-query-capture + (treesit-node-child-by-field-name node "pattern") + ,(treesit-query-compile 'rust '((identifier) @id))))) + (pcase-dolist (`(_name . ,id) captures) + (treesit-fontify-with-override + (treesit-node-start id) (treesit-node-end id) + 'font-lock-variable-name-face override start end)))))) + (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." commit 45525cafcbcc5205b7a3d53a6ae62c3ee31dfaf2 Author: Stefan Monnier Date: Sun Feb 5 09:04:51 2023 -0500 * lisp/emacs-lisp/cconv.el (cconv-convert): Fix thinko diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index e4268c2fb88..e8d639903c1 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -488,7 +488,7 @@ cconv-convert (_ (pcase cif ('nil nil) (`#',f - (setf (cadr (car bf)) (if wrapped (nth 2 f) f)) + (setf (cadr (car bf)) (if wrapped (nth 2 f) cif)) (setq cif nil)) ;; The interactive form needs special treatment, so the form ;; inside the `interactive' won't be used any further. commit 58dc03ba7e4c67027f49ed9f741ceb68de262f72 Author: Jonas Bernoulli Date: Wed Feb 1 20:25:15 2023 +0100 No longer use transient in isearch-emoji-by-name * lisp/isearch.el (isearch-emoji-by-name): Use 'emoji--read-emoji' and if that returns derivations, 'completing-read' to select one of them. This fixes bug#60740. * lisp/international/emoji.el (emoji--init): Autoload. (emoji--read-emoji): New function, which doesn't use transient and returns a list of the glyph and all derivations, if any. (emoji--choose-emoji): Use 'emoji--read-emoji'. diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el index 2d17cf639b0..f75bd877991 100644 --- a/lisp/international/emoji.el +++ b/lisp/international/emoji.el @@ -245,6 +245,7 @@ emoji-list-help (error "Emoji name is unknown") (message "%s" name))))) +;;;###autoload (defun emoji--init (&optional force inhibit-adjust) (when (or (not emoji--labels) force) @@ -638,7 +639,7 @@ emoji--split-long-lists collect (cons (concat (string prefix) "-group") (seq-take bit 77)))))))) -(defun emoji--choose-emoji () +(defun emoji--read-emoji () ;; Use the list of names. (let* ((table (if (not emoji-alternate-names) @@ -678,21 +679,24 @@ emoji--choose-emoji (complete-with-action action table string pred))) nil t))) (when (cl-plusp (length name)) - (let* ((glyph (if emoji-alternate-names - (cadr (split-string name "\t")) - (gethash name emoji--all-bases))) - (derived (gethash glyph emoji--derived))) - (if (not derived) - ;; Simple glyph with no derivations. - (progn - (emoji--add-recent glyph) - (insert glyph)) - ;; Choose a derived version. - (let ((emoji--done-derived (make-hash-table :test #'equal))) - (setf (gethash glyph emoji--done-derived) t) - (funcall - (emoji--define-transient - (cons "Choose Emoji" (cons glyph derived)))))))))) + (let ((glyph (if emoji-alternate-names + (cadr (split-string name "\t")) + (gethash name emoji--all-bases)))) + (cons glyph (gethash glyph emoji--derived)))))) + +(defun emoji--choose-emoji () + (pcase-let ((`(,glyph ,derived)) (emoji--read-emoji)) + (if (not derived) + ;; Simple glyph with no derivations. + (progn + (emoji--add-recent glyph) + (insert glyph)) + ;; Choose a derived version. + (let ((emoji--done-derived (make-hash-table :test #'equal))) + (setf (gethash glyph emoji--done-derived) t) + (funcall + (emoji--define-transient + (cons "Choose Emoji" (cons glyph derived)))))))) (defvar-keymap emoji-zoom-map "+" #'emoji-zoom-increase diff --git a/lisp/isearch.el b/lisp/isearch.el index 22e27764127..bfa71756146 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2774,25 +2774,21 @@ isearch-char-by-name (mapconcat 'isearch-text-char-description string "")))))))) -(defvar emoji--derived) (defun isearch-emoji-by-name (&optional count) "Read an Emoji name and add it to the search string COUNT times. COUNT (interactively, the prefix argument) defaults to 1. The command accepts Unicode names like \"smiling face\" or \"heart with arrow\", and completion is available." (interactive "p") + (emoji--init) (with-isearch-suspended - (let ((emoji (with-temp-buffer - ;; Derived emoji not supported yet (bug#60740). - ;; So first load `emoji--labels', then `emoji--init' - ;; will not fill `emoji--derived' that is set - ;; to an empty hash table below. - (ignore-errors (require 'emoji-labels)) - (let ((emoji--derived (make-hash-table :test #'equal))) - (emoji-search)) - (if (and (integerp count) (> count 1)) - (apply 'concat (make-list count (buffer-string))) - (buffer-string))))) + (pcase-let* ((`(,glyph . ,derived) (emoji--read-emoji)) + (emoji (if derived + (completing-read "Select derivation: " + (cons glyph derived) nil t) + glyph))) + (when (and (integerp count) (> count 1)) + (setq emoji (apply 'concat (make-list count emoji)))) (when emoji (setq isearch-new-string (concat isearch-string emoji) isearch-new-message (concat isearch-message commit 0c125fcc67a47b933716124223404a45e73357c7 Author: Dmitry Gutov Date: Sun Feb 5 15:46:28 2023 +0200 Make highlighting more regular across TS modes (bug#61205) * doc/emacs/display.texi (Parser-based Font Lock): Update description of treesit-font-lock-level, moving 'property' to level 4. * lisp/treesit.el (treesit-font-lock-level): Likewise, in docstring. * lisp/progmodes/c-ts-mode.el (c-ts-base-mode): Do that here. * lisp/progmodes/cmake-ts-mode.el (cmake-ts-mode): Add a comment. * lisp/progmodes/go-ts-mode.el (go-ts-mode): Add 'definition' to level 1. Move 'function', 'property' and 'variable' to level 4. (go-ts-mode--font-lock-settings): Move a bunch of existing rules to 'definition'. Add highlighting of function parameters. * lisp/progmodes/rust-ts-mode.el (rust-ts-mode) (rust-ts-mode--font-lock-settings): Same. And also change "scoped identifiers" highlights to only match capitalized names. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 97732b65e32..a86c12a0db7 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1159,11 +1159,11 @@ Parser-based Font Lock This level adds fontification of keywords, strings, and data types. @item Level 3 This is the default level; it adds fontification of assignments, -numbers, properties, etc. +numbers, etc. @item Level 4 This level adds everything else that can be fontified: operators, delimiters, brackets, other punctuation, function names in function -calls, variables, etc. +calls, property look ups, variables, etc. @end table @vindex treesit-font-lock-feature-list diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 1a8ef79dac8..5093c3980b6 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -779,8 +779,8 @@ c-ts-base-mode (setq-local treesit-font-lock-feature-list '(( comment definition) ( keyword preprocessor string type) - ( assignment constant escape-sequence label literal property ) - ( bracket delimiter error function operator variable)))) + ( assignment constant escape-sequence label literal) + ( bracket delimiter error function operator property variable)))) ;;;###autoload (define-derived-mode c-ts-mode c-ts-base-mode "C" diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index c241a2868e5..04f5d6bdac8 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -220,6 +220,9 @@ cmake-ts-mode (setq-local treesit-font-lock-feature-list '((comment) (keyword string) + ;; 'function' and 'variable' here play slightly + ;; different roles than in other ts modes, so we + ;; kept them at level 3. (builtin constant escape-sequence function number variable) (bracket error misc-punctuation))) diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 95dcf653fc6..4b14e55281e 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -123,17 +123,26 @@ go-ts-mode--font-lock-settings :feature 'delimiter '((["," "." ";" ":"]) @font-lock-delimiter-face) + :language 'go + :feature 'definition + '((function_declaration + name: (identifier) @font-lock-function-name-face) + (method_declaration + name: (field_identifier) @font-lock-function-name-face) + (method_spec + name: (field_identifier) @font-lock-function-name-face) + (field_declaration + name: (field_identifier) @font-lock-property-face) + (parameter_declaration + name: (identifier) @font-lock-variable-name-face)) + :language 'go :feature 'function '((call_expression function: (identifier) @font-lock-function-name-face) (call_expression function: (selector_expression - field: (field_identifier) @font-lock-function-name-face)) - (function_declaration - name: (identifier) @font-lock-function-name-face) - (method_declaration - name: (field_identifier) @font-lock-function-name-face)) + field: (field_identifier) @font-lock-function-name-face))) :language 'go :feature 'keyword @@ -221,11 +230,10 @@ go-ts-mode ;; Font-lock. (setq-local treesit-font-lock-settings go-ts-mode--font-lock-settings) (setq-local treesit-font-lock-feature-list - '(( comment) + '(( comment definition) ( keyword string type) - ( constant escape-sequence function label number - property variable) - ( bracket delimiter error operator))) + ( constant escape-sequence label number) + ( bracket delimiter error function operator property variable))) (treesit-major-mode-setup))) diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index e317793d211..5722d037bba 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -155,6 +155,16 @@ rust-ts-mode--font-lock-settings :feature 'delimiter '((["," "." ";" ":" "::"]) @font-lock-delimiter-face) + :language 'rust + :feature 'definition + '((function_item name: (identifier) @font-lock-function-name-face) + (macro_definition "macro_rules!" @font-lock-constant-face) + (macro_definition (identifier) @font-lock-preprocessor-face) + (field_declaration name: (field_identifier) @font-lock-property-face) + (parameter pattern: (identifier) @font-lock-variable-name-face) + (parameter + pattern: (reference_pattern (identifier) @font-lock-variable-name-face))) + :language 'rust :feature 'function '((call_expression @@ -164,15 +174,12 @@ rust-ts-mode--font-lock-settings field: (field_identifier) @font-lock-function-name-face) (scoped_identifier name: (identifier) @font-lock-function-name-face)]) - (function_item (identifier) @font-lock-function-name-face) (generic_function function: [(identifier) @font-lock-function-name-face (field_expression field: (field_identifier) @font-lock-function-name-face) (scoped_identifier name: (identifier) @font-lock-function-name-face)]) - (macro_definition "macro_rules!" @font-lock-constant-face) - (macro_definition (identifier) @font-lock-preprocessor-face) (macro_invocation macro: (identifier) @font-lock-preprocessor-face)) :language 'rust @@ -208,20 +215,20 @@ rust-ts-mode--font-lock-settings (mod_item name: (identifier) @font-lock-constant-face) (primitive_type) @font-lock-type-face (type_identifier) @font-lock-type-face - (scoped_identifier name: (identifier) @font-lock-type-face) - (scoped_identifier path: (identifier) @font-lock-constant-face) - (scoped_identifier - (scoped_identifier - path: (identifier) @font-lock-constant-face)) + ((scoped_identifier name: (identifier) @font-lock-type-face) + (:match "^[A-Z]" @font-lock-type-face)) + ((scoped_identifier path: (identifier) @font-lock-type-face) + (:match "^[A-Z]" @font-lock-type-face)) + ((scoped_identifier + (scoped_identifier + path: (identifier) @font-lock-type-face)) + (:match "^[A-Z]" @font-lock-type-face)) ((scoped_identifier path: [(identifier) @font-lock-type-face (scoped_identifier name: (identifier) @font-lock-type-face)]) (:match "^[A-Z]" @font-lock-type-face)) (scoped_type_identifier path: (identifier) @font-lock-constant-face) - (scoped_use_list - path: [(identifier) @font-lock-constant-face - (scoped_identifier (identifier) @font-lock-constant-face)]) (type_identifier) @font-lock-type-face (use_as_clause alias: (identifier) @font-lock-type-face) (use_list (identifier) @font-lock-type-face)) @@ -317,11 +324,11 @@ rust-ts-mode ;; Font-lock. (setq-local treesit-font-lock-settings rust-ts-mode--font-lock-settings) (setq-local treesit-font-lock-feature-list - '(( comment) + '(( comment definition) ( keyword string) ( attribute builtin constant escape-sequence - function number property type variable) - ( bracket delimiter error operator))) + number type) + ( bracket delimiter error function operator property variable))) ;; Imenu. (setq-local treesit-simple-imenu-settings diff --git a/lisp/treesit.el b/lisp/treesit.el index 7e31da95ef4..7bd68c9a6d9 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -612,9 +612,10 @@ treesit-font-lock-level Level 1 usually contains only comments and definitions. Level 2 usually adds keywords, strings, data types, etc. Level 3 usually represents full-blown fontifications, including -assignments, constants, numbers and literals, properties, etc. +assignments, constants, numbers and literals, etc. Level 4 adds everything else that can be fontified: delimiters, -operators, brackets, punctuation, all functions and variables, etc. +operators, brackets, punctuation, all functions, properties, +variables, etc. In addition to the decoration level, individual features can be turned on/off by calling `treesit-font-lock-recompute-features'. commit 1dd751c3ac4e4276b461b83df7d9c4d002cf016e Author: Eli Zaretskii Date: Sun Feb 5 15:15:35 2023 +0200 ; Improve documentation of 'proper-list-p' * doc/lispref/lists.texi (Cons Cells): Add cross-reference to 'proper-list-p' documentation. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 454fd217ac2..f3758f5ce60 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -79,7 +79,10 @@ Cons Cells list to see the @sc{cdr} of the final cons cell, it won't care. However, some functions that operate on lists demand proper lists and signal errors if given a dotted list. Most functions that try to find -the end of a list enter infinite loops if given a circular list. +the end of a list enter infinite loops if given a circular list. You +can use the function @code{proper-list-p}, described in the next +section (@pxref{List-related Predicates, proper-list-p}), to determine +whether a list is a proper one. @cindex list structure Because most cons cells are used as part of lists, we refer to any commit 96181ed3f09b12c7e91ddabab5b02f0ee868fa50 Author: Eli Zaretskii Date: Sun Feb 5 14:09:35 2023 +0200 Document 'plistp' * doc/lispref/lists.texi (Property Lists): Document 'plistp'. (Bug#61293) diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 44b7058e19d..454fd217ac2 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1914,6 +1914,11 @@ Property Lists record miscellaneous information about the symbol; these properties are stored in the form of a property list. @xref{Symbol Properties}. +@defun plistp object +This predicate function returns non-@code{nil} if @var{object} is a +valid property list. +@end defun + @menu * Plists and Alists:: Comparison of the advantages of property lists and association lists. commit 03d9d18513b6ec50d0022f09d040ce330c918fff Author: Eli Zaretskii Date: Sun Feb 5 13:57:10 2023 +0200 Fix display of raised/lowered composed text * src/xdisp.c (fill_gstring_glyph_string): Adjust the base line of the glyph string due to subscript/superscript. (Bug#61290) diff --git a/src/xdisp.c b/src/xdisp.c index d2c91e5847b..a19c9908616 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -29317,6 +29317,7 @@ fill_gstring_glyph_string (struct glyph_string *s, int face_id, int start, int end, int overlaps) { struct glyph *glyph, *last; + int voffset; Lisp_Object lgstring; int i; bool glyph_not_available_p; @@ -29324,6 +29325,7 @@ fill_gstring_glyph_string (struct glyph_string *s, int face_id, s->for_overlaps = overlaps; glyph = s->row->glyphs[s->area] + start; last = s->row->glyphs[s->area] + end; + voffset = glyph->voffset; glyph_not_available_p = glyph->glyph_not_available_p; s->cmp_id = glyph->u.cmp.id; s->cmp_from = glyph->slice.cmp.from; @@ -29374,6 +29376,9 @@ fill_gstring_glyph_string (struct glyph_string *s, int face_id, if (glyph_not_available_p) s->font_not_found_p = true; + /* Adjust base line for subscript/superscript text. */ + s->ybase += voffset; + return glyph - s->row->glyphs[s->area]; } commit f13479d95566e234a70001f02d4209f145e3729a Author: Eli Zaretskii Date: Sun Feb 5 11:14:25 2023 +0200 Fix installation of tree-sitter grammar on MS-Windows * lisp/treesit.el (treesit--install-language-grammar-1): Fix a failure on MS-Windows when the old DLL is still being used. (Bug#61289) diff --git a/lisp/treesit.el b/lisp/treesit.el index 948016dc723..7e31da95ef4 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2884,7 +2884,17 @@ treesit--install-language-grammar-1 ;; Copy out. (unless (file-exists-p out-dir) (make-directory out-dir t)) - (copy-file lib-name (file-name-as-directory out-dir) t t) + (let* ((library-fname (expand-file-name lib-name out-dir)) + (old-fname (concat library-fname ".old"))) + ;; Rename the existing shared library, if any, then + ;; install the new one, and try deleting the old one. + ;; This is for Windows systems, where we cannot simply + ;; overwrite a DLL that is being used. + (if (file-exists-p library-fname) + (rename-file library-fname old-fname t)) + (copy-file lib-name (file-name-as-directory out-dir) t t) + ;; Ignore errors, in case the old version is still used. + (ignore-errors (delete-file old-fname))) (message "Library installed to %s/%s" out-dir lib-name)) (when (file-exists-p workdir) (delete-directory workdir t))))) commit 0358267204d1c9ddeff46aac168c6a8c5d173d95 Author: Eli Zaretskii Date: Sun Feb 5 10:50:12 2023 +0200 Update the Emacs FAQ for Emacs 29 * doc/misc/efaq.texi (New in Emacs 29, History of Emacs): Add new section about Emacs 29. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 396a4753842..4a8c863230f 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -847,6 +847,7 @@ History of Emacs @menu * Origin of the term Emacs:: * Latest version of Emacs:: +* New in Emacs 29:: * New in Emacs 28:: * New in Emacs 27:: * New in Emacs 26:: @@ -919,6 +920,125 @@ Latest version of Emacs this command a prefix argument to read about which features were new in older versions. +@node New in Emacs 29 +@section What is different about Emacs 29? +@cindex Differences between Emacs 28 and Emacs 29 +@cindex Emacs 29, new features in + +Here's a list of the most important changes in Emacs 29 as compared to +Emacs 28 (the full list is too long, and can be read in the Emacs +@file{NEWS} file by typing @kbd{C-h n} inside Emacs). + +@itemize +@item +Emacs can now be built with the +@uref{https://tree-sitter.github.io/tree-sitter/, tree-sitter +library}, which provides incremental parsing capabilities for several +programming languages. Emacs comes with several major modes which use +this library for syntax highlighting (a.k.a. ``fontification''), +indentation, Imenu support, etc. These modes have names +@code{@var{lang}-ts-mode}, where @var{lang} is the programming +language. For example, @code{c-ts-mode}, @code{ruby-ts-mode}, etc. +There are several new font-lock faces, such as +@code{font-lock-number-face} and @code{font-lock-operator-face}, +intended to be used with these modes. + +@item +Emacs can now be built in the PGTK (``pure GTK'') configuration, which +supports running Emacs on window systems other than X, such as Wayland +and Broadway. + +@item +Emacs now has built-in support for accessing SQLite databases. This +requires Emacs to be built with the optional @file{sqlite3} library. + +@item +Emacs comes with the popular @code{use-package} package bundled. + +@item +Emacs can now display WebP images, if it was built with the optional +@file{libwebp} library. + +@item +On X window system, Emacs now supports the XInput2 specification for +input events. + +@item +Emacs now comes with a client library for using Language Server +Protocol (@acronym{LSP}) servers. This library, named @file{eglot.el} +(the name stands for ``Emacs polyGlot'') provides LSP support for +various software development and maintenance features, such as +@code{xref}, Imenu, ElDoc, etc. + +@item +Emacs can now cope with files with very long lines much better. It no +longer hangs when displaying such long lines, and allows +reasonably-responsive editing when such lines are present in the +visible portion of a buffer. + +@item +Emacs now supports the latest version 15.0 of the Unicode Standard. + +@item +The new mode @code{pixel-scroll-precision-mode} allows precise and +smooth scrolling of the display at pixel resolution, if your mouse +supports this. + +@item +Emacs now supports 24-bit true colors on more terminals. + +@item +On capable X terminal emulators, Emacs now supports setting the X +primary selection on TTY frames. + +@item +New convenient commands are now available for inserting, searching, +listing, and describing Emoji. These commands are on the @w{@kbd{C-x +8 e}} prefix key. The commands @kbd{C-u C-x =} +(@code{what-cursor-position}) and @kbd{M-x describe-char} now show the +names of Emoji sequences at point. + +@item +The Help commands were enhanced: + +@itemize @minus +@item +@kbd{M-x apropos-variable} shows the values of the matching variables. +@item +@kbd{C-h b} activates @code{outline-minor-mode} in the buffer, which +makes it easier to browse long lists of key bindings. +@item +@kbd{I} in the @file{*Help*} buffer displays the corresponding +documentation in the Emacs Lisp Reference manual. +@item +New command @code{help-quick} displays a buffer with overview of +common Help commands. +@end itemize + +@item +Outline Minor mode uses buttons to hide and show outlines. + +@item +Deleted frames can now be undeleted using @kbd{C-x 5 u}, if the +optional @code{undelete-frame-mode} is enabled. + +@item +You can now delete the entire composed sequence of characters with +@key{Delete} and edits the composed sequence by turning on the +@code{composition-break-at-point} option. + +@item +Support is added for many old scripts and writing systems, such as Tai +Tham, Brahmi, Tirhuta, Modi, Lepcha, and many others. + +@item +New translations of the Emacs tutorial: Ukrainian and Greek. + +@item +New major modes for Typescript, Csharp, CMake, Go, Rust, and Yaml. +@end itemize + + @node New in Emacs 28 @section What is different about Emacs 28? @cindex Differences between Emacs 27 and Emacs 28 commit 2c33e2889b4d711689a606d175ff56931c157fb4 Author: Eli Zaretskii Date: Sun Feb 5 08:24:32 2023 +0200 Fix byte-compilation of *-ts-mode.el files * lisp/treesit.el (treesit-font-lock-settings): Move to before use, to prevent failure in byte-compiling modes which require this file. (Bug#61282) diff --git a/lisp/treesit.el b/lisp/treesit.el index 6426eb08fe6..948016dc723 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -555,7 +555,30 @@ 'treesit-font-lock-error "Generic tree-sitter font-lock error" 'treesit-error) -(defvar treesit-font-lock-settings) +(defvar-local treesit-font-lock-settings nil + "A list of SETTINGs for treesit-based fontification. + +The exact format of each SETTING is considered internal. Use +`treesit-font-lock-rules' to set this variable. + +Each SETTING has the form: + + (QUERY ENABLE FEATURE OVERRIDE) + +QUERY must be a compiled query. See Info node `(elisp)Pattern +Matching' for how to write a query and compile it. + +For SETTING to be activated for font-lock, ENABLE must be t. To +disable this SETTING, set ENABLE to nil. + +FEATURE is the \"feature name\" of the query. Users can control +which features are enabled with `treesit-font-lock-level' and +`treesit-font-lock-feature-list'. + +OVERRIDE is the override flag for this query. Its value can be +t, nil, append, prepend, keep. See more in +`treesit-font-lock-rules'.") + (defun treesit--font-lock-level-setter (sym val) "Custom setter for `treesit-font-lock-level'. Set the default value of SYM to VAL, recompute fontification @@ -638,30 +661,6 @@ treesit-font-lock-feature-list For changes to this variable to take effect, run `treesit-font-lock-recompute-features'.") -(defvar-local treesit-font-lock-settings nil - "A list of SETTINGs for treesit-based fontification. - -The exact format of each SETTING is considered internal. Use -`treesit-font-lock-rules' to set this variable. - -Each SETTING has the form: - - (QUERY ENABLE FEATURE OVERRIDE) - -QUERY must be a compiled query. See Info node `(elisp)Pattern -Matching' for how to write a query and compile it. - -For SETTING to be activated for font-lock, ENABLE must be t. To -disable this SETTING, set ENABLE to nil. - -FEATURE is the \"feature name\" of the query. Users can control -which features are enabled with `treesit-font-lock-level' and -`treesit-font-lock-feature-list'. - -OVERRIDE is the override flag for this query. Its value can be -t, nil, append, prepend, keep. See more in -`treesit-font-lock-rules'.") - (defun treesit-font-lock-rules (&rest query-specs) "Return a value suitable for `treesit-font-lock-settings'. commit b40a929a3f238d48213c75f6a7613cdeaec14686 Author: Dmitry Gutov Date: Sun Feb 5 02:42:52 2023 +0200 ; ruby-ts--syntax-propertize: Amend commentary diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index c0971193244..e83bc2f9e11 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1059,7 +1059,8 @@ ruby-ts--syntax-propertize (put-text-property (treesit-node-end node) (1+ (treesit-node-end node)) 'syntax-table (string-to-syntax "\""))) ('percent - ;; TODO: Put the first one on the first paren in both %Q{} and %(). + ;; FIXME: Put the first one on the first paren in both %Q{} and %(). + ;; That would stop electric-pair-mode from pairing, though. Hmm. (put-text-property (treesit-node-start node) (1+ (treesit-node-start node)) 'syntax-table (string-to-syntax "|")) (put-text-property (1- (treesit-node-end node)) (treesit-node-end node) commit d27d9a43d4d1b3f8a213cb739f4d27793158a050 Author: Paul Eggert Date: Sat Feb 4 15:53:40 2023 -0800 Update some commentary for C23 diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index e1a4613875c..deb1021283f 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -732,14 +732,15 @@ C Dialect @section C Dialect @cindex C programming language -The C part of Emacs is portable to C99 or later: C11-specific features such -as @samp{} and @samp{_Noreturn} are not used without a check, +The C part of Emacs is portable to C99 or later: later C features such +as @samp{} and @samp{[[noreturn]]} are not used without a check, typically at configuration time, and the Emacs build procedure -provides a substitute implementation if necessary. Some C11 features, +provides a substitute implementation if necessary. Some later features, such as anonymous structures and unions, are too difficult to emulate, so they are avoided entirely. -At some point in the future the base C dialect will no doubt change to C11. +At some point in the future the base C dialect will no doubt change to +something later than C99. @node Writing Emacs Primitives @section Writing Emacs Primitives @@ -894,15 +895,17 @@ Writing Emacs Primitives @table @code @item noreturn Declares the C function as one that never returns. This corresponds -to the C11 keyword @code{_Noreturn} and to @w{@code{__attribute__ -((__noreturn__))}} attribute of GCC (@pxref{Function Attributes,,, -gcc, Using the GNU Compiler Collection}). +to C23's @code{[[noreturn]]}, to C11's @code{_Noreturn}, and to GCC's +@w{@code{__attribute__ ((__noreturn__))}} (@pxref{Function +Attributes,,, gcc, Using the GNU Compiler Collection}). (Internally, +Emacs's own C code uses @code{_Noreturn} as it can be defined as a +macro on C platforms that do not support it.) @item const Declares that the function does not examine any values except its arguments, and has no effects except the return value. This -corresponds to @w{@code{__attribute__ ((__const__))}} attribute of -GCC. +corresponds to C23's @code{[[unsequenced]]} and to GCC's +@w{@code{__attribute__ ((__const__))}}. @item noinline This corresponds to @w{@code{__attribute__ ((__noinline__))}} diff --git a/src/floatfns.c b/src/floatfns.c index 1d891ef3ce1..13f0ca3e129 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -27,19 +27,22 @@ Copyright (C) 1988, 1993-1994, 1999, 2001-2023 Free Software Foundation, frexp, ldexp, log, log10 [via (log X 10)], *modf, pow, sin, *sinh, sqrt, tan, *tanh. - C99 and C11 require the following math.h functions in addition to + C99, C11 and C17 require the following math.h functions in addition to the C89 functions. Of these, Emacs currently exports only the starred ones to Lisp, since we haven't found a use for the others. Also, it uses the ones marked "+" internally: acosh, atanh, cbrt, copysign (implemented by signbit), erf, erfc, exp2, expm1, fdim, fma, fmax, fmin, fpclassify, hypot, +ilogb, - isfinite, isgreater, isgreaterequal, isinf, isless, islessequal, + +isfinite, isgreater, isgreaterequal, +isinf, isless, islessequal, islessgreater, *isnan, isnormal, isunordered, lgamma, log1p, *log2 [via (log X 2)], logb (approximately; implemented by frexp), +lrint/llrint, +lround/llround, nan, nearbyint, nextafter, nexttoward, remainder, remquo, *rint, round, scalbln, +scalbn, +signbit, tgamma, *trunc. + C23 requires many more math.h functions. Emacs does not yet export + or use them. + The C standard also requires functions for float and long double that are not listed above. Of these functions, Emacs uses only the following internally: fabsf, powf, sprintf. diff --git a/src/lisp.h b/src/lisp.h index 196615effd8..0bc400ba78f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -272,7 +272,7 @@ DEFINE_GDB_SYMBOL_END (VALMASK) emacs_align_type union in alloc.c. Although these macros are reasonably portable, they are not - guaranteed on non-GCC platforms, as C11 does not require support + guaranteed on non-GCC platforms, as the C standard does not require support for alignment to GCALIGNMENT and older compilers may ignore alignment requests. For any type T where garbage collection requires alignment, use verify (GCALIGNED (T)) to verify the @@ -2962,9 +2962,10 @@ XFLOAT_DATA (Lisp_Object f) /* Most hosts nowadays use IEEE floating point, so they use IEC 60559 representations, have infinities and NaNs, and do not trap on exceptions. Define IEEE_FLOATING_POINT to 1 if this host is one of the - typical ones. The C11 macro __STDC_IEC_559__ is close to what is + typical ones. The C23 macro __STDC_IEC_60559_BFP__ (or its + obsolescent C11 counterpart __STDC_IEC_559__) is close to what is wanted here, but is not quite right because Emacs does not require - all the features of C11 Annex F (and does not require C11 at all, + all the features of C23 Annex F (and does not require C11 or later, for that matter). */ #define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ diff --git a/src/xdisp.c b/src/xdisp.c index 72d3bfa6398..398056144a8 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -12448,7 +12448,7 @@ display_echo_area (struct window *w) reset the echo_area_buffer in question to nil at the end because with_echo_area_buffer will set it to an empty buffer. */ bool i = display_last_displayed_message_p; - /* According to the C99, C11 and C++11 standards, the integral value + /* According to the C standard, the integral value of a "bool" is always 0 or 1, so this array access is safe here, if oddly typed. */ no_message_p = NILP (echo_area_buffer[i]); commit b80f36b88c76b8f8ce3f2e6f9bd56aa2ccbe7b39 Author: Yuan Fu Date: Fri Feb 3 18:35:33 2023 -0800 Make c-ts-mode-set-style's effect local (bug#61245) Now c-ts-mode-set-style's effect is local, and there is a new function c-ts-mode-set-global-style that changes the global setting. * lisp/progmodes/c-ts-mode.el: (c-ts-mode--indent-style-setter): Use c-ts-mode-set-style. (c-ts-mode-indent-style) (c-ts-mode--prompt-for-style): Minor change in docstring. (c-ts-mode-set-global-style): New function (from c-ts-mode-set-style). (c-ts-mode-set-local-style): Remove function (became c-ts-mode-set-style). (c-ts-mode-set-style): Renamed from c-ts-mode-set-local-style. * test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts: * test/lisp/progmodes/c-ts-mode-resources/indent.erts: Use c-ts-mode-set-style. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 2a164af26ea..1a8ef79dac8 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -89,18 +89,19 @@ c-ts-mode-indent-offset (defun c-ts-mode--indent-style-setter (sym val) "Custom setter for `c-ts-mode-set-style'. + Apart from setting the default value of SYM to VAL, also change -the value of SYM in `c-ts-mode' and `c++-ts-mode' buffers to VAL." +the value of SYM in `c-ts-mode' and `c++-ts-mode' buffers to VAL. + +SYM should be `c-ts-mode-indent-style', and VAL should be a style +symbol." (set-default sym val) (named-let loop ((res nil) (buffers (buffer-list))) (if (null buffers) (mapc (lambda (b) (with-current-buffer b - (setq-local treesit-simple-indent-rules - (treesit--indent-rules-optimize - (c-ts-mode--get-indent-style - (if (derived-mode-p 'c-ts-mode) 'c 'cpp)))))) + (c-ts-mode-set-style val))) res) (let ((buffer (car buffers))) (with-current-buffer buffer @@ -112,8 +113,8 @@ c-ts-mode-indent-style "Style used for indentation. The selected style could be one of GNU, K&R, LINUX or BSD. If -one of the supplied styles doesn't suffice a function could be -set instead. This function is expected return a list that +one of the supplied styles doesn't suffice, a function could be +set instead. This function is expected to return a list that follows the form of `treesit-simple-indent-rules'." :version "29.1" :type '(choice (symbol :tag "Gnu" gnu) @@ -134,7 +135,7 @@ c-ts-mode--get-indent-style `((,mode ,@style)))) (defun c-ts-mode--prompt-for-style () - "Prompt for a indent style and return the symbol for it." + "Prompt for an indent style and return the symbol for it." (let ((mode (if (derived-mode-p 'c-ts-mode) 'c 'c++))) (intern (completing-read @@ -142,16 +143,20 @@ c-ts-mode--prompt-for-style (mapcar #'car (c-ts-mode--indent-styles mode)) nil t nil nil "gnu")))) -(defun c-ts-mode-set-style (style) +(defun c-ts-mode-set-global-style (style) "Set the indent style of C/C++ modes globally to STYLE. This changes the current indent style of every C/C++ buffer and -the default C/C++ indent style in this Emacs session." +the default C/C++ indent style for `c-ts-mode' and `c++-ts-mode' +in this Emacs session." (interactive (list (c-ts-mode--prompt-for-style))) (c-ts-mode--indent-style-setter 'c-ts-mode-indent-style style)) -(defun c-ts-mode-set-local-style (style) - "Set the C/C++ indent style of the current buffer to STYLE." +(defun c-ts-mode-set-style (style) + "Set the C/C++ indent style of the current buffer to STYLE. + +To set the default indent style globally, use +`c-ts-mode-set-global-style'." (interactive (list (c-ts-mode--prompt-for-style))) (if (not (derived-mode-p 'c-ts-mode 'c++-ts-mode)) (user-error "The current buffer is not in `c-ts-mode' nor `c++-ts-mode'") diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts b/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts index ba4f854baf8..74e34fe821b 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts @@ -3,7 +3,7 @@ Code: (c-ts-mode) (setq-local indent-tabs-mode nil) (setq-local c-ts-mode-indent-offset 2) - (c-ts-mode-set-local-style 'bsd) + (c-ts-mode-set-style 'bsd) (indent-region (point-min) (point-max))) Point-Char: | diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index 058c6e9099c..7dcc3b0fb3a 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -3,7 +3,7 @@ Code: (c-ts-mode) (setq-local indent-tabs-mode nil) (setq-local c-ts-mode-indent-offset 2) - (c-ts-mode-set-local-style 'gnu) + (c-ts-mode-set-style 'gnu) (indent-region (point-min) (point-max))) Point-Char: | @@ -196,7 +196,7 @@ Code: (c-ts-mode) (setq-local indent-tabs-mode nil) (setq-local c-ts-mode-indent-offset 8) - (c-ts-mode-set-local-style 'linux) + (c-ts-mode-set-style 'linux) (indent-region (point-min) (point-max))) Name: Labels (Linux Style) commit 671e5d9fad5852165f4e63992c91cd6f8c715004 Author: Yuan Fu Date: Thu Feb 2 18:54:49 2023 -0800 ; * lisp/treesit.el (treesit--font-lock-level-setter): Minor change. diff --git a/lisp/treesit.el b/lisp/treesit.el index 98f446a1456..6426eb08fe6 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -555,8 +555,12 @@ 'treesit-font-lock-error "Generic tree-sitter font-lock error" 'treesit-error) +(defvar treesit-font-lock-settings) (defun treesit--font-lock-level-setter (sym val) - "Custom setter for `treesit-font-lock-level'." + "Custom setter for `treesit-font-lock-level'. +Set the default value of SYM to VAL, recompute fontification +features and refontify for every buffer where tree-sitter-based +fontification is enabled." (set-default sym val) (and (treesit-available-p) (named-let loop ((res nil) @@ -571,7 +575,7 @@ treesit--font-lock-level-setter res) (let ((buffer (car buffers))) (with-current-buffer buffer - (if (treesit-parser-list) + (if treesit-font-lock-settings (loop (append res (list buffer)) (cdr buffers)) (loop res (cdr buffers))))))))) commit b429274c5b4b2b511d2d351111dea2d354498e0f Author: Paul Eggert Date: Sat Feb 4 14:55:12 2023 -0800 Use Gnulib module alignasof instead of stdalign * admin/merge-gnulib (GNULIB_MODULES): Replace obsolescent Gnulib module stdalign with alignasof. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. * lib/stdalign.in.h: Remove; no longer needed. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 7f4b6678a94..04e3e34b9f9 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -26,7 +26,7 @@ GNULIB_URL=https://git.savannah.gnu.org/git/gnulib.git GNULIB_MODULES=' - alloca-opt binary-io byteswap c-ctype c-strcase + alignasof alloca-opt binary-io byteswap c-ctype c-strcase canonicalize-lgpl careadlinkat close-stream copy-file-range count-leading-zeros count-one-bits count-trailing-zeros @@ -44,7 +44,7 @@ GNULIB_MODULES= nanosleep nproc nstrftime pathmax pipe2 pselect pthread_sigmask qcopy-acl readlink readlinkat regex - sig2str sigdescr_np socklen stat-time std-gnu11 stdalign stdbool stddef stdio + sig2str sigdescr_np socklen stat-time std-gnu11 stdbool stddef stdio stpcpy strnlen strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub update-copyright unlocked-io utimensat diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 2e052465c79..53a821b141e 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -68,6 +68,7 @@ # --avoid=wchar \ # --avoid=wcrtomb \ # --avoid=wctype-h \ +# alignasof \ # alloca-opt \ # binary-io \ # byteswap \ @@ -145,7 +146,6 @@ # socklen \ # stat-time \ # std-gnu11 \ -# stdalign \ # stdbool \ # stddef \ # stdio \ @@ -325,7 +325,6 @@ GL_GENERATE_GMP_H_CONDITION = @GL_GENERATE_GMP_H_CONDITION@ GL_GENERATE_IEEE754_H_CONDITION = @GL_GENERATE_IEEE754_H_CONDITION@ GL_GENERATE_LIMITS_H_CONDITION = @GL_GENERATE_LIMITS_H_CONDITION@ GL_GENERATE_MINI_GMP_H_CONDITION = @GL_GENERATE_MINI_GMP_H_CONDITION@ -GL_GENERATE_STDALIGN_H_CONDITION = @GL_GENERATE_STDALIGN_H_CONDITION@ GL_GENERATE_STDCKDINT_H_CONDITION = @GL_GENERATE_STDCKDINT_H_CONDITION@ GL_GENERATE_STDDEF_H_CONDITION = @GL_GENERATE_STDDEF_H_CONDITION@ GL_GENERATE_STDINT_H_CONDITION = @GL_GENERATE_STDINT_H_CONDITION@ @@ -827,7 +826,6 @@ HAVE_SIGNED_WINT_T = @HAVE_SIGNED_WINT_T@ HAVE_SIGSET_T = @HAVE_SIGSET_T@ HAVE_SLEEP = @HAVE_SLEEP@ HAVE_SPAWN_H = @HAVE_SPAWN_H@ -HAVE_STDALIGN_H = @HAVE_STDALIGN_H@ HAVE_STDINT_H = @HAVE_STDINT_H@ HAVE_STPCPY = @HAVE_STPCPY@ HAVE_STPNCPY = @HAVE_STPNCPY@ @@ -979,7 +977,6 @@ NEXT_AS_FIRST_DIRECTIVE_GETOPT_H = @NEXT_AS_FIRST_DIRECTIVE_GETOPT_H@ NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H = @NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H@ NEXT_AS_FIRST_DIRECTIVE_LIMITS_H = @NEXT_AS_FIRST_DIRECTIVE_LIMITS_H@ NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H = @NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H@ -NEXT_AS_FIRST_DIRECTIVE_STDALIGN_H = @NEXT_AS_FIRST_DIRECTIVE_STDALIGN_H@ NEXT_AS_FIRST_DIRECTIVE_STDDEF_H = @NEXT_AS_FIRST_DIRECTIVE_STDDEF_H@ NEXT_AS_FIRST_DIRECTIVE_STDINT_H = @NEXT_AS_FIRST_DIRECTIVE_STDINT_H@ NEXT_AS_FIRST_DIRECTIVE_STDIO_H = @NEXT_AS_FIRST_DIRECTIVE_STDIO_H@ @@ -999,7 +996,6 @@ NEXT_GETOPT_H = @NEXT_GETOPT_H@ NEXT_INTTYPES_H = @NEXT_INTTYPES_H@ NEXT_LIMITS_H = @NEXT_LIMITS_H@ NEXT_SIGNAL_H = @NEXT_SIGNAL_H@ -NEXT_STDALIGN_H = @NEXT_STDALIGN_H@ NEXT_STDDEF_H = @NEXT_STDDEF_H@ NEXT_STDINT_H = @NEXT_STDINT_H@ NEXT_STDIO_H = @NEXT_STDIO_H@ @@ -1245,7 +1241,6 @@ SIZEOF_LONG = @SIZEOF_LONG@ SIZE_T_SUFFIX = @SIZE_T_SUFFIX@ SMALL_JA_DIC = @SMALL_JA_DIC@ SQLITE3_LIBS = @SQLITE3_LIBS@ -STDALIGN_H = @STDALIGN_H@ STDCKDINT_H = @STDCKDINT_H@ STDDEF_H = @STDDEF_H@ STDINT_H = @STDINT_H@ @@ -2933,35 +2928,6 @@ EXTRA_DIST += stat-time.h endif ## end gnulib module stat-time -## begin gnulib module stdalign -ifeq (,$(OMIT_GNULIB_MODULE_stdalign)) - -BUILT_SOURCES += $(STDALIGN_H) - -# We need the following in order to create when the system -# doesn't have one that works. -ifneq (,$(GL_GENERATE_STDALIGN_H_CONDITION)) -stdalign.h: stdalign.in.h $(top_builddir)/config.status - $(gl_V_at)$(SED_HEADER_STDOUT) \ - -e 's|@''GUARD_PREFIX''@|GL|g' \ - -e 's|@''HAVE_STDALIGN_H''@|$(HAVE_STDALIGN_H)|g' \ - -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ - -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ - -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_STDALIGN_H''@|$(NEXT_STDALIGN_H)|g' \ - $(srcdir)/stdalign.in.h > $@-t - $(AM_V_at)mv $@-t $@ -else -stdalign.h: $(top_builddir)/config.status - rm -f $@ -endif -MOSTLYCLEANFILES += stdalign.h stdalign.h-t - -EXTRA_DIST += stdalign.in.h - -endif -## end gnulib module stdalign - ## begin gnulib module stdckdint ifeq (,$(OMIT_GNULIB_MODULE_stdckdint)) diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h deleted file mode 100644 index b616c100fdc..00000000000 --- a/lib/stdalign.in.h +++ /dev/null @@ -1,49 +0,0 @@ -/* A substitute for ISO C11 . - - Copyright 2011-2023 Free Software Foundation, Inc. - - This file is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 2.1 of the - License, or (at your option) any later version. - - This file is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . */ - -/* Written by Paul Eggert and Bruno Haible. */ - -/* Define two obsolescent C11 macros, assuming alignas and alignof are - either keywords or alignasof-defined macros. */ - -#ifndef _@GUARD_PREFIX@_STDALIGN_H - -#if __GNUC__ >= 3 -@PRAGMA_SYSTEM_HEADER@ -#endif -@PRAGMA_COLUMNS@ - -/* We need to include the system's when it exists, because it might - define 'alignof' as a macro when it's not a keyword or compiler built-in. */ -#if @HAVE_STDALIGN_H@ -/* The include_next requires a split double-inclusion guard. */ -# @INCLUDE_NEXT@ @NEXT_STDALIGN_H@ -#endif - -#ifndef _@GUARD_PREFIX@_STDALIGN_H -#define _@GUARD_PREFIX@_STDALIGN_H - -#if (defined alignas \ - || (defined __STDC_VERSION__ && 202311 <= __STDC_VERSION__) \ - || (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) -# define __alignas_is_defined 1 -#endif - -#define __alignof_is_defined 1 - -#endif /* _@GUARD_PREFIX@_STDALIGN_H */ -#endif /* _@GUARD_PREFIX@_STDALIGN_H */ diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index aacceb92258..0658652a99e 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -171,7 +171,6 @@ AC_DEFUN # Code from module ssize_t: # Code from module stat-time: # Code from module std-gnu11: - # Code from module stdalign: # Code from module stdbool: # Code from module stdckdint: # Code from module stddef: @@ -500,9 +499,6 @@ AC_DEFUN gt_TYPE_SSIZE_T gl_STAT_TIME gl_STAT_BIRTHTIME - gl_STDALIGN_H - gl_CONDITIONAL_HEADER([stdalign.h]) - AC_PROG_MKDIR_P gl_C_BOOL AC_CHECK_HEADERS_ONCE([stdckdint.h]) if test $ac_cv_header_stdckdint_h = yes; then @@ -1377,7 +1373,6 @@ AC_DEFUN lib/signal.in.h lib/stat-time.c lib/stat-time.h - lib/stdalign.in.h lib/stdckdint.in.h lib/stddef.in.h lib/stdint.in.h commit 04d97e76a96854a9a9f4778cb1202a87537731de Author: Paul Eggert Date: Sat Feb 4 14:45:11 2023 -0800 Update from Gnulib by running admin/merge-gnulib diff --git a/build-aux/config.guess b/build-aux/config.guess index 980b0208381..69188da73d7 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -1,10 +1,10 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright 1992-2022 Free Software Foundation, Inc. +# Copyright 1992-2023 Free Software Foundation, Inc. # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2022-09-17' +timestamp='2023-01-01' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -60,7 +60,7 @@ version= GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright 1992-2022 Free Software Foundation, Inc. +Copyright 1992-2023 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." diff --git a/build-aux/config.sub b/build-aux/config.sub index baf1512b3c0..de4259e4047 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -1,10 +1,10 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright 1992-2022 Free Software Foundation, Inc. +# Copyright 1992-2023 Free Software Foundation, Inc. # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2022-09-17' +timestamp='2023-01-21' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -76,7 +76,7 @@ usage= version="\ GNU config.sub ($timestamp) -Copyright 1992-2022 Free Software Foundation, Inc. +Copyright 1992-2023 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -1075,7 +1075,7 @@ IFS= pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) cpu=i586 ;; - pentiumpro-* | p6-* | 6x86-* | athlon-* | athalon_*-*) + pentiumpro-* | p6-* | 6x86-* | athlon-* | athlon_*-*) cpu=i686 ;; pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) diff --git a/lib/_Noreturn.h b/lib/_Noreturn.h index fa15b1b25e8..6ecea98b54a 100644 --- a/lib/_Noreturn.h +++ b/lib/_Noreturn.h @@ -26,6 +26,11 @@ AIX system header files and several gnulib header files use precisely this syntax with 'extern'. */ # define _Noreturn [[noreturn]] +# elif (defined __clang__ && __clang_major__ < 16 \ + && defined _GL_WORK_AROUND_LLVM_BUG_59792) + /* Compile with -D_GL_WORK_AROUND_LLVM_BUG_59792 to work around + that rare LLVM bug, though you may get many false-alarm warnings. */ +# define _Noreturn # elif ((!defined __cplusplus || defined __clang__) \ && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \ || (!defined __STRICT_ANSI__ \ diff --git a/lib/cdefs.h b/lib/cdefs.h index 09a3d19b23b..412f036ce35 100644 --- a/lib/cdefs.h +++ b/lib/cdefs.h @@ -140,32 +140,37 @@ #define __ptr_t void * #endif +/* Gnulib avoids these definitions, as they don't work on non-glibc platforms. + In particular, __bos and __bos0 are defined differently in the Android libc. + */ +#ifndef __GNULIB_CDEFS + /* Fortify support. */ -#define __bos(ptr) __builtin_object_size (ptr, __USE_FORTIFY_LEVEL > 1) -#define __bos0(ptr) __builtin_object_size (ptr, 0) +# define __bos(ptr) __builtin_object_size (ptr, __USE_FORTIFY_LEVEL > 1) +# define __bos0(ptr) __builtin_object_size (ptr, 0) /* Use __builtin_dynamic_object_size at _FORTIFY_SOURCE=3 when available. */ -#if __USE_FORTIFY_LEVEL == 3 && (__glibc_clang_prereq (9, 0) \ - || __GNUC_PREREQ (12, 0)) -# define __glibc_objsize0(__o) __builtin_dynamic_object_size (__o, 0) -# define __glibc_objsize(__o) __builtin_dynamic_object_size (__o, 1) -#else -# define __glibc_objsize0(__o) __bos0 (__o) -# define __glibc_objsize(__o) __bos (__o) -#endif +# if __USE_FORTIFY_LEVEL == 3 && (__glibc_clang_prereq (9, 0) \ + || __GNUC_PREREQ (12, 0)) +# define __glibc_objsize0(__o) __builtin_dynamic_object_size (__o, 0) +# define __glibc_objsize(__o) __builtin_dynamic_object_size (__o, 1) +# else +# define __glibc_objsize0(__o) __bos0 (__o) +# define __glibc_objsize(__o) __bos (__o) +# endif /* Compile time conditions to choose between the regular, _chk and _chk_warn variants. These conditions should get evaluated to constant and optimized away. */ -#define __glibc_safe_len_cond(__l, __s, __osz) ((__l) <= (__osz) / (__s)) -#define __glibc_unsigned_or_positive(__l) \ +# define __glibc_safe_len_cond(__l, __s, __osz) ((__l) <= (__osz) / (__s)) +# define __glibc_unsigned_or_positive(__l) \ ((__typeof (__l)) 0 < (__typeof (__l)) -1 \ || (__builtin_constant_p (__l) && (__l) > 0)) /* Length is known to be safe at compile time if the __L * __S <= __OBJSZ condition can be folded to a constant and if it is true, or unknown (-1) */ -#define __glibc_safe_or_unknown_len(__l, __s, __osz) \ +# define __glibc_safe_or_unknown_len(__l, __s, __osz) \ ((__osz) == (__SIZE_TYPE__) -1 \ || (__glibc_unsigned_or_positive (__l) \ && __builtin_constant_p (__glibc_safe_len_cond ((__SIZE_TYPE__) (__l), \ @@ -175,7 +180,7 @@ #define __glibc_safe_or_unknown_len(__l, __s, __osz) \ /* Conversely, we know at compile time that the length is unsafe if the __L * __S <= __OBJSZ condition can be folded to a constant and if it is false. */ -#define __glibc_unsafe_len(__l, __s, __osz) \ +# define __glibc_unsafe_len(__l, __s, __osz) \ (__glibc_unsigned_or_positive (__l) \ && __builtin_constant_p (__glibc_safe_len_cond ((__SIZE_TYPE__) (__l), \ __s, __osz)) \ @@ -184,7 +189,7 @@ #define __glibc_unsafe_len(__l, __s, __osz) \ /* Fortify function f. __f_alias, __f_chk and __f_chk_warn must be declared. */ -#define __glibc_fortify(f, __l, __s, __osz, ...) \ +# define __glibc_fortify(f, __l, __s, __osz, ...) \ (__glibc_safe_or_unknown_len (__l, __s, __osz) \ ? __ ## f ## _alias (__VA_ARGS__) \ : (__glibc_unsafe_len (__l, __s, __osz) \ @@ -194,13 +199,16 @@ #define __glibc_fortify(f, __l, __s, __osz, ...) \ /* Fortify function f, where object size argument passed to f is the number of elements and not total size. */ -#define __glibc_fortify_n(f, __l, __s, __osz, ...) \ +# define __glibc_fortify_n(f, __l, __s, __osz, ...) \ (__glibc_safe_or_unknown_len (__l, __s, __osz) \ ? __ ## f ## _alias (__VA_ARGS__) \ : (__glibc_unsafe_len (__l, __s, __osz) \ ? __ ## f ## _chk_warn (__VA_ARGS__, (__osz) / (__s)) \ : __ ## f ## _chk (__VA_ARGS__, (__osz) / (__s)))) \ +#endif + + #if __GNUC_PREREQ (4,3) # define __warnattr(msg) __attribute__((__warning__ (msg))) # define __errordecl(name, msg) \ diff --git a/lib/fpending.c b/lib/fpending.c index afa840b8512..e57155e586e 100644 --- a/lib/fpending.c +++ b/lib/fpending.c @@ -41,7 +41,7 @@ __fpending (FILE *fp) return fp->_IO_write_ptr - fp->_IO_write_base; #elif defined __sferror || defined __DragonFly__ || defined __ANDROID__ /* FreeBSD, NetBSD, OpenBSD, DragonFly, Mac OS X, Cygwin < 1.7.34, Minix 3, Android */ - return fp->_p - fp->_bf._base; + return fp_->_p - fp_->_bf._base; #elif defined __EMX__ /* emx+gcc */ return fp->_ptr - fp->_buffer; #elif defined __minix /* Minix */ diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 2097850c812..2e052465c79 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -411,6 +411,7 @@ GL_GNULIB_GETOPT_POSIX = @GL_GNULIB_GETOPT_POSIX@ GL_GNULIB_GETPAGESIZE = @GL_GNULIB_GETPAGESIZE@ GL_GNULIB_GETPASS = @GL_GNULIB_GETPASS@ GL_GNULIB_GETPASS_GNU = @GL_GNULIB_GETPASS_GNU@ +GL_GNULIB_GETPROGNAME = @GL_GNULIB_GETPROGNAME@ GL_GNULIB_GETRANDOM = @GL_GNULIB_GETRANDOM@ GL_GNULIB_GETSUBOPT = @GL_GNULIB_GETSUBOPT@ GL_GNULIB_GETTIMEOFDAY = @GL_GNULIB_GETTIMEOFDAY@ @@ -734,6 +735,7 @@ HAVE_GETLOGIN = @HAVE_GETLOGIN@ HAVE_GETOPT_H = @HAVE_GETOPT_H@ HAVE_GETPAGESIZE = @HAVE_GETPAGESIZE@ HAVE_GETPASS = @HAVE_GETPASS@ +HAVE_GETPROGNAME = @HAVE_GETPROGNAME@ HAVE_GETRANDOM = @HAVE_GETRANDOM@ HAVE_GETSUBOPT = @HAVE_GETSUBOPT@ HAVE_GETTIMEOFDAY = @HAVE_GETTIMEOFDAY@ @@ -741,6 +743,8 @@ HAVE_GETUMASK = @HAVE_GETUMASK@ HAVE_GRANTPT = @HAVE_GRANTPT@ HAVE_GROUP_MEMBER = @HAVE_GROUP_MEMBER@ HAVE_GSETTINGS = @HAVE_GSETTINGS@ +HAVE_IMAXABS = @HAVE_IMAXABS@ +HAVE_IMAXDIV = @HAVE_IMAXDIV@ HAVE_IMAXDIV_T = @HAVE_IMAXDIV_T@ HAVE_INITSTATE = @HAVE_INITSTATE@ HAVE_INTTYPES_H = @HAVE_INTTYPES_H@ @@ -823,6 +827,7 @@ HAVE_SIGNED_WINT_T = @HAVE_SIGNED_WINT_T@ HAVE_SIGSET_T = @HAVE_SIGSET_T@ HAVE_SLEEP = @HAVE_SLEEP@ HAVE_SPAWN_H = @HAVE_SPAWN_H@ +HAVE_STDALIGN_H = @HAVE_STDALIGN_H@ HAVE_STDINT_H = @HAVE_STDINT_H@ HAVE_STPCPY = @HAVE_STPCPY@ HAVE_STPNCPY = @HAVE_STPNCPY@ @@ -974,6 +979,7 @@ NEXT_AS_FIRST_DIRECTIVE_GETOPT_H = @NEXT_AS_FIRST_DIRECTIVE_GETOPT_H@ NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H = @NEXT_AS_FIRST_DIRECTIVE_INTTYPES_H@ NEXT_AS_FIRST_DIRECTIVE_LIMITS_H = @NEXT_AS_FIRST_DIRECTIVE_LIMITS_H@ NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H = @NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H@ +NEXT_AS_FIRST_DIRECTIVE_STDALIGN_H = @NEXT_AS_FIRST_DIRECTIVE_STDALIGN_H@ NEXT_AS_FIRST_DIRECTIVE_STDDEF_H = @NEXT_AS_FIRST_DIRECTIVE_STDDEF_H@ NEXT_AS_FIRST_DIRECTIVE_STDINT_H = @NEXT_AS_FIRST_DIRECTIVE_STDINT_H@ NEXT_AS_FIRST_DIRECTIVE_STDIO_H = @NEXT_AS_FIRST_DIRECTIVE_STDIO_H@ @@ -993,6 +999,7 @@ NEXT_GETOPT_H = @NEXT_GETOPT_H@ NEXT_INTTYPES_H = @NEXT_INTTYPES_H@ NEXT_LIMITS_H = @NEXT_LIMITS_H@ NEXT_SIGNAL_H = @NEXT_SIGNAL_H@ +NEXT_STDALIGN_H = @NEXT_STDALIGN_H@ NEXT_STDDEF_H = @NEXT_STDDEF_H@ NEXT_STDINT_H = @NEXT_STDINT_H@ NEXT_STDIO_H = @NEXT_STDIO_H@ @@ -1061,6 +1068,7 @@ REPLACE_DIRFD = @REPLACE_DIRFD@ REPLACE_DPRINTF = @REPLACE_DPRINTF@ REPLACE_DUP = @REPLACE_DUP@ REPLACE_DUP2 = @REPLACE_DUP2@ +REPLACE_DUP3 = @REPLACE_DUP3@ REPLACE_EXECL = @REPLACE_EXECL@ REPLACE_EXECLE = @REPLACE_EXECLE@ REPLACE_EXECLP = @REPLACE_EXECLP@ @@ -1073,6 +1081,7 @@ REPLACE_FCHMODAT = @REPLACE_FCHMODAT@ REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@ REPLACE_FCLOSE = @REPLACE_FCLOSE@ REPLACE_FCNTL = @REPLACE_FCNTL@ +REPLACE_FDATASYNC = @REPLACE_FDATASYNC@ REPLACE_FDOPEN = @REPLACE_FDOPEN@ REPLACE_FDOPENDIR = @REPLACE_FDOPENDIR@ REPLACE_FFLUSH = @REPLACE_FFLUSH@ @@ -1095,15 +1104,21 @@ REPLACE_GETCWD = @REPLACE_GETCWD@ REPLACE_GETDELIM = @REPLACE_GETDELIM@ REPLACE_GETDOMAINNAME = @REPLACE_GETDOMAINNAME@ REPLACE_GETDTABLESIZE = @REPLACE_GETDTABLESIZE@ +REPLACE_GETENTROPY = @REPLACE_GETENTROPY@ REPLACE_GETGROUPS = @REPLACE_GETGROUPS@ REPLACE_GETLINE = @REPLACE_GETLINE@ +REPLACE_GETLOADAVG = @REPLACE_GETLOADAVG@ REPLACE_GETLOGIN_R = @REPLACE_GETLOGIN_R@ REPLACE_GETPAGESIZE = @REPLACE_GETPAGESIZE@ REPLACE_GETPASS = @REPLACE_GETPASS@ REPLACE_GETPASS_FOR_GETPASS_GNU = @REPLACE_GETPASS_FOR_GETPASS_GNU@ +REPLACE_GETPROGNAME = @REPLACE_GETPROGNAME@ REPLACE_GETRANDOM = @REPLACE_GETRANDOM@ +REPLACE_GETSUBOPT = @REPLACE_GETSUBOPT@ REPLACE_GETTIMEOFDAY = @REPLACE_GETTIMEOFDAY@ REPLACE_GMTIME = @REPLACE_GMTIME@ +REPLACE_IMAXABS = @REPLACE_IMAXABS@ +REPLACE_IMAXDIV = @REPLACE_IMAXDIV@ REPLACE_INITSTATE = @REPLACE_INITSTATE@ REPLACE_ISATTY = @REPLACE_ISATTY@ REPLACE_LCHOWN = @REPLACE_LCHOWN@ @@ -1118,11 +1133,14 @@ REPLACE_MALLOC_FOR_MALLOC_POSIX = @REPLACE_MALLOC_FOR_MALLOC_POSIX@ REPLACE_MBTOWC = @REPLACE_MBTOWC@ REPLACE_MEMCHR = @REPLACE_MEMCHR@ REPLACE_MEMMEM = @REPLACE_MEMMEM@ +REPLACE_MEMPCPY = @REPLACE_MEMPCPY@ REPLACE_MKDIR = @REPLACE_MKDIR@ REPLACE_MKFIFO = @REPLACE_MKFIFO@ REPLACE_MKFIFOAT = @REPLACE_MKFIFOAT@ REPLACE_MKNOD = @REPLACE_MKNOD@ REPLACE_MKNODAT = @REPLACE_MKNODAT@ +REPLACE_MKOSTEMP = @REPLACE_MKOSTEMP@ +REPLACE_MKOSTEMPS = @REPLACE_MKOSTEMPS@ REPLACE_MKSTEMP = @REPLACE_MKSTEMP@ REPLACE_MKTIME = @REPLACE_MKTIME@ REPLACE_NANOSLEEP = @REPLACE_NANOSLEEP@ @@ -1132,8 +1150,10 @@ REPLACE_OPEN = @REPLACE_OPEN@ REPLACE_OPENAT = @REPLACE_OPENAT@ REPLACE_OPENDIR = @REPLACE_OPENDIR@ REPLACE_PERROR = @REPLACE_PERROR@ +REPLACE_PIPE2 = @REPLACE_PIPE2@ REPLACE_POPEN = @REPLACE_POPEN@ REPLACE_POSIX_MEMALIGN = @REPLACE_POSIX_MEMALIGN@ +REPLACE_POSIX_OPENPT = @REPLACE_POSIX_OPENPT@ REPLACE_PREAD = @REPLACE_PREAD@ REPLACE_PRINTF = @REPLACE_PRINTF@ REPLACE_PSELECT = @REPLACE_PSELECT@ @@ -1159,6 +1179,7 @@ REPLACE_RENAMEAT = @REPLACE_RENAMEAT@ REPLACE_RMDIR = @REPLACE_RMDIR@ REPLACE_SELECT = @REPLACE_SELECT@ REPLACE_SETENV = @REPLACE_SETENV@ +REPLACE_SETHOSTNAME = @REPLACE_SETHOSTNAME@ REPLACE_SETSTATE = @REPLACE_SETSTATE@ REPLACE_SLEEP = @REPLACE_SLEEP@ REPLACE_SNPRINTF = @REPLACE_SNPRINTF@ @@ -1166,6 +1187,7 @@ REPLACE_SPRINTF = @REPLACE_SPRINTF@ REPLACE_STAT = @REPLACE_STAT@ REPLACE_STDIO_READ_FUNCS = @REPLACE_STDIO_READ_FUNCS@ REPLACE_STDIO_WRITE_FUNCS = @REPLACE_STDIO_WRITE_FUNCS@ +REPLACE_STPCPY = @REPLACE_STPCPY@ REPLACE_STPNCPY = @REPLACE_STPNCPY@ REPLACE_STRCASESTR = @REPLACE_STRCASESTR@ REPLACE_STRCHRNUL = @REPLACE_STRCHRNUL@ @@ -1192,6 +1214,7 @@ REPLACE_STRUCT_TIMEVAL = @REPLACE_STRUCT_TIMEVAL@ REPLACE_SYMLINK = @REPLACE_SYMLINK@ REPLACE_SYMLINKAT = @REPLACE_SYMLINKAT@ REPLACE_TIMEGM = @REPLACE_TIMEGM@ +REPLACE_TIMESPEC_GET = @REPLACE_TIMESPEC_GET@ REPLACE_TMPFILE = @REPLACE_TMPFILE@ REPLACE_TRUNCATE = @REPLACE_TRUNCATE@ REPLACE_TTYNAME_R = @REPLACE_TTYNAME_R@ @@ -1209,6 +1232,7 @@ REPLACE_VSNPRINTF = @REPLACE_VSNPRINTF@ REPLACE_VSPRINTF = @REPLACE_VSPRINTF@ REPLACE_WCTOMB = @REPLACE_WCTOMB@ REPLACE_WRITE = @REPLACE_WRITE@ +REPLACE__EXIT = @REPLACE__EXIT@ RSVG_CFLAGS = @RSVG_CFLAGS@ RSVG_LIBS = @RSVG_LIBS@ SEPCHAR = @SEPCHAR@ @@ -2369,6 +2393,8 @@ inttypes.h: inttypes.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_U -e 's/@''HAVE_DECL_STRTOIMAX''@/$(HAVE_DECL_STRTOIMAX)/g' \ -e 's/@''HAVE_DECL_STRTOUMAX''@/$(HAVE_DECL_STRTOUMAX)/g' \ -e 's/@''HAVE_IMAXDIV_T''@/$(HAVE_IMAXDIV_T)/g' \ + -e 's/@''REPLACE_IMAXABS''@/$(REPLACE_IMAXABS)/g' \ + -e 's/@''REPLACE_IMAXDIV''@/$(REPLACE_IMAXDIV)/g' \ -e 's/@''REPLACE_STRTOIMAX''@/$(REPLACE_STRTOIMAX)/g' \ -e 's/@''REPLACE_STRTOUMAX''@/$(REPLACE_STRTOUMAX)/g' \ -e 's/@''INT32_MAX_LT_INTMAX_MAX''@/$(INT32_MAX_LT_INTMAX_MAX)/g' \ @@ -2916,7 +2942,14 @@ BUILT_SOURCES += $(STDALIGN_H) # doesn't have one that works. ifneq (,$(GL_GENERATE_STDALIGN_H_CONDITION)) stdalign.h: stdalign.in.h $(top_builddir)/config.status - $(gl_V_at)$(SED_HEADER_TO_AT_t) $(srcdir)/stdalign.in.h + $(gl_V_at)$(SED_HEADER_STDOUT) \ + -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''HAVE_STDALIGN_H''@|$(HAVE_STDALIGN_H)|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_STDALIGN_H''@|$(NEXT_STDALIGN_H)|g' \ + $(srcdir)/stdalign.in.h > $@-t $(AM_V_at)mv $@-t $@ else stdalign.h: $(top_builddir)/config.status @@ -3203,6 +3236,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's/@''GNULIB_CANONICALIZE_FILE_NAME''@/$(GL_GNULIB_CANONICALIZE_FILE_NAME)/g' \ -e 's/@''GNULIB_FREE_POSIX''@/$(GL_GNULIB_FREE_POSIX)/g' \ -e 's/@''GNULIB_GETLOADAVG''@/$(GL_GNULIB_GETLOADAVG)/g' \ + -e 's/@''GNULIB_GETPROGNAME''@/$(GL_GNULIB_GETPROGNAME)/g' \ -e 's/@''GNULIB_GETSUBOPT''@/$(GL_GNULIB_GETSUBOPT)/g' \ -e 's/@''GNULIB_GRANTPT''@/$(GL_GNULIB_GRANTPT)/g' \ -e 's/@''GNULIB_MALLOC_GNU''@/$(GL_GNULIB_MALLOC_GNU)/g' \ @@ -3252,6 +3286,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''HAVE_DECL_FCVT''@|$(HAVE_DECL_FCVT)|g' \ -e 's|@''HAVE_DECL_GCVT''@|$(HAVE_DECL_GCVT)|g' \ -e 's|@''HAVE_DECL_GETLOADAVG''@|$(HAVE_DECL_GETLOADAVG)|g' \ + -e 's|@''HAVE_GETPROGNAME''@|$(HAVE_GETPROGNAME)|g' \ -e 's|@''HAVE_GETSUBOPT''@|$(HAVE_GETSUBOPT)|g' \ -e 's|@''HAVE_GRANTPT''@|$(HAVE_GRANTPT)|g' \ -e 's|@''HAVE_INITSTATE''@|$(HAVE_INITSTATE)|g' \ @@ -3287,17 +3322,24 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''HAVE_SYS_LOADAVG_H''@|$(HAVE_SYS_LOADAVG_H)|g' \ -e 's|@''HAVE_UNLOCKPT''@|$(HAVE_UNLOCKPT)|g' \ -e 's|@''HAVE_DECL_UNSETENV''@|$(HAVE_DECL_UNSETENV)|g' \ + -e 's|@''REPLACE__EXIT''@|$(REPLACE__EXIT)|g' \ -e 's|@''REPLACE_ALIGNED_ALLOC''@|$(REPLACE_ALIGNED_ALLOC)|g' \ -e 's|@''REPLACE_CALLOC_FOR_CALLOC_GNU''@|$(REPLACE_CALLOC_FOR_CALLOC_GNU)|g' \ -e 's|@''REPLACE_CALLOC_FOR_CALLOC_POSIX''@|$(REPLACE_CALLOC_FOR_CALLOC_POSIX)|g' \ -e 's|@''REPLACE_CANONICALIZE_FILE_NAME''@|$(REPLACE_CANONICALIZE_FILE_NAME)|g' \ -e 's|@''REPLACE_FREE''@|$(REPLACE_FREE)|g' \ + -e 's|@''REPLACE_GETLOADAVG''@|$(REPLACE_GETLOADAVG)|g' \ + -e 's|@''REPLACE_GETPROGNAME''@|$(REPLACE_GETPROGNAME)|g' \ + -e 's|@''REPLACE_GETSUBOPT''@|$(REPLACE_GETSUBOPT)|g' \ -e 's|@''REPLACE_INITSTATE''@|$(REPLACE_INITSTATE)|g' \ -e 's|@''REPLACE_MALLOC_FOR_MALLOC_GNU''@|$(REPLACE_MALLOC_FOR_MALLOC_GNU)|g' \ -e 's|@''REPLACE_MALLOC_FOR_MALLOC_POSIX''@|$(REPLACE_MALLOC_FOR_MALLOC_POSIX)|g' \ -e 's|@''REPLACE_MBTOWC''@|$(REPLACE_MBTOWC)|g' \ + -e 's|@''REPLACE_MKOSTEMP''@|$(REPLACE_MKOSTEMP)|g' \ + -e 's|@''REPLACE_MKOSTEMPS''@|$(REPLACE_MKOSTEMPS)|g' \ -e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \ -e 's|@''REPLACE_POSIX_MEMALIGN''@|$(REPLACE_POSIX_MEMALIGN)|g' \ + -e 's|@''REPLACE_POSIX_OPENPT''@|$(REPLACE_POSIX_OPENPT)|g' \ -e 's|@''REPLACE_PTSNAME''@|$(REPLACE_PTSNAME)|g' \ -e 's|@''REPLACE_PTSNAME_R''@|$(REPLACE_PTSNAME_R)|g' \ -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \ @@ -3429,7 +3471,9 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_FFSLL''@|$(REPLACE_FFSLL)|g' \ -e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \ -e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \ + -e 's|@''REPLACE_MEMPCPY''@|$(REPLACE_MEMPCPY)|g' \ -e 's|@''REPLACE_FREE''@|$(REPLACE_FREE)|g' \ + -e 's|@''REPLACE_STPCPY''@|$(REPLACE_STPCPY)|g' \ -e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \ -e 's|@''REPLACE_STRCHRNUL''@|$(REPLACE_STRCHRNUL)|g' \ -e 's|@''REPLACE_STRDUP''@|$(REPLACE_STRDUP)|g' \ @@ -3755,6 +3799,7 @@ time.h: time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $( -e 's|@''REPLACE_NANOSLEEP''@|$(REPLACE_NANOSLEEP)|g' \ -e 's|@''REPLACE_STRFTIME''@|$(REPLACE_STRFTIME)|g' \ -e 's|@''REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \ + -e 's|@''REPLACE_TIMESPEC_GET''@|$(REPLACE_TIMESPEC_GET)|g' \ -e 's|@''REPLACE_TZSET''@|$(REPLACE_TZSET)|g' \ -e 's|@''PTHREAD_H_DEFINES_STRUCT_TIMESPEC''@|$(PTHREAD_H_DEFINES_STRUCT_TIMESPEC)|g' \ -e 's|@''SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ @@ -3999,6 +4044,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_COPY_FILE_RANGE''@|$(REPLACE_COPY_FILE_RANGE)|g' \ -e 's|@''REPLACE_DUP''@|$(REPLACE_DUP)|g' \ -e 's|@''REPLACE_DUP2''@|$(REPLACE_DUP2)|g' \ + -e 's|@''REPLACE_DUP3''@|$(REPLACE_DUP3)|g' \ -e 's|@''REPLACE_EXECL''@|$(REPLACE_EXECL)|g' \ -e 's|@''REPLACE_EXECLE''@|$(REPLACE_EXECLE)|g' \ -e 's|@''REPLACE_EXECLP''@|$(REPLACE_EXECLP)|g' \ @@ -4008,10 +4054,12 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_EXECVPE''@|$(REPLACE_EXECVPE)|g' \ -e 's|@''REPLACE_FACCESSAT''@|$(REPLACE_FACCESSAT)|g' \ -e 's|@''REPLACE_FCHOWNAT''@|$(REPLACE_FCHOWNAT)|g' \ + -e 's|@''REPLACE_FDATASYNC''@|$(REPLACE_FDATASYNC)|g' \ -e 's|@''REPLACE_FTRUNCATE''@|$(REPLACE_FTRUNCATE)|g' \ -e 's|@''REPLACE_GETCWD''@|$(REPLACE_GETCWD)|g' \ -e 's|@''REPLACE_GETDOMAINNAME''@|$(REPLACE_GETDOMAINNAME)|g' \ -e 's|@''REPLACE_GETDTABLESIZE''@|$(REPLACE_GETDTABLESIZE)|g' \ + -e 's|@''REPLACE_GETENTROPY''@|$(REPLACE_GETENTROPY)|g' \ -e 's|@''REPLACE_GETLOGIN_R''@|$(REPLACE_GETLOGIN_R)|g' \ -e 's|@''REPLACE_GETGROUPS''@|$(REPLACE_GETGROUPS)|g' \ -e 's|@''REPLACE_GETPAGESIZE''@|$(REPLACE_GETPAGESIZE)|g' \ @@ -4022,12 +4070,14 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''REPLACE_LINK''@|$(REPLACE_LINK)|g' \ -e 's|@''REPLACE_LINKAT''@|$(REPLACE_LINKAT)|g' \ -e 's|@''REPLACE_LSEEK''@|$(REPLACE_LSEEK)|g' \ + -e 's|@''REPLACE_PIPE2''@|$(REPLACE_PIPE2)|g' \ -e 's|@''REPLACE_PREAD''@|$(REPLACE_PREAD)|g' \ -e 's|@''REPLACE_PWRITE''@|$(REPLACE_PWRITE)|g' \ -e 's|@''REPLACE_READ''@|$(REPLACE_READ)|g' \ -e 's|@''REPLACE_READLINK''@|$(REPLACE_READLINK)|g' \ -e 's|@''REPLACE_READLINKAT''@|$(REPLACE_READLINKAT)|g' \ -e 's|@''REPLACE_RMDIR''@|$(REPLACE_RMDIR)|g' \ + -e 's|@''REPLACE_SETHOSTNAME''@|$(REPLACE_SETHOSTNAME)|g' \ -e 's|@''REPLACE_SLEEP''@|$(REPLACE_SLEEP)|g' \ -e 's|@''REPLACE_SYMLINK''@|$(REPLACE_SYMLINK)|g' \ -e 's|@''REPLACE_SYMLINKAT''@|$(REPLACE_SYMLINKAT)|g' \ diff --git a/lib/inttypes.in.h b/lib/inttypes.in.h index 50a2bbfcda2..5b7ef12dc7e 100644 --- a/lib/inttypes.in.h +++ b/lib/inttypes.in.h @@ -903,8 +903,21 @@ #define INTTYPES_H #endif #if @GNULIB_IMAXABS@ -# if !@HAVE_DECL_IMAXABS@ -extern intmax_t imaxabs (intmax_t); +# if @REPLACE_IMAXABS@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef imaxabs +# define imaxabs rpl_imaxabs +# endif +_GL_FUNCDECL_RPL (imaxabs, intmax_t, (intmax_t x)); +_GL_CXXALIAS_RPL (imaxabs, intmax_t, (intmax_t x)); +# else +# if !@HAVE_DECL_IMAXABS@ +_GL_FUNCDECL_SYS (imaxabs, intmax_t, (intmax_t x)); +# endif +_GL_CXXALIAS_SYS (imaxabs, intmax_t, (intmax_t x)); +# endif +# if __GLIBC__ >= 2 +_GL_CXXALIASWARN (imaxabs); # endif #elif defined GNULIB_POSIXCHECK # undef imaxabs @@ -921,8 +934,21 @@ _GL_WARN_ON_USE (imaxabs, "imaxabs is unportable - " # define GNULIB_defined_imaxdiv_t 1 # endif # endif -# if !@HAVE_DECL_IMAXDIV@ -extern imaxdiv_t imaxdiv (intmax_t, intmax_t); +# if @REPLACE_IMAXDIV@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef imaxdiv +# define imaxdiv rpl_imaxdiv +# endif +_GL_FUNCDECL_RPL (imaxdiv, imaxdiv_t, (intmax_t numer, intmax_t denom)); +_GL_CXXALIAS_RPL (imaxdiv, imaxdiv_t, (intmax_t numer, intmax_t denom)); +# else +# if !@HAVE_DECL_IMAXDIV@ +_GL_FUNCDECL_SYS (imaxdiv, imaxdiv_t, (intmax_t numer, intmax_t denom)); +# endif +_GL_CXXALIAS_SYS (imaxdiv, imaxdiv_t, (intmax_t numer, intmax_t denom)); +# endif +# if __GLIBC__ >= 2 +_GL_CXXALIASWARN (imaxdiv); # endif #elif defined GNULIB_POSIXCHECK # undef imaxdiv diff --git a/lib/libc-config.h b/lib/libc-config.h index 1d28e58c971..5f5ad010377 100644 --- a/lib/libc-config.h +++ b/lib/libc-config.h @@ -137,8 +137,6 @@ # undef __attribute_returns_twice__ # undef __attribute_used__ # undef __attribute_warn_unused_result__ -# undef __bos -# undef __bos0 # undef __errordecl # undef __extension__ # undef __extern_always_inline @@ -147,21 +145,13 @@ # undef __fortified_attr_access # undef __fortify_function # undef __glibc_c99_flexarr_available -# undef __glibc_fortify -# undef __glibc_fortify_n # undef __glibc_has_attribute # undef __glibc_has_builtin # undef __glibc_has_extension # undef __glibc_likely # undef __glibc_macro_warning # undef __glibc_macro_warning1 -# undef __glibc_objsize -# undef __glibc_objsize0 -# undef __glibc_safe_len_cond -# undef __glibc_safe_or_unknown_len # undef __glibc_unlikely -# undef __glibc_unsafe_len -# undef __glibc_unsigned_or_positive # undef __inline # undef __ptr_t # undef __restrict @@ -170,6 +160,18 @@ # undef __va_arg_pack_len # undef __warnattr # undef __wur +# ifndef __GNULIB_CDEFS +# undef __bos +# undef __bos0 +# undef __glibc_fortify +# undef __glibc_fortify_n +# undef __glibc_objsize +# undef __glibc_objsize0 +# undef __glibc_safe_len_cond +# undef __glibc_safe_or_unknown_len +# undef __glibc_unsafe_len +# undef __glibc_unsigned_or_positive +# endif /* Include our copy of glibc . */ # include diff --git a/lib/openat-proc.c b/lib/openat-proc.c index 2a6a85f0696..88f70be4f59 100644 --- a/lib/openat-proc.c +++ b/lib/openat-proc.c @@ -30,9 +30,12 @@ #include #include -#ifdef __KLIBC__ +#ifdef __KLIBC__ /* OS/2 */ # include #endif +#ifdef __MVS__ /* z/OS */ +# include +#endif #include "intprops.h" @@ -53,7 +56,8 @@ openat_proc_name (char buf[OPENAT_BUFFER_SIZE], int fd, char const *file) return buf; } -#ifndef __KLIBC__ +#if !(defined __KLIBC__ || defined __MVS__) + /* Generic code for Linux, Solaris, and similar platforms. */ # define PROC_SELF_FD_FORMAT "/proc/self/fd/%d/" { enum { @@ -107,14 +111,29 @@ openat_proc_name (char buf[OPENAT_BUFFER_SIZE], int fd, char const *file) dirlen = sprintf (result, PROC_SELF_FD_FORMAT, fd); } } -#else +#else /* (defined __KLIBC__ || defined __MVS__), i.e. OS/2 or z/OS */ /* OS/2 kLIBC provides a function to retrieve a path from a fd. */ { - char dir[_MAX_PATH]; size_t bufsize; +# ifdef __KLIBC__ + char dir[_MAX_PATH]; if (__libc_Back_ioFHToPath (fd, dir, sizeof dir)) return NULL; +# endif +# ifdef __MVS__ + char dir[_XOPEN_PATH_MAX]; + /* Documentation: + https://www.ibm.com/docs/en/zos/2.2.0?topic=functions-w-ioctl-w-pioctl-control-devices */ + if (w_ioctl (fd, _IOCC_GPN, sizeof dir, dir) < 0) + return NULL; + /* Documentation: + https://www.ibm.com/docs/en/zos/2.2.0?topic=functions-e2a-l-convert-characters-from-ebcdic-ascii */ + dirlen = __e2a_l (dir, strlen (dir)); + if (dirlen < 0 || dirlen >= sizeof dir) + return NULL; + dir[dirlen] = '\0'; +# endif dirlen = strlen (dir); bufsize = dirlen + 1 + strlen (file) + 1; /* 1 for '/', 1 for null */ diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h index 17357810c7c..b616c100fdc 100644 --- a/lib/stdalign.in.h +++ b/lib/stdalign.in.h @@ -17,117 +17,33 @@ /* Written by Paul Eggert and Bruno Haible. */ -#ifndef _GL_STDALIGN_H -#define _GL_STDALIGN_H +/* Define two obsolescent C11 macros, assuming alignas and alignof are + either keywords or alignasof-defined macros. */ -/* ISO C11 for platforms that lack it. +#ifndef _@GUARD_PREFIX@_STDALIGN_H - References: - ISO C11 (latest free draft - ) - sections 6.5.3.4, 6.7.5, 7.15. - C++11 (latest free draft - ) - section 18.10. */ - -/* alignof (TYPE), also known as _Alignof (TYPE), yields the alignment - requirement of a structure member (i.e., slot or field) that is of - type TYPE, as an integer constant expression. - - This differs from GCC's and clang's __alignof__ operator, which can - yield a better-performing alignment for an object of that type. For - example, on x86 with GCC and on Linux/x86 with clang, - __alignof__ (double) and __alignof__ (long long) are 8, whereas - alignof (double) and alignof (long long) are 4 unless the option - '-malign-double' is used. - - The result cannot be used as a value for an 'enum' constant, if you - want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. */ - -/* FreeBSD 9.1 , included by and lots of other - standard headers, defines conflicting implementations of _Alignas - and _Alignof that are no better than ours; override them. */ -#undef _Alignas -#undef _Alignof - -/* GCC releases before GCC 4.9 had a bug in _Alignof. See GCC bug 52023 - . - clang versions < 8.0.0 have the same bug. */ -#if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \ - || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \ - && !defined __clang__) \ - || (defined __clang__ && __clang_major__ < 8)) -# ifdef __cplusplus -# if (201103 <= __cplusplus || defined _MSC_VER) -# define _Alignof(type) alignof (type) -# else - template struct __alignof_helper { char __a; __t __b; }; -# define _Alignof(type) offsetof (__alignof_helper, __b) -# define _GL_STDALIGN_NEEDS_STDDEF 1 -# endif -# else -# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b) -# define _GL_STDALIGN_NEEDS_STDDEF 1 -# endif +#if __GNUC__ >= 3 +@PRAGMA_SYSTEM_HEADER@ #endif -#if ! (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER)) -# define alignof _Alignof -#endif -#define __alignof_is_defined 1 - -/* alignas (A), also known as _Alignas (A), aligns a variable or type - to the alignment A, where A is an integer constant expression. For - example: - - int alignas (8) foo; - struct s { int a; int alignas (8) bar; }; +@PRAGMA_COLUMNS@ - aligns the address of FOO and the offset of BAR to be multiples of 8. - - A should be a power of two that is at least the type's alignment - and at most the implementation's alignment limit. This limit is - 2**28 on typical GNUish hosts, and 2**13 on MSVC. To be portable - to MSVC through at least version 10.0, A should be an integer - constant, as MSVC does not support expressions such as 1 << 3. - To be portable to Sun C 5.11, do not align auto variables to - anything stricter than their default alignment. - - The following C11 requirements are not supported here: - - - If A is zero, alignas has no effect. - - alignas can be used multiple times; the strictest one wins. - - alignas (TYPE) is equivalent to alignas (alignof (TYPE)). +/* We need to include the system's when it exists, because it might + define 'alignof' as a macro when it's not a keyword or compiler built-in. */ +#if @HAVE_STDALIGN_H@ +/* The include_next requires a split double-inclusion guard. */ +# @INCLUDE_NEXT@ @NEXT_STDALIGN_H@ +#endif - */ +#ifndef _@GUARD_PREFIX@_STDALIGN_H +#define _@GUARD_PREFIX@_STDALIGN_H -#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 -# if defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER) -# define _Alignas(a) alignas (a) -# elif (!defined __attribute__ \ - && ((defined __APPLE__ && defined __MACH__ \ - ? 4 < __GNUC__ + (1 <= __GNUC_MINOR__) \ - : __GNUC__ && !defined __ibmxl__) \ - || (4 <= __clang_major__) \ - || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \ - || __ICC || 0x590 <= __SUNPRO_C || 0x0600 <= __xlC__)) -# define _Alignas(a) __attribute__ ((__aligned__ (a))) -# elif 1300 <= _MSC_VER -# define _Alignas(a) __declspec (align (a)) -# endif -#endif -#if ((defined _Alignas \ - && !(defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) \ - || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__)) -# define alignas _Alignas -#endif #if (defined alignas \ + || (defined __STDC_VERSION__ && 202311 <= __STDC_VERSION__) \ || (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) # define __alignas_is_defined 1 #endif -/* Include if needed for offsetof. */ -#if _GL_STDALIGN_NEEDS_STDDEF -# include -#endif +#define __alignof_is_defined 1 -#endif /* _GL_STDALIGN_H */ +#endif /* _@GUARD_PREFIX@_STDALIGN_H */ +#endif /* _@GUARD_PREFIX@_STDALIGN_H */ diff --git a/lib/stdio-impl.h b/lib/stdio-impl.h index 81e7f838372..46608bed198 100644 --- a/lib/stdio-impl.h +++ b/lib/stdio-impl.h @@ -70,6 +70,12 @@ # define _gl_flags_file_t int # else # define _gl_flags_file_t short +# endif +# ifdef __LP64__ +# define _gl_file_offset_t int64_t +# else + /* see https://android.googlesource.com/platform/bionic/+/master/docs/32-bit-abi.md */ +# define _gl_file_offset_t __kernel_off_t # endif /* Up to this commit from 2015-10-12 @@ -96,7 +102,7 @@ unsigned char _nbuf[1]; \ struct { unsigned char *_base; size_t _size; } _lb; \ int _blksize; \ - fpos_t _offset; \ + _gl_file_offset_t _offset; \ /* More fields, not relevant here. */ \ } *) fp) # else diff --git a/lib/stdio.in.h b/lib/stdio.in.h index 8b5ef4bd2dd..3f8ea985335 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -210,7 +210,9 @@ _GL_FUNCDECL_SYS (dprintf, int, (int fd, const char *restrict format, ...) # endif _GL_CXXALIAS_SYS (dprintf, int, (int fd, const char *restrict format, ...)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (dprintf); +# endif #elif defined GNULIB_POSIXCHECK # undef dprintf # if HAVE_RAW_DECL_DPRINTF @@ -882,7 +884,9 @@ _GL_CXXALIAS_SYS (getdelim, ssize_t, int delimiter, FILE *restrict stream)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (getdelim); +# endif #elif defined GNULIB_POSIXCHECK # undef getdelim # if HAVE_RAW_DECL_GETDELIM @@ -921,7 +925,7 @@ _GL_CXXALIAS_SYS (getline, ssize_t, (char **restrict lineptr, size_t *restrict linesize, FILE *restrict stream)); # endif -# if @HAVE_DECL_GETLINE@ +# if __GLIBC__ >= 2 && @HAVE_DECL_GETLINE@ _GL_CXXALIASWARN (getline); # endif #elif defined GNULIB_POSIXCHECK diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index b79e5f70965..a91f4e23d67 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -164,11 +164,22 @@ #define _@GUARD_PREFIX@_STDLIB_H #if @GNULIB__EXIT@ /* Terminate the current process with the given return code, without running the 'atexit' handlers. */ -# if !@HAVE__EXIT@ +# if @REPLACE__EXIT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef _Exit +# define _Exit rpl__Exit +# endif +_GL_FUNCDECL_RPL (_Exit, _Noreturn void, (int status)); +_GL_CXXALIAS_RPL (_Exit, void, (int status)); +# else +# if !@HAVE__EXIT@ _GL_FUNCDECL_SYS (_Exit, _Noreturn void, (int status)); -# endif +# endif _GL_CXXALIAS_SYS (_Exit, void, (int status)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (_Exit); +# endif #elif defined GNULIB_POSIXCHECK # undef _Exit # if HAVE_RAW_DECL__EXIT @@ -416,12 +427,24 @@ _GL_CXXALIASWARN (gcvt); The three numbers are the load average of the last 1 minute, the last 5 minutes, and the last 15 minutes, respectively. LOADAVG is an array of NELEM numbers. */ -# if !@HAVE_DECL_GETLOADAVG@ +# if @REPLACE_GETLOADAVG@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef getloadavg +# define getloadavg rpl_getloadavg +# endif +_GL_FUNCDECL_RPL (getloadavg, int, (double loadavg[], int nelem) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (getloadavg, int, (double loadavg[], int nelem)); +# else +# if !@HAVE_DECL_GETLOADAVG@ _GL_FUNCDECL_SYS (getloadavg, int, (double loadavg[], int nelem) _GL_ARG_NONNULL ((1))); -# endif +# endif _GL_CXXALIAS_SYS (getloadavg, int, (double loadavg[], int nelem)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (getloadavg); +# endif #elif defined GNULIB_POSIXCHECK # undef getloadavg # if HAVE_RAW_DECL_GETLOADAVG @@ -430,6 +453,41 @@ _GL_WARN_ON_USE (getloadavg, "getloadavg is not portable - " # endif #endif +#if @GNULIB_GETPROGNAME@ +/* Return the base name of the executing program. + On native Windows this will usually end in ".exe" or ".EXE". */ +# if @REPLACE_GETPROGNAME@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef getprogname +# define getprogname rpl_getprogname +# endif +# ifdef HAVE_DECL_PROGRAM_INVOCATION_NAME +_GL_FUNCDECL_RPL (getprogname, const char *, (void) _GL_ATTRIBUTE_PURE); +# else +_GL_FUNCDECL_RPL (getprogname, const char *, (void)); +# endif +_GL_CXXALIAS_RPL (getprogname, const char *, (void)); +# else +# if !@HAVE_GETPROGNAME@ +# ifdef HAVE_DECL_PROGRAM_INVOCATION_NAME +_GL_FUNCDECL_SYS (getprogname, const char *, (void) _GL_ATTRIBUTE_PURE); +# else +_GL_FUNCDECL_SYS (getprogname, const char *, (void)); +# endif +# endif +_GL_CXXALIAS_SYS (getprogname, const char *, (void)); +# endif +# if __GLIBC__ >= 2 +_GL_CXXALIASWARN (getprogname); +# endif +#elif defined GNULIB_POSIXCHECK +# undef getprogname +# if HAVE_RAW_DECL_GETPROGNAME +_GL_WARN_ON_USE (getprogname, "getprogname is unportable - " + "use gnulib module getprogname for portability"); +# endif +#endif + #if @GNULIB_GETSUBOPT@ /* Assuming *OPTIONP is a comma separated list of elements of the form "token" or "token=value", getsubopt parses the first of these elements. @@ -442,14 +500,28 @@ _GL_WARN_ON_USE (getloadavg, "getloadavg is not portable - " Otherwise it returns -1, and *OPTIONP and *VALUEP are undefined. For more details see the POSIX specification. https://pubs.opengroup.org/onlinepubs/9699919799/functions/getsubopt.html */ -# if !@HAVE_GETSUBOPT@ +# if @REPLACE_GETSUBOPT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef getsubopt +# define getsubopt rpl_getsubopt +# endif +_GL_FUNCDECL_RPL (getsubopt, int, + (char **optionp, char *const *tokens, char **valuep) + _GL_ARG_NONNULL ((1, 2, 3))); +_GL_CXXALIAS_RPL (getsubopt, int, + (char **optionp, char *const *tokens, char **valuep)); +# else +# if !@HAVE_GETSUBOPT@ _GL_FUNCDECL_SYS (getsubopt, int, (char **optionp, char *const *tokens, char **valuep) _GL_ARG_NONNULL ((1, 2, 3))); -# endif +# endif _GL_CXXALIAS_SYS (getsubopt, int, (char **optionp, char *const *tokens, char **valuep)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (getsubopt); +# endif #elif defined GNULIB_POSIXCHECK # undef getsubopt # if HAVE_RAW_DECL_GETSUBOPT @@ -579,12 +651,24 @@ _GL_WARN_ON_USE (mkdtemp, "mkdtemp is unportable - " implementation. Returns the open file descriptor if successful, otherwise -1 and errno set. */ -# if !@HAVE_MKOSTEMP@ +# if @REPLACE_MKOSTEMP@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef mkostemp +# define mkostemp rpl_mkostemp +# endif +_GL_FUNCDECL_RPL (mkostemp, int, (char * /*template*/, int /*flags*/) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (mkostemp, int, (char * /*template*/, int /*flags*/)); +# else +# if !@HAVE_MKOSTEMP@ _GL_FUNCDECL_SYS (mkostemp, int, (char * /*template*/, int /*flags*/) _GL_ARG_NONNULL ((1))); -# endif +# endif _GL_CXXALIAS_SYS (mkostemp, int, (char * /*template*/, int /*flags*/)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (mkostemp); +# endif #elif defined GNULIB_POSIXCHECK # undef mkostemp # if HAVE_RAW_DECL_MKOSTEMP @@ -607,14 +691,28 @@ _GL_WARN_ON_USE (mkostemp, "mkostemp is unportable - " implementation. Returns the open file descriptor if successful, otherwise -1 and errno set. */ -# if !@HAVE_MKOSTEMPS@ +# if @REPLACE_MKOSTEMPS@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef mkostemps +# define mkostemps rpl_mkostemps +# endif +_GL_FUNCDECL_RPL (mkostemps, int, + (char * /*template*/, int /*suffixlen*/, int /*flags*/) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (mkostemps, int, + (char * /*template*/, int /*suffixlen*/, int /*flags*/)); +# else +# if !@HAVE_MKOSTEMPS@ _GL_FUNCDECL_SYS (mkostemps, int, (char * /*template*/, int /*suffixlen*/, int /*flags*/) _GL_ARG_NONNULL ((1))); -# endif +# endif _GL_CXXALIAS_SYS (mkostemps, int, (char * /*template*/, int /*suffixlen*/, int /*flags*/)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (mkostemps); +# endif #elif defined GNULIB_POSIXCHECK # undef mkostemps # if HAVE_RAW_DECL_MKOSTEMPS @@ -713,7 +811,7 @@ _GL_CXXALIAS_SYS (posix_memalign, int, (void **memptr, size_t alignment, size_t size)); # endif # endif -# if @HAVE_POSIX_MEMALIGN@ +# if __GLIBC__ >= 2 && @HAVE_POSIX_MEMALIGN@ _GL_CXXALIASWARN (posix_memalign); # endif #elif defined GNULIB_POSIXCHECK @@ -727,11 +825,22 @@ _GL_WARN_ON_USE (posix_memalign, "posix_memalign is not portable - " #if @GNULIB_POSIX_OPENPT@ /* Return an FD open to the master side of a pseudo-terminal. Flags should include O_RDWR, and may also include O_NOCTTY. */ -# if !@HAVE_POSIX_OPENPT@ +# if @REPLACE_POSIX_OPENPT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef posix_openpt +# define posix_openpt rpl_posix_openpt +# endif +_GL_FUNCDECL_RPL (posix_openpt, int, (int flags)); +_GL_CXXALIAS_RPL (posix_openpt, int, (int flags)); +# else +# if !@HAVE_POSIX_OPENPT@ _GL_FUNCDECL_SYS (posix_openpt, int, (int flags)); -# endif +# endif _GL_CXXALIAS_SYS (posix_openpt, int, (int flags)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (posix_openpt); +# endif #elif defined GNULIB_POSIXCHECK # undef posix_openpt # if HAVE_RAW_DECL_POSIX_OPENPT @@ -956,7 +1065,9 @@ _GL_FUNCDECL_SYS (initstate, char *, _GL_CXXALIAS_SYS_CAST (initstate, char *, (unsigned int seed, char *buf, size_t buf_size)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (initstate); +# endif #elif defined GNULIB_POSIXCHECK # undef initstate # if HAVE_RAW_DECL_INITSTATE @@ -981,7 +1092,9 @@ _GL_FUNCDECL_SYS (setstate, char *, (char *arg_state) _GL_ARG_NONNULL ((1))); is const char *arg_state. */ _GL_CXXALIAS_SYS_CAST (setstate, char *, (char *arg_state)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (setstate); +# endif #elif defined GNULIB_POSIXCHECK # undef setstate # if HAVE_RAW_DECL_SETSTATE @@ -1167,7 +1280,9 @@ _GL_FUNCDECL_SYS (reallocarray, void *, _GL_CXXALIAS_SYS (reallocarray, void *, (void *ptr, size_t nmemb, size_t size)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (reallocarray); +# endif #elif defined GNULIB_POSIXCHECK # undef reallocarray # if HAVE_RAW_DECL_REALLOCARRAY diff --git a/lib/string.in.h b/lib/string.in.h index b227a178873..aa088213927 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -308,16 +308,32 @@ _GL_WARN_ON_USE (memmem, "memmem is unportable and often quadratic - " /* Copy N bytes of SRC to DEST, return pointer to bytes after the last written byte. */ #if @GNULIB_MEMPCPY@ -# if ! @HAVE_MEMPCPY@ +# if @REPLACE_MEMPCPY@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef mempcpy +# define mempcpy rpl_mempcpy +# endif +_GL_FUNCDECL_RPL (mempcpy, void *, + (void *restrict __dest, void const *restrict __src, + size_t __n) + _GL_ARG_NONNULL ((1, 2))); +_GL_CXXALIAS_RPL (mempcpy, void *, + (void *restrict __dest, void const *restrict __src, + size_t __n)); +# else +# if !@HAVE_MEMPCPY@ _GL_FUNCDECL_SYS (mempcpy, void *, (void *restrict __dest, void const *restrict __src, size_t __n) _GL_ARG_NONNULL ((1, 2))); -# endif +# endif _GL_CXXALIAS_SYS (mempcpy, void *, (void *restrict __dest, void const *restrict __src, size_t __n)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (mempcpy); +# endif #elif defined GNULIB_POSIXCHECK # undef mempcpy # if HAVE_RAW_DECL_MEMPCPY @@ -406,14 +422,28 @@ _GL_WARN_ON_USE (rawmemchr, "rawmemchr is unportable - " /* Copy SRC to DST, returning the address of the terminating '\0' in DST. */ #if @GNULIB_STPCPY@ -# if ! @HAVE_STPCPY@ +# if @REPLACE_STPCPY@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef stpcpy +# define stpcpy rpl_stpcpy +# endif +_GL_FUNCDECL_RPL (stpcpy, char *, + (char *restrict __dst, char const *restrict __src) + _GL_ARG_NONNULL ((1, 2))); +_GL_CXXALIAS_RPL (stpcpy, char *, + (char *restrict __dst, char const *restrict __src)); +# else +# if !@HAVE_STPCPY@ _GL_FUNCDECL_SYS (stpcpy, char *, (char *restrict __dst, char const *restrict __src) _GL_ARG_NONNULL ((1, 2))); -# endif +# endif _GL_CXXALIAS_SYS (stpcpy, char *, (char *restrict __dst, char const *restrict __src)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (stpcpy); +# endif #elif defined GNULIB_POSIXCHECK # undef stpcpy # if HAVE_RAW_DECL_STPCPY @@ -448,7 +478,9 @@ _GL_CXXALIAS_SYS (stpncpy, char *, (char *restrict __dst, char const *restrict __src, size_t __n)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (stpncpy); +# endif #elif defined GNULIB_POSIXCHECK # undef stpncpy # if HAVE_RAW_DECL_STPNCPY @@ -1212,7 +1244,7 @@ _GL_FUNCDECL_SYS (strerror_r, int, (int errnum, char *buf, size_t buflen) # endif _GL_CXXALIAS_SYS (strerror_r, int, (int errnum, char *buf, size_t buflen)); # endif -# if @HAVE_DECL_STRERROR_R@ +# if __GLIBC__ >= 2 && @HAVE_DECL_STRERROR_R@ _GL_CXXALIASWARN (strerror_r); # endif #elif defined GNULIB_POSIXCHECK diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h index 096887c0162..0c2f39c12bf 100644 --- a/lib/sys_stat.in.h +++ b/lib/sys_stat.in.h @@ -549,7 +549,7 @@ _GL_FUNCDECL_SYS (futimens, int, (int fd, struct timespec const times[2])); # endif _GL_CXXALIAS_SYS (futimens, int, (int fd, struct timespec const times[2])); # endif -# if @HAVE_FUTIMENS@ +# if __GLIBC__ >= 2 && @HAVE_FUTIMENS@ _GL_CXXALIASWARN (futimens); # endif #elif defined GNULIB_POSIXCHECK @@ -716,7 +716,9 @@ _GL_FUNCDECL_SYS (mkfifoat, int, (int fd, char const *file, mode_t mode) # endif _GL_CXXALIAS_SYS (mkfifoat, int, (int fd, char const *file, mode_t mode)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (mkfifoat); +# endif #elif defined GNULIB_POSIXCHECK # undef mkfifoat # if HAVE_RAW_DECL_MKFIFOAT @@ -773,7 +775,9 @@ _GL_FUNCDECL_SYS (mknodat, int, _GL_CXXALIAS_SYS (mknodat, int, (int fd, char const *file, mode_t mode, dev_t dev)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (mknodat); +# endif #elif defined GNULIB_POSIXCHECK # undef mknodat # if HAVE_RAW_DECL_MKNODAT @@ -937,7 +941,7 @@ _GL_FUNCDECL_SYS (utimensat, int, (int fd, char const *name, _GL_CXXALIAS_SYS (utimensat, int, (int fd, char const *name, struct timespec const times[2], int flag)); # endif -# if @HAVE_UTIMENSAT@ +# if __GLIBC__ >= 2 && @HAVE_UTIMENSAT@ _GL_CXXALIASWARN (utimensat); # endif #elif defined GNULIB_POSIXCHECK diff --git a/lib/time.in.h b/lib/time.in.h index 50c9b30b6b3..87cda21413b 100644 --- a/lib/time.in.h +++ b/lib/time.in.h @@ -112,12 +112,24 @@ /* Set *TS to the current time, and return BASE. Upon failure, return 0. */ # if @GNULIB_TIMESPEC_GET@ -# if ! @HAVE_TIMESPEC_GET@ +# if @REPLACE_TIMESPEC_GET@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef timespec_get +# define timespec_get rpl_timespec_get +# endif +_GL_FUNCDECL_RPL (timespec_get, int, (struct timespec *ts, int base) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (timespec_get, int, (struct timespec *ts, int base)); +# else +# if !@HAVE_TIMESPEC_GET@ _GL_FUNCDECL_SYS (timespec_get, int, (struct timespec *ts, int base) _GL_ARG_NONNULL ((1))); -# endif +# endif _GL_CXXALIAS_SYS (timespec_get, int, (struct timespec *ts, int base)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (timespec_get); +# endif # endif /* Set *TS to the current time resolution, and return BASE. @@ -423,7 +435,9 @@ _GL_FUNCDECL_SYS (timegm, time_t, (struct tm *__tm) _GL_ARG_NONNULL ((1))); # endif _GL_CXXALIAS_SYS (timegm, time_t, (struct tm *__tm)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (timegm); +# endif # endif /* Encourage applications to avoid unsafe functions that can overrun diff --git a/lib/unistd.in.h b/lib/unistd.in.h index 4812fdb1120..bfc501e5a7d 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -541,17 +541,22 @@ _GL_CXXALIASWARN (dup2); Return newfd if successful, otherwise -1 and errno set. See the Linux man page at . */ -# if @HAVE_DUP3@ +# if @REPLACE_DUP3@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef dup3 # define dup3 rpl_dup3 # endif _GL_FUNCDECL_RPL (dup3, int, (int oldfd, int newfd, int flags)); _GL_CXXALIAS_RPL (dup3, int, (int oldfd, int newfd, int flags)); # else +# if !@HAVE_DUP3@ _GL_FUNCDECL_SYS (dup3, int, (int oldfd, int newfd, int flags)); +# endif _GL_CXXALIAS_SYS (dup3, int, (int oldfd, int newfd, int flags)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (dup3); +# endif #elif defined GNULIB_POSIXCHECK # undef dup3 # if HAVE_RAW_DECL_DUP3 @@ -870,7 +875,9 @@ _GL_FUNCDECL_SYS (execvpe, int, _GL_CXXALIAS_SYS (execvpe, int, (const char *program, char * const *argv, char * const *env)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (execvpe); +# endif #elif defined GNULIB_POSIXCHECK # undef execvpe # if HAVE_RAW_DECL_EXECVPE @@ -925,7 +932,9 @@ _GL_FUNCDECL_SYS (faccessat, int, _GL_CXXALIAS_SYS (faccessat, int, (int fd, char const *file, int mode, int flag)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (faccessat); +# endif #elif defined GNULIB_POSIXCHECK # undef faccessat # if HAVE_RAW_DECL_FACCESSAT @@ -1002,11 +1011,22 @@ _GL_WARN_ON_USE (fchownat, "fchownat is not portable - " Return 0 if successful, otherwise -1 and errno set. See POSIX:2008 specification . */ -# if !@HAVE_FDATASYNC@ || !@HAVE_DECL_FDATASYNC@ +# if @REPLACE_FDATASYNC@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef fdatasync +# define fdatasync rpl_fdatasync +# endif +_GL_FUNCDECL_RPL (fdatasync, int, (int fd)); +_GL_CXXALIAS_RPL (fdatasync, int, (int fd)); +# else +# if !@HAVE_FDATASYNC@|| !@HAVE_DECL_FDATASYNC@ _GL_FUNCDECL_SYS (fdatasync, int, (int fd)); -# endif +# endif _GL_CXXALIAS_SYS (fdatasync, int, (int fd)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (fdatasync); +# endif #elif defined GNULIB_POSIXCHECK # undef fdatasync # if HAVE_RAW_DECL_FDATASYNC @@ -1053,7 +1073,9 @@ _GL_FUNCDECL_SYS (ftruncate, int, (int fd, off_t length)); # endif _GL_CXXALIAS_SYS (ftruncate, int, (int fd, off_t length)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (ftruncate); +# endif #elif defined GNULIB_POSIXCHECK # undef ftruncate # if HAVE_RAW_DECL_FTRUNCATE @@ -1185,11 +1207,22 @@ _GL_WARN_ON_USE (getdtablesize, "getdtablesize is unportable - " #if @GNULIB_GETENTROPY@ /* Fill a buffer with random bytes. */ -# if !@HAVE_GETENTROPY@ +# if @REPLACE_GETENTROPY@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef getentropy +# define getentropy rpl_getentropy +# endif +_GL_FUNCDECL_RPL (getentropy, int, (void *buffer, size_t length)); +_GL_CXXALIAS_RPL (getentropy, int, (void *buffer, size_t length)); +# else +# if !@HAVE_GETENTROPY@ _GL_FUNCDECL_SYS (getentropy, int, (void *buffer, size_t length)); -# endif +# endif _GL_CXXALIAS_SYS (getentropy, int, (void *buffer, size_t length)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (getentropy); +# endif #elif defined GNULIB_POSIXCHECK # undef getentropy # if HAVE_RAW_DECL_GETENTROPY @@ -1323,7 +1356,9 @@ _GL_FUNCDECL_SYS (getlogin_r, int, (char *name, size_t size) int size. */ _GL_CXXALIAS_SYS_CAST (getlogin_r, int, (char *name, size_t size)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (getlogin_r); +# endif #elif defined GNULIB_POSIXCHECK # undef getlogin_r # if HAVE_RAW_DECL_GETLOGIN_R @@ -1661,7 +1696,9 @@ _GL_CXXALIAS_SYS (linkat, int, (int fd1, const char *path1, int fd2, const char *path2, int flag)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (linkat); +# endif #elif defined GNULIB_POSIXCHECK # undef linkat # if HAVE_RAW_DECL_LINKAT @@ -1742,8 +1779,9 @@ _GL_WARN_ON_USE (pipe, "pipe is unportable - " Return 0 upon success, or -1 with errno set upon failure. See also the Linux man page at . */ -# if @HAVE_PIPE2@ +# if @REPLACE_PIPE2@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef pipe2 # define pipe2 rpl_pipe2 # endif _GL_FUNCDECL_RPL (pipe2, int, (int fd[2], int flags) _GL_ARG_NONNULL ((1))); @@ -1752,7 +1790,9 @@ _GL_CXXALIAS_RPL (pipe2, int, (int fd[2], int flags)); _GL_FUNCDECL_SYS (pipe2, int, (int fd[2], int flags) _GL_ARG_NONNULL ((1))); _GL_CXXALIAS_SYS (pipe2, int, (int fd[2], int flags)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (pipe2); +# endif #elif defined GNULIB_POSIXCHECK # undef pipe2 # if HAVE_RAW_DECL_PIPE2 @@ -1787,7 +1827,9 @@ _GL_FUNCDECL_SYS (pread, ssize_t, _GL_CXXALIAS_SYS (pread, ssize_t, (int fd, void *buf, size_t bufsize, off_t offset)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (pread); +# endif #elif defined GNULIB_POSIXCHECK # undef pread # if HAVE_RAW_DECL_PREAD @@ -1822,7 +1864,9 @@ _GL_FUNCDECL_SYS (pwrite, ssize_t, _GL_CXXALIAS_SYS (pwrite, ssize_t, (int fd, const void *buf, size_t bufsize, off_t offset)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (pwrite); +# endif #elif defined GNULIB_POSIXCHECK # undef pwrite # if HAVE_RAW_DECL_PWRITE @@ -1936,7 +1980,9 @@ _GL_CXXALIAS_SYS (readlinkat, ssize_t, (int fd, char const *restrict file, char *restrict buf, size_t len)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (readlinkat); +# endif #elif defined GNULIB_POSIXCHECK # undef readlinkat # if HAVE_RAW_DECL_READLINKAT @@ -1996,15 +2042,27 @@ _GL_CXXALIASWARN (rmdir); Platforms with no ability to set the hostname return -1 and set errno = ENOSYS. */ -# if !@HAVE_SETHOSTNAME@ || !@HAVE_DECL_SETHOSTNAME@ +# if @REPLACE_SETHOSTNAME@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef sethostname +# define sethostname rpl_sethostname +# endif +_GL_FUNCDECL_RPL (sethostname, int, (const char *name, size_t len) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (sethostname, int, (const char *name, size_t len)); +# else +# if !@HAVE_SETHOSTNAME@ || !@HAVE_DECL_SETHOSTNAME@ _GL_FUNCDECL_SYS (sethostname, int, (const char *name, size_t len) _GL_ARG_NONNULL ((1))); -# endif +# endif /* Need to cast, because on Solaris 11 2011-10, Mac OS X 10.5, IRIX 6.5 and FreeBSD 6.4 the second parameter is int. On Solaris 11 2011-10, the first parameter is not const. */ _GL_CXXALIAS_SYS_CAST (sethostname, int, (const char *name, size_t len)); +# endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (sethostname); +# endif #elif defined GNULIB_POSIXCHECK # undef sethostname # if HAVE_RAW_DECL_SETHOSTNAME @@ -2113,7 +2171,9 @@ _GL_FUNCDECL_SYS (symlinkat, int, _GL_CXXALIAS_SYS (symlinkat, int, (char const *contents, int fd, char const *file)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (symlinkat); +# endif #elif defined GNULIB_POSIXCHECK # undef symlinkat # if HAVE_RAW_DECL_SYMLINKAT @@ -2143,7 +2203,9 @@ _GL_FUNCDECL_SYS (truncate, int, (const char *filename, off_t length) # endif _GL_CXXALIAS_SYS (truncate, int, (const char *filename, off_t length)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (truncate); +# endif #elif defined GNULIB_POSIXCHECK # undef truncate # if HAVE_RAW_DECL_TRUNCATE @@ -2173,7 +2235,9 @@ _GL_FUNCDECL_SYS (ttyname_r, int, _GL_CXXALIAS_SYS (ttyname_r, int, (int fd, char *buf, size_t buflen)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (ttyname_r); +# endif #elif defined GNULIB_POSIXCHECK # undef ttyname_r # if HAVE_RAW_DECL_TTYNAME_R diff --git a/lib/verify.h b/lib/verify.h index b63cb264321..8f786af7f5a 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -222,7 +222,21 @@ #define _GL_VERIFY_TRUE(R, DIAGNOSTIC) \ /* _GL_STATIC_ASSERT_H is defined if this code is copied into assert.h. */ #ifdef _GL_STATIC_ASSERT_H -# if !defined _GL_HAVE__STATIC_ASSERT1 && !defined _Static_assert +/* Define _Static_assert if needed. */ +/* With clang ≥ 3.8.0 in C++ mode, _Static_assert already works and accepts + 1 or 2 arguments. We better don't override it, because clang's standard + C++ library uses static_assert inside classes in several places, and our + replacement via _GL_VERIFY does not work in these contexts. */ +# if (defined __cplusplus && defined __clang__ \ + && (4 <= __clang_major__ + (8 <= __clang_minor__))) +# if 5 <= __clang_major__ +/* Avoid "warning: 'static_assert' with no message is a C++17 extension". */ +# pragma clang diagnostic ignored "-Wc++17-extensions" +# else +/* Avoid "warning: static_assert with no message is a C++1z extension". */ +# pragma clang diagnostic ignored "-Wc++1z-extensions" +# endif +# elif !defined _GL_HAVE__STATIC_ASSERT1 && !defined _Static_assert # if !defined _MSC_VER || defined __clang__ # define _Static_assert(...) \ _GL_VERIFY (__VA_ARGS__, "static assertion failed", -) @@ -233,6 +247,7 @@ #define _GL_VERIFY_TRUE(R, DIAGNOSTIC) \ _GL_VERIFY ((R), "static assertion failed", -) # endif # endif +/* Define static_assert if needed. */ # if (!defined static_assert \ && __STDC_VERSION__ < 202311 \ && (!defined __cplusplus \ diff --git a/m4/canonicalize.m4 b/m4/canonicalize.m4 index 03cb0aec93f..d319645fd3f 100644 --- a/m4/canonicalize.m4 +++ b/m4/canonicalize.m4 @@ -1,4 +1,4 @@ -# canonicalize.m4 serial 37 +# canonicalize.m4 serial 38 dnl Copyright (C) 2003-2007, 2009-2023 Free Software Foundation, Inc. @@ -12,7 +12,8 @@ AC_DEFUN [ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK]) - AC_CHECK_FUNCS_ONCE([canonicalize_file_name faccessat]) + AC_CHECK_FUNCS_ONCE([canonicalize_file_name]) + gl_CHECK_FUNCS_ANDROID([faccessat], [[#include ]]) AC_REQUIRE([gl_DOUBLE_SLASH_ROOT]) AC_REQUIRE([gl_FUNC_REALPATH_WORKS]) if test $ac_cv_func_canonicalize_file_name = no; then @@ -58,7 +59,8 @@ AC_DEFUN [ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK]) - AC_CHECK_FUNCS_ONCE([canonicalize_file_name faccessat]) + AC_CHECK_FUNCS_ONCE([canonicalize_file_name]) + gl_CHECK_FUNCS_ANDROID([faccessat], [[#include ]]) dnl On native Windows, we use _getcwd(), regardless whether getcwd() is dnl available through the linker option '-loldnames'. diff --git a/m4/euidaccess.m4 b/m4/euidaccess.m4 index f0eb5bde84a..7429779c152 100644 --- a/m4/euidaccess.m4 +++ b/m4/euidaccess.m4 @@ -1,4 +1,4 @@ -# euidaccess.m4 serial 16 +# euidaccess.m4 serial 17 dnl Copyright (C) 2002-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -32,7 +32,7 @@ AC_DEFUN # Prerequisites of lib/euidaccess.c. AC_DEFUN([gl_PREREQ_EUIDACCESS], [ dnl Prefer POSIX faccessat over non-standard euidaccess. - AC_CHECK_FUNCS_ONCE([faccessat]) + gl_CHECK_FUNCS_ANDROID([faccessat], [[#include ]]) dnl Try various other non-standard fallbacks. AC_CHECK_HEADERS([libgen.h]) AC_FUNC_GETGROUPS diff --git a/m4/faccessat.m4 b/m4/faccessat.m4 index 934c1f41546..a858bfee33d 100644 --- a/m4/faccessat.m4 +++ b/m4/faccessat.m4 @@ -1,4 +1,4 @@ -# serial 10 +# serial 12 # See if we need to provide faccessat replacement. dnl Copyright (C) 2009-2023 Free Software Foundation, Inc. @@ -16,9 +16,12 @@ AC_DEFUN dnl Persuade glibc to declare faccessat(). AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_FUNCS_ONCE([faccessat]) + gl_CHECK_FUNCS_ANDROID([faccessat], [[#include ]]) if test $ac_cv_func_faccessat = no; then HAVE_FACCESSAT=0 + case "$gl_cv_onwards_func_faccessat" in + future*) REPLACE_FACCESSAT=1 ;; + esac else case $gl_cv_func_lstat_dereferences_slashed_symlink in *yes) ;; diff --git a/m4/fchmodat.m4 b/m4/fchmodat.m4 index 7a3ee863e3c..5356da40bae 100644 --- a/m4/fchmodat.m4 +++ b/m4/fchmodat.m4 @@ -1,4 +1,4 @@ -# fchmodat.m4 serial 7 +# fchmodat.m4 serial 8 dnl Copyright (C) 2004-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -97,6 +97,6 @@ AC_DEFUN # Prerequisites of lib/fchmodat.c. AC_DEFUN([gl_PREREQ_FCHMODAT], [ - AC_CHECK_FUNCS_ONCE([readlinkat]) + gl_CHECK_FUNCS_ANDROID([readlinkat], [[#include ]]) : ]) diff --git a/m4/futimens.m4 b/m4/futimens.m4 index 3aaa10a0b52..dc0b21b9d51 100644 --- a/m4/futimens.m4 +++ b/m4/futimens.m4 @@ -1,4 +1,4 @@ -# serial 9 +# serial 11 # See if we need to provide futimens replacement. dnl Copyright (C) 2009-2023 Free Software Foundation, Inc. @@ -13,9 +13,12 @@ AC_DEFUN AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS]) AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_FUNCS_ONCE([futimens]) + gl_CHECK_FUNCS_ANDROID([futimens], [[#include ]]) if test $ac_cv_func_futimens = no; then HAVE_FUTIMENS=0 + case "$gl_cv_onwards_func_futimens" in + future*) REPLACE_FUTIMENS=1 ;; + esac else AC_CACHE_CHECK([whether futimens works], [gl_cv_func_futimens_works], diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4 index 79e420baae8..ee83b32f1e0 100644 --- a/m4/getloadavg.m4 +++ b/m4/getloadavg.m4 @@ -7,7 +7,7 @@ # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. -#serial 10 +#serial 12 # Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent. # New applications should use gl_GETLOADAVG instead. @@ -25,8 +25,13 @@ AC_DEFUN # getloadavg is present in libc on glibc >= 2.2, Mac OS X, FreeBSD >= 2.0, # NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7. HAVE_GETLOADAVG=1 -AC_CHECK_FUNC([getloadavg], [], - [gl_func_getloadavg_done=no +gl_CHECK_FUNCS_ANDROID([getloadavg], [[#include ]]) +if test $ac_cv_func_getloadavg != yes; then + case "$gl_cv_onwards_func_getloadavg" in + future*) REPLACE_GETLOADAVG=1 ;; + esac + + gl_func_getloadavg_done=no # Some systems with -lutil have (and need) -lkvm as well, some do not. # On Solaris, -lkvm requires nlist from -lelf, so check that first @@ -73,7 +78,8 @@ AC_DEFUN AC_DEFINE([DGUX], [1], [Define to 1 for DGUX with .]) AC_CHECK_LIB([dgc], [dg_sys_info])]) fi - fi]) + fi +fi if test "x$gl_save_LIBS" = x; then GETLOADAVG_LIBS=$LIBS diff --git a/m4/getrandom.m4 b/m4/getrandom.m4 index c508f1a55c3..7b7f9ce2ee8 100644 --- a/m4/getrandom.m4 +++ b/m4/getrandom.m4 @@ -1,4 +1,4 @@ -# getrandom.m4 serial 10 +# getrandom.m4 serial 11 dnl Copyright 2020-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -18,6 +18,9 @@ AC_DEFUN ]]) if test "$ac_cv_func_getrandom" != yes; then HAVE_GETRANDOM=0 + case "$gl_cv_onwards_func_getrandom" in + future*) REPLACE_GETRANDOM=1 ;; + esac else dnl On Solaris 11.4 the return type is 'int', not 'ssize_t'. AC_CACHE_CHECK([whether getrandom is compatible with its GNU+BSD signature], diff --git a/m4/gettime.m4 b/m4/gettime.m4 index 7e353fcd00e..ec1f97ee0d5 100644 --- a/m4/gettime.m4 +++ b/m4/gettime.m4 @@ -1,4 +1,4 @@ -# gettime.m4 serial 13 +# gettime.m4 serial 14 dnl Copyright (C) 2002, 2004-2006, 2009-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -18,9 +18,11 @@ AC_DEFUN ]) dnl Tests whether the function timespec_get exists. -dnl Sets gl_cv_func_timespec_get. +dnl Sets gl_cv_func_timespec_get and gl_cv_onwards_func_timespec_get. AC_DEFUN([gl_CHECK_FUNC_TIMESPEC_GET], [ + AC_REQUIRE([AC_CANONICAL_HOST]) + dnl Persuade OpenBSD to declare timespec_get(). AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) @@ -29,21 +31,32 @@ AC_DEFUN dnl But at the same time, we need to notice a missing declaration, like dnl gl_CHECK_FUNCS_ANDROID does. AC_CHECK_DECL([timespec_get], , , [[#include ]]) - if test $ac_cv_have_decl_timespec_get = yes; then - AC_CACHE_CHECK([for timespec_get], [gl_cv_func_timespec_get], - [AC_LINK_IFELSE( + AC_CACHE_CHECK([for timespec_get], [gl_cv_onwards_func_timespec_get], + [if test $ac_cv_have_decl_timespec_get = yes; then + AC_LINK_IFELSE( [AC_LANG_PROGRAM( [[#include struct timespec ts; ]], [[return timespec_get (&ts, 0);]]) ], - [gl_cv_func_timespec_get=yes], - [gl_cv_func_timespec_get=no]) - ]) - else - gl_cv_func_timespec_get=no - fi + [gl_cv_onwards_func_timespec_get=yes], + [gl_cv_onwards_func_timespec_get=no]) + else + gl_cv_onwards_func_timespec_get=no + fi + case "$host_os" in + linux*-android*) + if test $gl_cv_onwards_func_timespec_get = no; then + gl_cv_onwards_func_timespec_get='future OS version' + fi + ;; + esac + ]) + case "$gl_cv_onwards_func_timespec_get" in + future*) gl_cv_func_timespec_get=no ;; + *) gl_cv_func_timespec_get=$gl_cv_onwards_func_timespec_get ;; + esac ]) AC_DEFUN([gl_GETTIME_RES], diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 2db3376b01e..c0181abdc50 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 76 +# gnulib-common.m4 serial 80 dnl Copyright (C) 2007-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -38,6 +38,11 @@ AC_DEFUN AIX system header files and several gnulib header files use precisely this syntax with 'extern'. */ # define _Noreturn [[noreturn]] +# elif (defined __clang__ && __clang_major__ < 16 \ + && defined _GL_WORK_AROUND_LLVM_BUG_59792) + /* Compile with -D_GL_WORK_AROUND_LLVM_BUG_59792 to work around + that rare LLVM bug, though you may get many false-alarm warnings. */ +# define _Noreturn # elif ((!defined __cplusplus || defined __clang__) \ && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \ || (!defined __STRICT_ANSI__ \ @@ -119,29 +124,35 @@ AC_DEFUN by the Nth argument of the function is the size of the returned memory block. */ /* Applies to: function, pointer to function, function types. */ -#if _GL_HAS_ATTRIBUTE (alloc_size) -# define _GL_ATTRIBUTE_ALLOC_SIZE(args) __attribute__ ((__alloc_size__ args)) -#else -# define _GL_ATTRIBUTE_ALLOC_SIZE(args) +#ifndef _GL_ATTRIBUTE_ALLOC_SIZE +# if _GL_HAS_ATTRIBUTE (alloc_size) +# define _GL_ATTRIBUTE_ALLOC_SIZE(args) __attribute__ ((__alloc_size__ args)) +# else +# define _GL_ATTRIBUTE_ALLOC_SIZE(args) +# endif #endif /* _GL_ATTRIBUTE_ALWAYS_INLINE tells that the compiler should always inline the function and report an error if it cannot do so. */ /* Applies to: function. */ -#if _GL_HAS_ATTRIBUTE (always_inline) -# define _GL_ATTRIBUTE_ALWAYS_INLINE __attribute__ ((__always_inline__)) -#else -# define _GL_ATTRIBUTE_ALWAYS_INLINE +#ifndef _GL_ATTRIBUTE_ALWAYS_INLINE +# if _GL_HAS_ATTRIBUTE (always_inline) +# define _GL_ATTRIBUTE_ALWAYS_INLINE __attribute__ ((__always_inline__)) +# else +# define _GL_ATTRIBUTE_ALWAYS_INLINE +# endif #endif /* _GL_ATTRIBUTE_ARTIFICIAL declares that the function is not important to show in stack traces when debugging. The compiler should omit the function from stack traces. */ /* Applies to: function. */ -#if _GL_HAS_ATTRIBUTE (artificial) -# define _GL_ATTRIBUTE_ARTIFICIAL __attribute__ ((__artificial__)) -#else -# define _GL_ATTRIBUTE_ARTIFICIAL +#ifndef _GL_ATTRIBUTE_ARTIFICIAL +# if _GL_HAS_ATTRIBUTE (artificial) +# define _GL_ATTRIBUTE_ARTIFICIAL __attribute__ ((__artificial__)) +# else +# define _GL_ATTRIBUTE_ARTIFICIAL +# endif #endif /* _GL_ATTRIBUTE_COLD declares that the function is rarely executed. */ @@ -149,14 +160,16 @@ AC_DEFUN /* Avoid __attribute__ ((cold)) on MinGW; see thread starting at . Also, Oracle Studio 12.6 requires 'cold' not '__cold__'. */ -#if _GL_HAS_ATTRIBUTE (cold) && !defined __MINGW32__ -# ifndef __SUNPRO_C -# define _GL_ATTRIBUTE_COLD __attribute__ ((__cold__)) +#ifndef _GL_ATTRIBUTE_COLD +# if _GL_HAS_ATTRIBUTE (cold) && !defined __MINGW32__ +# ifndef __SUNPRO_C +# define _GL_ATTRIBUTE_COLD __attribute__ ((__cold__)) +# else +# define _GL_ATTRIBUTE_COLD __attribute__ ((cold)) +# endif # else -# define _GL_ATTRIBUTE_COLD __attribute__ ((cold)) +# define _GL_ATTRIBUTE_COLD # endif -#else -# define _GL_ATTRIBUTE_COLD #endif /* _GL_ATTRIBUTE_CONST declares that it is OK for a compiler to omit duplicate @@ -166,10 +179,12 @@ AC_DEFUN forever, and does not call longjmp. (This attribute is stricter than _GL_ATTRIBUTE_PURE.) */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (const) -# define _GL_ATTRIBUTE_CONST __attribute__ ((__const__)) -#else -# define _GL_ATTRIBUTE_CONST +#ifndef _GL_ATTRIBUTE_CONST +# if _GL_HAS_ATTRIBUTE (const) +# define _GL_ATTRIBUTE_CONST __attribute__ ((__const__)) +# else +# define _GL_ATTRIBUTE_CONST +# endif #endif /* _GL_ATTRIBUTE_DEALLOC (F, I) declares that the function returns pointers @@ -178,10 +193,12 @@ AC_DEFUN _GL_ATTRIBUTE_DEALLOC_FREE declares that the function returns pointers that can be freed via 'free'; it can be used only after declaring 'free'. */ /* Applies to: functions. Cannot be used on inline functions. */ -#if _GL_GNUC_PREREQ (11, 0) -# define _GL_ATTRIBUTE_DEALLOC(f, i) __attribute__ ((__malloc__ (f, i))) -#else -# define _GL_ATTRIBUTE_DEALLOC(f, i) +#ifndef _GL_ATTRIBUTE_DEALLOC +# if _GL_GNUC_PREREQ (11, 0) +# define _GL_ATTRIBUTE_DEALLOC(f, i) __attribute__ ((__malloc__ (f, i))) +# else +# define _GL_ATTRIBUTE_DEALLOC(f, i) +# endif #endif /* If gnulib's or has already defined this macro, continue to use this earlier definition, since may not have been included @@ -205,16 +222,18 @@ AC_DEFUN - enumeration, enumeration item, - typedef, in C++ also: namespace, class, template specialization. */ -#ifdef __has_c_attribute -# if __has_c_attribute (__deprecated__) -# define _GL_ATTRIBUTE_DEPRECATED [[__deprecated__]] -# endif -#endif -#if !defined _GL_ATTRIBUTE_DEPRECATED && _GL_HAS_ATTRIBUTE (deprecated) -# define _GL_ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__)) -#endif #ifndef _GL_ATTRIBUTE_DEPRECATED -# define _GL_ATTRIBUTE_DEPRECATED +# ifdef __has_c_attribute +# if __has_c_attribute (__deprecated__) +# define _GL_ATTRIBUTE_DEPRECATED [[__deprecated__]] +# endif +# endif +# if !defined _GL_ATTRIBUTE_DEPRECATED && _GL_HAS_ATTRIBUTE (deprecated) +# define _GL_ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__)) +# endif +# ifndef _GL_ATTRIBUTE_DEPRECATED +# define _GL_ATTRIBUTE_DEPRECATED +# endif #endif /* _GL_ATTRIBUTE_ERROR(msg) requests an error if a function is called and @@ -222,24 +241,28 @@ AC_DEFUN _GL_ATTRIBUTE_WARNING(msg) requests a warning if a function is called and the function call is not optimized away. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (error) -# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__error__ (msg))) -# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__warning__ (msg))) -#elif _GL_HAS_ATTRIBUTE (diagnose_if) -# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__diagnose_if__ (1, msg, "error"))) -# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__diagnose_if__ (1, msg, "warning"))) -#else -# define _GL_ATTRIBUTE_ERROR(msg) -# define _GL_ATTRIBUTE_WARNING(msg) +#if !(defined _GL_ATTRIBUTE_ERROR && defined _GL_ATTRIBUTE_WARNING) +# if _GL_HAS_ATTRIBUTE (error) +# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__error__ (msg))) +# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__warning__ (msg))) +# elif _GL_HAS_ATTRIBUTE (diagnose_if) +# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__diagnose_if__ (1, msg, "error"))) +# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__diagnose_if__ (1, msg, "warning"))) +# else +# define _GL_ATTRIBUTE_ERROR(msg) +# define _GL_ATTRIBUTE_WARNING(msg) +# endif #endif /* _GL_ATTRIBUTE_EXTERNALLY_VISIBLE declares that the entity should remain visible to debuggers etc., even with '-fwhole-program'. */ /* Applies to: functions, variables. */ -#if _GL_HAS_ATTRIBUTE (externally_visible) -# define _GL_ATTRIBUTE_EXTERNALLY_VISIBLE __attribute__ ((externally_visible)) -#else -# define _GL_ATTRIBUTE_EXTERNALLY_VISIBLE +#ifndef _GL_ATTRIBUTE_EXTERNALLY_VISIBLE +# if _GL_HAS_ATTRIBUTE (externally_visible) +# define _GL_ATTRIBUTE_EXTERNALLY_VISIBLE __attribute__ ((externally_visible)) +# else +# define _GL_ATTRIBUTE_EXTERNALLY_VISIBLE +# endif #endif /* _GL_ATTRIBUTE_FALLTHROUGH declares that it is not a programming mistake if @@ -247,16 +270,18 @@ AC_DEFUN 'default' label. The compiler should not warn in this case. */ /* Applies to: Empty statement (;), inside a 'switch' statement. */ /* Always expands to something. */ -#ifdef __has_c_attribute -# if __has_c_attribute (__fallthrough__) -# define _GL_ATTRIBUTE_FALLTHROUGH [[__fallthrough__]] -# endif -#endif -#if !defined _GL_ATTRIBUTE_FALLTHROUGH && _GL_HAS_ATTRIBUTE (fallthrough) -# define _GL_ATTRIBUTE_FALLTHROUGH __attribute__ ((__fallthrough__)) -#endif #ifndef _GL_ATTRIBUTE_FALLTHROUGH -# define _GL_ATTRIBUTE_FALLTHROUGH ((void) 0) +# ifdef __has_c_attribute +# if __has_c_attribute (__fallthrough__) +# define _GL_ATTRIBUTE_FALLTHROUGH [[__fallthrough__]] +# endif +# endif +# if !defined _GL_ATTRIBUTE_FALLTHROUGH && _GL_HAS_ATTRIBUTE (fallthrough) +# define _GL_ATTRIBUTE_FALLTHROUGH __attribute__ ((__fallthrough__)) +# endif +# ifndef _GL_ATTRIBUTE_FALLTHROUGH +# define _GL_ATTRIBUTE_FALLTHROUGH ((void) 0) +# endif #endif /* _GL_ATTRIBUTE_FORMAT ((ARCHETYPE, STRING-INDEX, FIRST-TO-CHECK)) @@ -270,10 +295,12 @@ AC_DEFUN If FIRST-TO-CHECK is not 0, arguments starting at FIRST-TO_CHECK are suitable for the format string. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (format) -# define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec)) -#else -# define _GL_ATTRIBUTE_FORMAT(spec) +#ifndef _GL_ATTRIBUTE_FORMAT +# if _GL_HAS_ATTRIBUTE (format) +# define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec)) +# else +# define _GL_ATTRIBUTE_FORMAT(spec) +# endif #endif /* _GL_ATTRIBUTE_LEAF declares that if the function is called from some other @@ -281,19 +308,23 @@ AC_DEFUN exception handling. This declaration lets the compiler optimize that unit more aggressively. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (leaf) -# define _GL_ATTRIBUTE_LEAF __attribute__ ((__leaf__)) -#else -# define _GL_ATTRIBUTE_LEAF +#ifndef _GL_ATTRIBUTE_LEAF +# if _GL_HAS_ATTRIBUTE (leaf) +# define _GL_ATTRIBUTE_LEAF __attribute__ ((__leaf__)) +# else +# define _GL_ATTRIBUTE_LEAF +# endif #endif /* _GL_ATTRIBUTE_MALLOC declares that the function returns a pointer to freshly allocated memory. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (malloc) -# define _GL_ATTRIBUTE_MALLOC __attribute__ ((__malloc__)) -#else -# define _GL_ATTRIBUTE_MALLOC +#ifndef _GL_ATTRIBUTE_MALLOC +# if _GL_HAS_ATTRIBUTE (malloc) +# define _GL_ATTRIBUTE_MALLOC __attribute__ ((__malloc__)) +# else +# define _GL_ATTRIBUTE_MALLOC +# endif #endif /* _GL_ATTRIBUTE_MAY_ALIAS declares that pointers to the type may point to the @@ -301,10 +332,12 @@ AC_DEFUN strict aliasing optimization. */ /* Applies to: types. */ /* Oracle Studio 12.6 mishandles may_alias despite __has_attribute OK. */ -#if _GL_HAS_ATTRIBUTE (may_alias) && !defined __SUNPRO_C -# define _GL_ATTRIBUTE_MAY_ALIAS __attribute__ ((__may_alias__)) -#else -# define _GL_ATTRIBUTE_MAY_ALIAS +#ifndef _GL_ATTRIBUTE_MAY_ALIAS +# if _GL_HAS_ATTRIBUTE (may_alias) && !defined __SUNPRO_C +# define _GL_ATTRIBUTE_MAY_ALIAS __attribute__ ((__may_alias__)) +# else +# define _GL_ATTRIBUTE_MAY_ALIAS +# endif #endif /* _GL_ATTRIBUTE_MAYBE_UNUSED declares that it is not a programming mistake if @@ -318,14 +351,22 @@ AC_DEFUN in C++ also: class. */ /* In C++ and C23, this is spelled [[__maybe_unused__]]. GCC's syntax is __attribute__ ((__unused__)). - clang supports both syntaxes. */ -#ifdef __has_c_attribute -# if __has_c_attribute (__maybe_unused__) -# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]] -# endif -#endif + clang supports both syntaxes. Except that with clang ≥ 6, < 10, in C++ mode, + __has_c_attribute (__maybe_unused__) yields true but the use of + [[__maybe_unused__]] nevertheless produces a warning. */ #ifndef _GL_ATTRIBUTE_MAYBE_UNUSED -# define _GL_ATTRIBUTE_MAYBE_UNUSED _GL_ATTRIBUTE_UNUSED +# if defined __clang__ && defined __cplusplus +# if __clang_major__ >= 10 +# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]] +# endif +# elif defined __has_c_attribute +# if __has_c_attribute (__maybe_unused__) +# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]] +# endif +# endif +# ifndef _GL_ATTRIBUTE_MAYBE_UNUSED +# define _GL_ATTRIBUTE_MAYBE_UNUSED _GL_ATTRIBUTE_UNUSED +# endif #endif /* Alternative spelling of this macro, for convenience and for compatibility with glibc/include/libc-symbols.h. */ @@ -337,25 +378,38 @@ AC_DEFUN discard the return value. The compiler may warn if the caller does not use the return value, unless the caller uses something like ignore_value. */ /* Applies to: function, enumeration, class. */ -#ifdef __has_c_attribute -# if __has_c_attribute (__nodiscard__) -# define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]] -# endif -#endif -#if !defined _GL_ATTRIBUTE_NODISCARD && _GL_HAS_ATTRIBUTE (warn_unused_result) -# define _GL_ATTRIBUTE_NODISCARD __attribute__ ((__warn_unused_result__)) -#endif #ifndef _GL_ATTRIBUTE_NODISCARD -# define _GL_ATTRIBUTE_NODISCARD +# if defined __clang__ && defined __cplusplus + /* With clang up to 15.0.6 (at least), in C++ mode, [[__nodiscard__]] produces + a warning. + The 1000 below means a yet unknown threshold. When clang++ version X + starts supporting [[__nodiscard__]] without warning about it, you can + replace the 1000 with X. */ +# if __clang_major__ >= 1000 +# define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]] +# endif +# elif defined __has_c_attribute +# if __has_c_attribute (__nodiscard__) +# define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]] +# endif +# endif +# if !defined _GL_ATTRIBUTE_NODISCARD && _GL_HAS_ATTRIBUTE (warn_unused_result) +# define _GL_ATTRIBUTE_NODISCARD __attribute__ ((__warn_unused_result__)) +# endif +# ifndef _GL_ATTRIBUTE_NODISCARD +# define _GL_ATTRIBUTE_NODISCARD +# endif #endif /* _GL_ATTRIBUTE_NOINLINE tells that the compiler should not inline the function. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (noinline) -# define _GL_ATTRIBUTE_NOINLINE __attribute__ ((__noinline__)) -#else -# define _GL_ATTRIBUTE_NOINLINE +#ifndef _GL_ATTRIBUTE_NOINLINE +# if _GL_HAS_ATTRIBUTE (noinline) +# define _GL_ATTRIBUTE_NOINLINE __attribute__ ((__noinline__)) +# else +# define _GL_ATTRIBUTE_NOINLINE +# endif #endif /* _GL_ATTRIBUTE_NONNULL ((N1, N2,...)) declares that the arguments N1, N2,... @@ -363,20 +417,24 @@ AC_DEFUN _GL_ATTRIBUTE_NONNULL () declares that all pointer arguments must not be null. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (nonnull) -# define _GL_ATTRIBUTE_NONNULL(args) __attribute__ ((__nonnull__ args)) -#else -# define _GL_ATTRIBUTE_NONNULL(args) +#ifndef _GL_ATTRIBUTE_NONNULL +# if _GL_HAS_ATTRIBUTE (nonnull) +# define _GL_ATTRIBUTE_NONNULL(args) __attribute__ ((__nonnull__ args)) +# else +# define _GL_ATTRIBUTE_NONNULL(args) +# endif #endif /* _GL_ATTRIBUTE_NONSTRING declares that the contents of a character array is not meant to be NUL-terminated. */ /* Applies to: struct/union members and variables that are arrays of element type '[[un]signed] char'. */ -#if _GL_HAS_ATTRIBUTE (nonstring) -# define _GL_ATTRIBUTE_NONSTRING __attribute__ ((__nonstring__)) -#else -# define _GL_ATTRIBUTE_NONSTRING +#ifndef _GL_ATTRIBUTE_NONSTRING +# if _GL_HAS_ATTRIBUTE (nonstring) +# define _GL_ATTRIBUTE_NONSTRING __attribute__ ((__nonstring__)) +# else +# define _GL_ATTRIBUTE_NONSTRING +# endif #endif /* There is no _GL_ATTRIBUTE_NORETURN; use _Noreturn instead. */ @@ -384,10 +442,12 @@ AC_DEFUN /* _GL_ATTRIBUTE_NOTHROW declares that the function does not throw exceptions. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (nothrow) && !defined __cplusplus -# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__)) -#else -# define _GL_ATTRIBUTE_NOTHROW +#ifndef _GL_ATTRIBUTE_NOTHROW +# if _GL_HAS_ATTRIBUTE (nothrow) && !defined __cplusplus +# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__)) +# else +# define _GL_ATTRIBUTE_NOTHROW +# endif #endif /* _GL_ATTRIBUTE_PACKED declares: @@ -396,10 +456,12 @@ AC_DEFUN minimizing the memory required. */ /* Applies to: struct members, struct, union, in C++ also: class. */ -#if _GL_HAS_ATTRIBUTE (packed) -# define _GL_ATTRIBUTE_PACKED __attribute__ ((__packed__)) -#else -# define _GL_ATTRIBUTE_PACKED +#ifndef _GL_ATTRIBUTE_PACKED +# if _GL_HAS_ATTRIBUTE (packed) +# define _GL_ATTRIBUTE_PACKED __attribute__ ((__packed__)) +# else +# define _GL_ATTRIBUTE_PACKED +# endif #endif /* _GL_ATTRIBUTE_PURE declares that It is OK for a compiler to omit duplicate @@ -409,19 +471,23 @@ AC_DEFUN observable state, and always returns exactly once. (This attribute is looser than _GL_ATTRIBUTE_CONST.) */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (pure) -# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__)) -#else -# define _GL_ATTRIBUTE_PURE +#ifndef _GL_ATTRIBUTE_PURE +# if _GL_HAS_ATTRIBUTE (pure) +# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__)) +# else +# define _GL_ATTRIBUTE_PURE +# endif #endif /* _GL_ATTRIBUTE_RETURNS_NONNULL declares that the function's return value is a non-NULL pointer. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (returns_nonnull) -# define _GL_ATTRIBUTE_RETURNS_NONNULL __attribute__ ((__returns_nonnull__)) -#else -# define _GL_ATTRIBUTE_RETURNS_NONNULL +#ifndef _GL_ATTRIBUTE_RETURNS_NONNULL +# if _GL_HAS_ATTRIBUTE (returns_nonnull) +# define _GL_ATTRIBUTE_RETURNS_NONNULL __attribute__ ((__returns_nonnull__)) +# else +# define _GL_ATTRIBUTE_RETURNS_NONNULL +# endif #endif /* _GL_ATTRIBUTE_SENTINEL(pos) declares that the variadic function expects a @@ -429,17 +495,21 @@ AC_DEFUN _GL_ATTRIBUTE_SENTINEL () - The last argument is NULL (requires C99). _GL_ATTRIBUTE_SENTINEL ((N)) - The (N+1)st argument from the end is NULL. */ /* Applies to: functions. */ -#if _GL_HAS_ATTRIBUTE (sentinel) -# define _GL_ATTRIBUTE_SENTINEL(pos) __attribute__ ((__sentinel__ pos)) -#else -# define _GL_ATTRIBUTE_SENTINEL(pos) +#ifndef _GL_ATTRIBUTE_SENTINEL +# if _GL_HAS_ATTRIBUTE (sentinel) +# define _GL_ATTRIBUTE_SENTINEL(pos) __attribute__ ((__sentinel__ pos)) +# else +# define _GL_ATTRIBUTE_SENTINEL(pos) +# endif #endif /* A helper macro. Don't use it directly. */ -#if _GL_HAS_ATTRIBUTE (unused) -# define _GL_ATTRIBUTE_UNUSED __attribute__ ((__unused__)) -#else -# define _GL_ATTRIBUTE_UNUSED +#ifndef _GL_ATTRIBUTE_UNUSED +# if _GL_HAS_ATTRIBUTE (unused) +# define _GL_ATTRIBUTE_UNUSED __attribute__ ((__unused__)) +# else +# define _GL_ATTRIBUTE_UNUSED +# endif #endif ]dnl There is no _GL_ATTRIBUTE_VISIBILITY; see m4/visibility.m4 instead. @@ -450,10 +520,12 @@ AC_DEFUN /* Applies to: label (both in C and C++). */ /* Note that g++ < 4.5 does not support the '__attribute__ ((__unused__)) ;' syntax. But clang does. */ -#if !(defined __cplusplus && !_GL_GNUC_PREREQ (4, 5)) || defined __clang__ -# define _GL_UNUSED_LABEL _GL_ATTRIBUTE_UNUSED -#else -# define _GL_UNUSED_LABEL +#ifndef _GL_UNUSED_LABEL +# if !(defined __cplusplus && !_GL_GNUC_PREREQ (4, 5)) || defined __clang__ +# define _GL_UNUSED_LABEL _GL_ATTRIBUTE_UNUSED +# else +# define _GL_UNUSED_LABEL +# endif #endif ]) AH_VERBATIM([async_safe], @@ -1026,8 +1098,21 @@ AC_DEFUN dnl gl_CHECK_FUNCS_ANDROID([func], [[#include ]]) dnl is like AC_CHECK_FUNCS([func]), taking into account a portability problem dnl on Android. -dnl Namely, if func was added to Android API level, say, 28, then the libc.so -dnl has the symbol func always, whereas the header file declares func +dnl +dnl When code is compiled on Android, it is in the context of a certain +dnl "Android API level", which indicates the minimum version of Android on +dnl which the app can be installed. In other words, you don't compile for a +dnl specific version of Android. You compile for all versions of Android, +dnl onwards from the given API level. +dnl Thus, the question "does the OS have the function func" has three possible +dnl answers: +dnl - yes, in all versions starting from the given API level, +dnl - no, in no version, +dnl - not in the given API level, but in a later version of Android. +dnl +dnl In detail, this works as follows: +dnl If func was added to Android API level, say, 28, then the libc.so has the +dnl symbol func always, whereas the header file declares func dnl conditionally: dnl #if __ANDROID_API__ >= 28 dnl ... func (...) __INTRODUCED_IN(28); @@ -1035,15 +1120,55 @@ AC_DEFUN dnl Thus, when compiling with "clang -target armv7a-unknown-linux-android28", dnl the function func is declared and exists in libc. dnl Whereas when compiling with "clang -target armv7a-unknown-linux-android27", -dnl the function func is not declared but exists in libc. We need to treat this -dnl case like the case where func does not exist. +dnl the function func is not declared but exists in libc. +dnl +dnl This macro sets two variables: +dnl - gl_cv_onwards_func_ to yes / no / "future OS version" +dnl - ac_cv_func_ to yes / no / no +dnl The first variable allows to distinguish all three cases. +dnl The second variable is set, so that an invocation +dnl gl_CHECK_FUNCS_ANDROID([func], [[#include ]]) +dnl can be used as a drop-in replacement for +dnl AC_CHECK_FUNCS([func]). AC_DEFUN([gl_CHECK_FUNCS_ANDROID], [ - AC_CHECK_DECL([$1], , , [$2]) - if test $ac_cv_have_decl_[$1] = yes; then - AC_CHECK_FUNCS([$1]) - else - ac_cv_func_[$1]=no + AC_REQUIRE([AC_CANONICAL_HOST]) + AC_CACHE_CHECK([for [$1]], + [[gl_cv_onwards_func_][$1]], + [gl_SILENT([ + case "$host_os" in + linux*-android*) + AC_CHECK_DECL([$1], , , [$2]) + if test $[ac_cv_have_decl_][$1] = yes; then + AC_CHECK_FUNC([[$1]]) + if test $[ac_cv_func_][$1] = yes; then + [gl_cv_onwards_func_][$1]=yes + else + dnl The function is declared but does not exist. This should not + dnl happen normally. But anyway, we know that a future version + dnl of Android will have the function. + [gl_cv_onwards_func_][$1]='future OS version' + fi + else + [gl_cv_onwards_func_][$1]='future OS version' + fi + ;; + *) + AC_CHECK_FUNC([$1]) + [gl_cv_onwards_func_][$1]=$[ac_cv_func_][$1] + ;; + esac + ]) + ]) + case "$[gl_cv_onwards_func_][$1]" in + future*) [ac_cv_func_][$1]=no ;; + *) [ac_cv_func_][$1]=$[gl_cv_onwards_func_][$1] ;; + esac + if test $[ac_cv_func_][$1] = yes; then + AC_DEFINE([HAVE_]m4_translit([[$1]], + [abcdefghijklmnopqrstuvwxyz], + [ABCDEFGHIJKLMNOPQRSTUVWXYZ]), + [1], [Define to 1 if you have the `$1' function.]) fi ]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 10c74fa2392..aacceb92258 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -44,6 +44,7 @@ AC_DEFUN # Code from module absolute-header: # Code from module acl-permissions: + # Code from module alignasof: # Code from module alloca-opt: # Code from module allocator: # Code from module assert-h: @@ -231,6 +232,7 @@ AC_DEFUN gl_source_base='lib' gl_source_base_prefix= gl_FUNC_ACL + gl_ALIGNASOF gl_FUNC_ALLOCA gl_CONDITIONAL_HEADER([alloca.h]) AC_PROG_MKDIR_P @@ -248,7 +250,7 @@ AC_DEFUN gl_STDLIB_MODULE_INDICATOR([canonicalize_file_name]) gl_STDLIB_MODULE_INDICATOR([realpath]) AC_REQUIRE([AC_C_RESTRICT]) - AC_CHECK_FUNCS_ONCE([readlinkat]) + gl_CHECK_FUNCS_ANDROID([readlinkat], [[#include ]]) gl_CLOCK_TIME gl_MODULE_INDICATOR([close-stream]) gl_FUNC_COPY_FILE_RANGE @@ -344,7 +346,8 @@ AC_DEFUN gl_SYS_STAT_MODULE_INDICATOR([futimens]) AC_REQUIRE([AC_CANONICAL_HOST]) gl_GETLOADAVG - gl_CONDITIONAL([GL_COND_OBJ_GETLOADAVG], [test $HAVE_GETLOADAVG = 0]) + gl_CONDITIONAL([GL_COND_OBJ_GETLOADAVG], + [test $HAVE_GETLOADAVG = 0 || test $REPLACE_GETLOADAVG = 1]) AM_COND_IF([GL_COND_OBJ_GETLOADAVG], [ gl_PREREQ_GETLOADAVG ]) @@ -404,7 +407,8 @@ AC_DEFUN fi gl_STRING_MODULE_INDICATOR([memmem]) gl_FUNC_MEMPCPY - gl_CONDITIONAL([GL_COND_OBJ_MEMPCPY], [test $HAVE_MEMPCPY = 0]) + gl_CONDITIONAL([GL_COND_OBJ_MEMPCPY], + [test $HAVE_MEMPCPY = 0 || test $REPLACE_MEMPCPY = 1]) AM_COND_IF([GL_COND_OBJ_MEMPCPY], [ gl_PREREQ_MEMPCPY ]) @@ -423,7 +427,8 @@ AC_DEFUN gl_STRING_MODULE_INDICATOR([memset_explicit]) gl_MINMAX gl_FUNC_MKOSTEMP - gl_CONDITIONAL([GL_COND_OBJ_MKOSTEMP], [test $HAVE_MKOSTEMP = 0]) + gl_CONDITIONAL([GL_COND_OBJ_MKOSTEMP], + [test $HAVE_MKOSTEMP = 0 || test $REPLACE_MKOSTEMP = 1]) AM_COND_IF([GL_COND_OBJ_MKOSTEMP], [ gl_PREREQ_MKOSTEMP ]) @@ -548,7 +553,8 @@ AC_DEFUN gl_STDLIB_H_REQUIRE_DEFAULTS AC_PROG_MKDIR_P gl_FUNC_STPCPY - gl_CONDITIONAL([GL_COND_OBJ_STPCPY], [test $HAVE_STPCPY = 0]) + gl_CONDITIONAL([GL_COND_OBJ_STPCPY], + [test $HAVE_STPCPY = 0 || test $REPLACE_STPCPY = 1]) AM_COND_IF([GL_COND_OBJ_STPCPY], [ gl_PREREQ_STPCPY ]) @@ -973,7 +979,7 @@ AC_DEFUN if test $HAVE_FUTIMENS = 0 || test $REPLACE_FUTIMENS = 1; then func_gl_gnulib_m4code_utimens fi - if case $host_os in mingw*) false;; *) test $HAVE_GETLOADAVG = 0;; esac; then + if case $host_os in mingw*) false;; *) test $HAVE_GETLOADAVG = 0 || test $REPLACE_GETLOADAVG = 1;; esac; then func_gl_gnulib_m4code_open fi if test $REPLACE_GETOPT = 1; then diff --git a/m4/inttypes.m4 b/m4/inttypes.m4 index bf2eab2ba31..e7efbe94167 100644 --- a/m4/inttypes.m4 +++ b/m4/inttypes.m4 @@ -1,4 +1,4 @@ -# inttypes.m4 serial 36 +# inttypes.m4 serial 37 dnl Copyright (C) 2006-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -170,6 +170,10 @@ AC_DEFUN HAVE_DECL_STRTOIMAX=1; AC_SUBST([HAVE_DECL_STRTOIMAX]) HAVE_DECL_STRTOUMAX=1; AC_SUBST([HAVE_DECL_STRTOUMAX]) HAVE_IMAXDIV_T=1; AC_SUBST([HAVE_IMAXDIV_T]) + HAVE_IMAXABS=1; AC_SUBST([HAVE_IMAXABS]) + HAVE_IMAXDIV=1; AC_SUBST([HAVE_IMAXDIV]) + REPLACE_IMAXABS=0; AC_SUBST([REPLACE_IMAXABS]) + REPLACE_IMAXDIV=0; AC_SUBST([REPLACE_IMAXDIV]) REPLACE_STRTOIMAX=0; AC_SUBST([REPLACE_STRTOIMAX]) REPLACE_STRTOUMAX=0; AC_SUBST([REPLACE_STRTOUMAX]) INT32_MAX_LT_INTMAX_MAX=1; AC_SUBST([INT32_MAX_LT_INTMAX_MAX]) diff --git a/m4/mempcpy.m4 b/m4/mempcpy.m4 index 55bee2ab7a2..612b77b3c11 100644 --- a/m4/mempcpy.m4 +++ b/m4/mempcpy.m4 @@ -1,4 +1,4 @@ -# mempcpy.m4 serial 12 +# mempcpy.m4 serial 14 dnl Copyright (C) 2003-2004, 2006-2007, 2009-2023 Free Software Foundation, dnl Inc. dnl This file is free software; the Free Software Foundation @@ -14,9 +14,12 @@ AC_DEFUN AC_REQUIRE([AC_C_RESTRICT]) AC_REQUIRE([gl_STRING_H_DEFAULTS]) - AC_CHECK_FUNCS([mempcpy]) + gl_CHECK_FUNCS_ANDROID([mempcpy], [[#include ]]) if test $ac_cv_func_mempcpy = no; then HAVE_MEMPCPY=0 + case "$gl_cv_onwards_func_mempcpy" in + future*) REPLACE_MEMPCPY=1 ;; + esac fi ]) diff --git a/m4/mkostemp.m4 b/m4/mkostemp.m4 index a7cfac4cb87..1b0d0d55946 100644 --- a/m4/mkostemp.m4 +++ b/m4/mkostemp.m4 @@ -1,4 +1,4 @@ -# mkostemp.m4 serial 2 +# mkostemp.m4 serial 4 dnl Copyright (C) 2009-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -11,9 +11,12 @@ AC_DEFUN dnl Persuade glibc to declare mkostemp(). AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_FUNCS_ONCE([mkostemp]) + gl_CHECK_FUNCS_ANDROID([mkostemp], [[#include ]]) if test $ac_cv_func_mkostemp != yes; then HAVE_MKOSTEMP=0 + case "$gl_cv_onwards_func_mkostemp" in + future*) REPLACE_MKOSTEMP=1 ;; + esac fi ]) diff --git a/m4/nproc.m4 b/m4/nproc.m4 index 3065b7b9bff..c892ad74b7d 100644 --- a/m4/nproc.m4 +++ b/m4/nproc.m4 @@ -1,4 +1,4 @@ -# nproc.m4 serial 5 +# nproc.m4 serial 6 dnl Copyright (C) 2009-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -25,8 +25,8 @@ AC_DEFUN #endif ]) - AC_CHECK_FUNCS([sched_getaffinity sched_getaffinity_np \ - pstat_getdynamic sysmp sysctl]) + AC_CHECK_FUNCS([sched_getaffinity_np pstat_getdynamic sysmp sysctl]) + gl_CHECK_FUNCS_ANDROID([sched_getaffinity], [[#include ]]) dnl Test whether sched_getaffinity has the expected declaration. dnl glibc 2.3.[0-2]: diff --git a/m4/pipe2.m4 b/m4/pipe2.m4 index 501f3a4303d..79de69cd1a4 100644 --- a/m4/pipe2.m4 +++ b/m4/pipe2.m4 @@ -1,4 +1,4 @@ -# pipe2.m4 serial 2 +# pipe2.m4 serial 4 dnl Copyright (C) 2009-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -11,8 +11,13 @@ AC_DEFUN dnl Persuade glibc to declare pipe2(). AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_FUNCS_ONCE([pipe2]) + gl_CHECK_FUNCS_ANDROID([pipe2], [[#include ]]) if test $ac_cv_func_pipe2 != yes; then HAVE_PIPE2=0 + case "$gl_cv_onwards_func_pipe2" in + future*) REPLACE_PIPE2=1 ;; + esac + else + REPLACE_PIPE2=1 fi ]) diff --git a/m4/readlinkat.m4 b/m4/readlinkat.m4 index ffd0b8e9bc1..5c513562919 100644 --- a/m4/readlinkat.m4 +++ b/m4/readlinkat.m4 @@ -1,4 +1,4 @@ -# serial 6 +# serial 8 # See if we need to provide readlinkat replacement. dnl Copyright (C) 2009-2023 Free Software Foundation, Inc. @@ -12,10 +12,13 @@ AC_DEFUN [ AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) - AC_CHECK_FUNCS_ONCE([readlinkat]) + gl_CHECK_FUNCS_ANDROID([readlinkat], [[#include ]]) AC_REQUIRE([gl_FUNC_READLINK]) if test $ac_cv_func_readlinkat = no; then HAVE_READLINKAT=0 + case "$gl_cv_onwards_func_readlinkat" in + future*) REPLACE_READLINKAT=1 ;; + esac else AC_CACHE_CHECK([whether readlinkat signature is correct], [gl_cv_decl_readlinkat_works], diff --git a/m4/stdalign.m4 b/m4/stdalign.m4 index b1438eeaced..f49cf8ec162 100644 --- a/m4/stdalign.m4 +++ b/m4/stdalign.m4 @@ -5,9 +5,11 @@ dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. +dnl Written by Paul Eggert and Bruno Haible. + # Prepare for substituting if it is not supported. -AC_DEFUN([gl_STDALIGN_H], +AC_DEFUN([gl_ALIGNASOF], [ AC_CACHE_CHECK([for alignas and alignof], [gl_cv_header_working_stdalign_h], @@ -58,77 +60,141 @@ AC_DEFUN test "$gl_cv_header_working_stdalign_h" != no && break done]) - GL_GENERATE_STDALIGN_H=false AS_CASE([$gl_cv_header_working_stdalign_h], - [no], - [GL_GENERATE_STDALIGN_H=true], [yes*keyword*], [AC_DEFINE([HAVE_C_ALIGNASOF], [1], [Define to 1 if the alignas and alignof keywords work.])]) - AC_CHECK_HEADERS_ONCE([stdalign.h]) - dnl The "zz" puts this toward config.h's end, to avoid potential dnl collisions with other definitions. AH_VERBATIM([zzalignas], [#if !defined HAVE_C_ALIGNASOF && __cplusplus < 201103 && !defined alignof # if HAVE_STDALIGN_H # include -# else - /* Substitute. Keep consistent with gnulib/lib/stdalign.in.h. */ -# ifndef _GL_STDALIGN_H -# define _GL_STDALIGN_H -# undef _Alignas -# undef _Alignof -# if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \ - || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \ - && !defined __clang__) \ - || (defined __clang__ && __clang_major__ < 8)) -# ifdef __cplusplus -# if (201103 <= __cplusplus || defined _MSC_VER) -# define _Alignof(type) alignof (type) -# else - template struct __alignof_helper { char __a; __t __b; }; -# define _Alignof(type) offsetof (__alignof_helper, __b) -# define _GL_STDALIGN_NEEDS_STDDEF 1 -# endif +# endif + +/* ISO C23 alignas and alignof for platforms that lack it. + + References: + ISO C23 (latest free draft + ) + sections 6.5.3.4, 6.7.5, 7.15. + C++11 (latest free draft + ) + section 18.10. */ + +/* alignof (TYPE), also known as _Alignof (TYPE), yields the alignment + requirement of a structure member (i.e., slot or field) that is of + type TYPE, as an integer constant expression. + + This differs from GCC's and clang's __alignof__ operator, which can + yield a better-performing alignment for an object of that type. For + example, on x86 with GCC and on Linux/x86 with clang, + __alignof__ (double) and __alignof__ (long long) are 8, whereas + alignof (double) and alignof (long long) are 4 unless the option + '-malign-double' is used. + + The result cannot be used as a value for an 'enum' constant, if you + want to be portable to HP-UX 10.20 cc and AIX 3.2.5 xlc. */ + +/* GCC releases before GCC 4.9 had a bug in _Alignof. See GCC bug 52023 + . + clang versions < 8.0.0 have the same bug. */ +# if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \ + || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9) \ + && !defined __clang__) \ + || (defined __clang__ && __clang_major__ < 8)) +# undef/**/_Alignof +# ifdef __cplusplus +# if (201103 <= __cplusplus || defined _MSC_VER) +# define _Alignof(type) alignof (type) # else -# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b) + template struct __alignof_helper { char __a; __t __b; }; +# define _Alignof(type) offsetof (__alignof_helper, __b) # define _GL_STDALIGN_NEEDS_STDDEF 1 # endif -# endif -# if ! (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER)) -# define alignof _Alignof -# endif -# define __alignof_is_defined 1 -# if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 -# if defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER) -# define _Alignas(a) alignas (a) -# elif (!defined __attribute__ \ - && ((defined __APPLE__ && defined __MACH__ \ - ? 4 < __GNUC__ + (1 <= __GNUC_MINOR__) \ - : __GNUC__ && !defined __ibmxl__) \ - || (4 <= __clang_major__) \ - || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \ - || __ICC || 0x590 <= __SUNPRO_C || 0x0600 <= __xlC__)) -# define _Alignas(a) __attribute__ ((__aligned__ (a))) -# elif 1300 <= _MSC_VER -# define _Alignas(a) __declspec (align (a)) +# else +# if (defined __GNUC__ && 4 <= __GNUC__) || defined __clang__ +# define _Alignof(type) __builtin_offsetof (struct { char __a; type __b; }, __b) +# else +# define _Alignof(type) offsetof (struct { char __a; type __b; }, __b) +# define _GL_STDALIGN_NEEDS_STDDEF 1 # endif # endif -# if ((defined _Alignas \ - && !(defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) \ - || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__)) -# define alignas _Alignas -# endif -# if (defined alignas \ - || (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER))) -# define __alignas_is_defined 1 -# endif -# if _GL_STDALIGN_NEEDS_STDDEF -# include +# endif +# if ! (defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER)) +# undef/**/alignof +# define alignof _Alignof +# endif + +/* alignas (A), also known as _Alignas (A), aligns a variable or type + to the alignment A, where A is an integer constant expression. For + example: + + int alignas (8) foo; + struct s { int a; int alignas (8) bar; }; + + aligns the address of FOO and the offset of BAR to be multiples of 8. + + A should be a power of two that is at least the type's alignment + and at most the implementation's alignment limit. This limit is + 2**28 on typical GNUish hosts, and 2**13 on MSVC. To be portable + to MSVC through at least version 10.0, A should be an integer + constant, as MSVC does not support expressions such as 1 << 3. + To be portable to Sun C 5.11, do not align auto variables to + anything stricter than their default alignment. + + The following C23 requirements are not supported here: + + - If A is zero, alignas has no effect. + - alignas can be used multiple times; the strictest one wins. + - alignas (TYPE) is equivalent to alignas (alignof (TYPE)). + + */ +# if !HAVE_STDALIGN_H +# if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 +# if defined __cplusplus && (201103 <= __cplusplus || defined _MSC_VER) +# define _Alignas(a) alignas (a) +# elif (!defined __attribute__ \ + && ((defined __APPLE__ && defined __MACH__ \ + ? 4 < __GNUC__ + (1 <= __GNUC_MINOR__) \ + : __GNUC__ && !defined __ibmxl__) \ + || (4 <= __clang_major__) \ + || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \ + || __ICC || 0x590 <= __SUNPRO_C || 0x0600 <= __xlC__)) +# define _Alignas(a) __attribute__ ((__aligned__ (a))) +# elif 1300 <= _MSC_VER +# define _Alignas(a) __declspec (align (a)) # endif -# endif /* _GL_STDALIGN_H */ +# endif +# if ((defined _Alignas \ + && !(defined __cplusplus \ + && (201103 <= __cplusplus || defined _MSC_VER))) \ + || (defined __STDC_VERSION__ && 201112 <= __STDC_VERSION__)) +# define alignas _Alignas +# endif +# endif + +# if _GL_STDALIGN_NEEDS_STDDEF +# include # endif #endif]) ]) + +AC_DEFUN([gl_STDALIGN_H], +[ + AC_REQUIRE([gl_ALIGNASOF]) + if test "$gl_cv_header_working_stdalign_h" = no; then + GL_GENERATE_STDALIGN_H=true + else + GL_GENERATE_STDALIGN_H=false + fi + + gl_CHECK_NEXT_HEADERS([stdalign.h]) + if test $ac_cv_header_stdalign_h = yes; then + HAVE_STDALIGN_H=1 + else + HAVE_STDALIGN_H=0 + fi + AC_SUBST([HAVE_STDALIGN_H]) +]) diff --git a/m4/stddef_h.m4 b/m4/stddef_h.m4 index c0553d6f2ff..a2322ebb7ee 100644 --- a/m4/stddef_h.m4 +++ b/m4/stddef_h.m4 @@ -1,4 +1,4 @@ -# stddef_h.m4 serial 12 +# stddef_h.m4 serial 13 dnl Copyright (C) 2009-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -22,7 +22,14 @@ AC_DEFUN_ONCE [gl_cv_type_max_align_t], [AC_COMPILE_IFELSE( [AC_LANG_PROGRAM( - [[#include + [[/* On FreeBSD 12.0/x86, max_align_t defined by has + the correct alignment with the default (wrong) definition of + _Alignof, but a wrong alignment as soon as we activate an + ISO C compliant _Alignof definition. */ + #if ((defined __GNUC__ && 4 <= __GNUC__) || defined __clang__) && !defined __cplusplus + #define _Alignof(type) __builtin_offsetof (struct { char __a; type __b; }, __b) + #endif + #include unsigned int s = sizeof (max_align_t); #if defined __GNUC__ || defined __clang__ || defined __IBM__ALIGNOF__ int check1[2 * (__alignof__ (double) <= __alignof__ (max_align_t)) - 1]; diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4 index e96be22f583..249ef657224 100644 --- a/m4/stdlib_h.m4 +++ b/m4/stdlib_h.m4 @@ -1,4 +1,4 @@ -# stdlib_h.m4 serial 66 +# stdlib_h.m4 serial 71 dnl Copyright (C) 2007-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -23,7 +23,7 @@ AC_DEFUN_ONCE # include #endif ]], [_Exit aligned_alloc atoll canonicalize_file_name free - getloadavg getsubopt grantpt + getloadavg getprogname getsubopt grantpt initstate initstate_r mbtowc mkdtemp mkostemp mkostemps mkstemp mkstemps posix_memalign posix_openpt ptsname ptsname_r qsort_r random random_r reallocarray realpath rpmatch secure_getenv setenv @@ -73,6 +73,7 @@ AC_DEFUN gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_CANONICALIZE_FILE_NAME]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_FREE_POSIX]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_GETLOADAVG]) + gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_GETPROGNAME]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_GETSUBOPT]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_GRANTPT]) gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_MALLOC_GNU]) @@ -130,6 +131,7 @@ AC_DEFUN HAVE_DECL_FCVT=1; AC_SUBST([HAVE_DECL_FCVT]) HAVE_DECL_GCVT=1; AC_SUBST([HAVE_DECL_GCVT]) HAVE_DECL_GETLOADAVG=1; AC_SUBST([HAVE_DECL_GETLOADAVG]) + HAVE_GETPROGNAME=1; AC_SUBST([HAVE_GETPROGNAME]) HAVE_GETSUBOPT=1; AC_SUBST([HAVE_GETSUBOPT]) HAVE_GRANTPT=1; AC_SUBST([HAVE_GRANTPT]) HAVE_INITSTATE=1; AC_SUBST([HAVE_INITSTATE]) @@ -166,17 +168,24 @@ AC_DEFUN HAVE_SYS_LOADAVG_H=0; AC_SUBST([HAVE_SYS_LOADAVG_H]) HAVE_UNLOCKPT=1; AC_SUBST([HAVE_UNLOCKPT]) HAVE_DECL_UNSETENV=1; AC_SUBST([HAVE_DECL_UNSETENV]) + REPLACE__EXIT=0; AC_SUBST([REPLACE__EXIT]) REPLACE_ALIGNED_ALLOC=0; AC_SUBST([REPLACE_ALIGNED_ALLOC]) REPLACE_CALLOC_FOR_CALLOC_GNU=0; AC_SUBST([REPLACE_CALLOC_FOR_CALLOC_GNU]) REPLACE_CALLOC_FOR_CALLOC_POSIX=0; AC_SUBST([REPLACE_CALLOC_FOR_CALLOC_POSIX]) REPLACE_CANONICALIZE_FILE_NAME=0; AC_SUBST([REPLACE_CANONICALIZE_FILE_NAME]) REPLACE_FREE=0; AC_SUBST([REPLACE_FREE]) + REPLACE_GETLOADAVG=0; AC_SUBST([REPLACE_GETLOADAVG]) + REPLACE_GETPROGNAME=0; AC_SUBST([REPLACE_GETPROGNAME]) + REPLACE_GETSUBOPT=0; AC_SUBST([REPLACE_GETSUBOPT]) REPLACE_INITSTATE=0; AC_SUBST([REPLACE_INITSTATE]) REPLACE_MALLOC_FOR_MALLOC_GNU=0; AC_SUBST([REPLACE_MALLOC_FOR_MALLOC_GNU]) REPLACE_MALLOC_FOR_MALLOC_POSIX=0; AC_SUBST([REPLACE_MALLOC_FOR_MALLOC_POSIX]) REPLACE_MBTOWC=0; AC_SUBST([REPLACE_MBTOWC]) + REPLACE_MKOSTEMP=0; AC_SUBST([REPLACE_MKOSTEMP]) + REPLACE_MKOSTEMPS=0; AC_SUBST([REPLACE_MKOSTEMPS]) REPLACE_MKSTEMP=0; AC_SUBST([REPLACE_MKSTEMP]) REPLACE_POSIX_MEMALIGN=0; AC_SUBST([REPLACE_POSIX_MEMALIGN]) + REPLACE_POSIX_OPENPT=0; AC_SUBST([REPLACE_POSIX_OPENPT]) REPLACE_PTSNAME=0; AC_SUBST([REPLACE_PTSNAME]) REPLACE_PTSNAME_R=0; AC_SUBST([REPLACE_PTSNAME_R]) REPLACE_PUTENV=0; AC_SUBST([REPLACE_PUTENV]) diff --git a/m4/stpcpy.m4 b/m4/stpcpy.m4 index e8a76bc34f3..f3acbee7be9 100644 --- a/m4/stpcpy.m4 +++ b/m4/stpcpy.m4 @@ -1,4 +1,4 @@ -# stpcpy.m4 serial 9 +# stpcpy.m4 serial 11 dnl Copyright (C) 2002, 2007, 2009-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -13,9 +13,12 @@ AC_DEFUN AC_REQUIRE([AC_C_RESTRICT]) AC_REQUIRE([gl_STRING_H_DEFAULTS]) - AC_CHECK_FUNCS([stpcpy]) + gl_CHECK_FUNCS_ANDROID([stpcpy], [[#include ]]) if test $ac_cv_func_stpcpy = no; then HAVE_STPCPY=0 + case "$gl_cv_onwards_func_stpcpy" in + future*) REPLACE_STPCPY=1 ;; + esac fi ]) diff --git a/m4/string_h.m4 b/m4/string_h.m4 index 5da3cc25291..7f51391cbff 100644 --- a/m4/string_h.m4 +++ b/m4/string_h.m4 @@ -5,7 +5,7 @@ # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. -# serial 35 +# serial 37 # Written by Paul Eggert. @@ -131,6 +131,8 @@ AC_DEFUN REPLACE_FFSLL=0; AC_SUBST([REPLACE_FFSLL]) REPLACE_MEMCHR=0; AC_SUBST([REPLACE_MEMCHR]) REPLACE_MEMMEM=0; AC_SUBST([REPLACE_MEMMEM]) + REPLACE_MEMPCPY=0; AC_SUBST([REPLACE_MEMPCPY]) + REPLACE_STPCPY=0; AC_SUBST([REPLACE_STPCPY]) REPLACE_STPNCPY=0; AC_SUBST([REPLACE_STPNCPY]) REPLACE_STRCHRNUL=0; AC_SUBST([REPLACE_STRCHRNUL]) REPLACE_STRDUP=0; AC_SUBST([REPLACE_STRDUP]) diff --git a/m4/time_h.m4 b/m4/time_h.m4 index f6bf3a4f30e..b74870c3d0e 100644 --- a/m4/time_h.m4 +++ b/m4/time_h.m4 @@ -2,7 +2,7 @@ # Copyright (C) 2000-2001, 2003-2007, 2009-2023 Free Software Foundation, Inc. -# serial 20 +# serial 21 # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, @@ -170,6 +170,7 @@ AC_DEFUN REPLACE_NANOSLEEP=GNULIB_PORTCHECK; AC_SUBST([REPLACE_NANOSLEEP]) REPLACE_STRFTIME=GNULIB_PORTCHECK; AC_SUBST([REPLACE_STRFTIME]) REPLACE_TIMEGM=GNULIB_PORTCHECK; AC_SUBST([REPLACE_TIMEGM]) + REPLACE_TIMESPEC_GET=GNULIB_PORTCHECK; AC_SUBST([REPLACE_TIMESPEC_GET]) REPLACE_TZSET=GNULIB_PORTCHECK; AC_SUBST([REPLACE_TZSET]) dnl Hack so that the time module doesn't depend on the sys_time module. diff --git a/m4/timegm.m4 b/m4/timegm.m4 index 6079f1a39c8..8ab265e65fe 100644 --- a/m4/timegm.m4 +++ b/m4/timegm.m4 @@ -1,4 +1,4 @@ -# timegm.m4 serial 13 +# timegm.m4 serial 15 dnl Copyright (C) 2003, 2007, 2009-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -9,7 +9,7 @@ AC_DEFUN AC_REQUIRE([gl_TIME_H_DEFAULTS]) AC_REQUIRE([gl_FUNC_MKTIME_WORKS]) REPLACE_TIMEGM=0 - AC_CHECK_FUNCS_ONCE([timegm]) + gl_CHECK_FUNCS_ANDROID([timegm], [[#include ]]) if test $ac_cv_func_timegm = yes; then if test "$gl_cv_func_working_mktime" != yes; then # Assume that timegm is buggy if mktime is. @@ -17,6 +17,9 @@ AC_DEFUN fi else HAVE_TIMEGM=0 + case "$gl_cv_onwards_func_timegm" in + future*) REPLACE_TIMEGM=1 ;; + esac fi ]) diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4 index f4384027e37..1c96158155a 100644 --- a/m4/unistd_h.m4 +++ b/m4/unistd_h.m4 @@ -1,4 +1,4 @@ -# unistd_h.m4 serial 90 +# unistd_h.m4 serial 94 dnl Copyright (C) 2006-2023 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -225,6 +225,7 @@ AC_DEFUN REPLACE_COPY_FILE_RANGE=0; AC_SUBST([REPLACE_COPY_FILE_RANGE]) REPLACE_DUP=0; AC_SUBST([REPLACE_DUP]) REPLACE_DUP2=0; AC_SUBST([REPLACE_DUP2]) + REPLACE_DUP3=0; AC_SUBST([REPLACE_DUP3]) REPLACE_EXECL=0; AC_SUBST([REPLACE_EXECL]) REPLACE_EXECLE=0; AC_SUBST([REPLACE_EXECLE]) REPLACE_EXECLP=0; AC_SUBST([REPLACE_EXECLP]) @@ -234,10 +235,12 @@ AC_DEFUN REPLACE_EXECVPE=0; AC_SUBST([REPLACE_EXECVPE]) REPLACE_FACCESSAT=0; AC_SUBST([REPLACE_FACCESSAT]) REPLACE_FCHOWNAT=0; AC_SUBST([REPLACE_FCHOWNAT]) + REPLACE_FDATASYNC=0; AC_SUBST([REPLACE_FDATASYNC]) REPLACE_FTRUNCATE=0; AC_SUBST([REPLACE_FTRUNCATE]) REPLACE_GETCWD=0; AC_SUBST([REPLACE_GETCWD]) REPLACE_GETDOMAINNAME=0; AC_SUBST([REPLACE_GETDOMAINNAME]) REPLACE_GETDTABLESIZE=0; AC_SUBST([REPLACE_GETDTABLESIZE]) + REPLACE_GETENTROPY=0; AC_SUBST([REPLACE_GETENTROPY]) REPLACE_GETLOGIN_R=0; AC_SUBST([REPLACE_GETLOGIN_R]) REPLACE_GETGROUPS=0; AC_SUBST([REPLACE_GETGROUPS]) REPLACE_GETPAGESIZE=0; AC_SUBST([REPLACE_GETPAGESIZE]) @@ -248,12 +251,14 @@ AC_DEFUN REPLACE_LINK=0; AC_SUBST([REPLACE_LINK]) REPLACE_LINKAT=0; AC_SUBST([REPLACE_LINKAT]) REPLACE_LSEEK=0; AC_SUBST([REPLACE_LSEEK]) + REPLACE_PIPE2=0; AC_SUBST([REPLACE_PIPE2]) REPLACE_PREAD=0; AC_SUBST([REPLACE_PREAD]) REPLACE_PWRITE=0; AC_SUBST([REPLACE_PWRITE]) REPLACE_READ=0; AC_SUBST([REPLACE_READ]) REPLACE_READLINK=0; AC_SUBST([REPLACE_READLINK]) REPLACE_READLINKAT=0; AC_SUBST([REPLACE_READLINKAT]) REPLACE_RMDIR=0; AC_SUBST([REPLACE_RMDIR]) + REPLACE_SETHOSTNAME=0; AC_SUBST([REPLACE_SETHOSTNAME]) REPLACE_SLEEP=0; AC_SUBST([REPLACE_SLEEP]) REPLACE_SYMLINK=0; AC_SUBST([REPLACE_SYMLINK]) REPLACE_SYMLINKAT=0; AC_SUBST([REPLACE_SYMLINKAT]) diff --git a/m4/utimens.m4 b/m4/utimens.m4 index c5d9b69e6f5..5f8606167a6 100644 --- a/m4/utimens.m4 +++ b/m4/utimens.m4 @@ -3,7 +3,7 @@ dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. -dnl serial 12 +dnl serial 15 AC_DEFUN([gl_UTIMENS], [ @@ -11,9 +11,11 @@ AC_DEFUN AC_REQUIRE([gl_FUNC_UTIMES]) AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC]) AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles - AC_CHECK_FUNCS_ONCE([futimens utimensat lutimes]) gl_CHECK_FUNCS_ANDROID([futimes], [[#include ]]) gl_CHECK_FUNCS_ANDROID([futimesat], [[#include ]]) + gl_CHECK_FUNCS_ANDROID([lutimes], [[#include ]]) + gl_CHECK_FUNCS_ANDROID([futimens], [[#include ]]) + gl_CHECK_FUNCS_ANDROID([utimensat], [[#include ]]) if test $ac_cv_func_futimens = no && test $ac_cv_func_futimesat = yes; then dnl FreeBSD 8.0-rc2 mishandles futimesat(fd,NULL,time). It is not diff --git a/m4/utimensat.m4 b/m4/utimensat.m4 index dd210fc989a..1a670bb7b78 100644 --- a/m4/utimensat.m4 +++ b/m4/utimensat.m4 @@ -1,4 +1,4 @@ -# serial 9 +# serial 11 # See if we need to provide utimensat replacement. dnl Copyright (C) 2009-2023 Free Software Foundation, Inc. @@ -13,9 +13,12 @@ AC_DEFUN AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS]) AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles - AC_CHECK_FUNCS_ONCE([utimensat]) + gl_CHECK_FUNCS_ANDROID([utimensat], [[#include ]]) if test $ac_cv_func_utimensat = no; then HAVE_UTIMENSAT=0 + case "$gl_cv_onwards_func_utimensat" in + future*) REPLACE_UTIMENSAT=1 ;; + esac else AC_CACHE_CHECK([whether utimensat works], [gl_cv_func_utimensat_works], commit 7e1c7db1cb5a33a66115bb767224bdc79a257266 Author: Paul Eggert Date: Sat Feb 4 14:24:37 2023 -0800 Prefer https: to git: URIs Prefer https: to git: URIs on Savannah. The idea is to avoid some adversary-in-the-middle attacks on developers. diff --git a/CONTRIBUTE b/CONTRIBUTE index 674b4e5b18c..dcf34f48fe5 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -18,7 +18,7 @@ To configure Git for Emacs development, you can run the following: The following shell commands then build and run Emacs from scratch: - git clone git://git.sv.gnu.org/emacs.git + git clone https://git.savannah.gnu.org/git/emacs.git cd emacs ./autogen.sh ./configure diff --git a/INSTALL.REPO b/INSTALL.REPO index dcbbbcb9594..ea88842cfa9 100644 --- a/INSTALL.REPO +++ b/INSTALL.REPO @@ -4,7 +4,7 @@ The Emacs repository is hosted on Savannah. The following Git command will clone the repository to the 'emacs' subdirectory of the current directory on your local machine: - git clone git://git.sv.gnu.org/emacs.git + git clone https://git.savannah.gnu.org/git/emacs.git To build the repository code, simply run 'make' in the 'emacs' directory. This should work if your files are freshly checked out diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 6e080d1f5bb..1273e9a976b 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -294,7 +294,7 @@ Po Lu Tramp Maintainer: Michael Albinus - Repository: git://git.savannah.gnu.org/tramp.git + Repository: https://git.savannah.gnu.org/git/tramp.git Mailing List: tramp-devel@gnu.org Bug Reports: M-x tramp-bug Notes: For backward compatibility requirements, see @@ -316,7 +316,7 @@ Modus themes Org Mode Home Page: https://orgmode.org/ Maintainer: Org Mode developers - Repository: git://git.sv.gnu.org/emacs/org-mode.git + Repository: https://git.savannah.gnu.org/git/emacs/org-mode.git Mailing list: emacs-orgmode@gnu.org Bug Reports: M-x org-submit-bug-report Notes: Org Mode is maintained as a separate project that is diff --git a/admin/merge-gnulib b/admin/merge-gnulib index f47c5e6e8d4..7f4b6678a94 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -23,7 +23,7 @@ # written by Paul Eggert -GNULIB_URL=git://git.savannah.gnu.org/gnulib.git +GNULIB_URL=https://git.savannah.gnu.org/git/gnulib.git GNULIB_MODULES=' alloca-opt binary-io byteswap c-ctype c-strcase diff --git a/admin/notes/elpa b/admin/notes/elpa index 1e9e7a9f52b..afcda71d1dd 100644 --- a/admin/notes/elpa +++ b/admin/notes/elpa @@ -3,7 +3,7 @@ NOTES ON THE EMACS PACKAGE ARCHIVE The GNU Emacs package archive, at elpa.gnu.org, is managed using a Git repository named "elpa", hosted on Savannah. To check it out: - git clone git://git.sv.gnu.org/emacs/elpa + git clone https://git.savannah.gnu.org/git/emacs/elpa cd elpa make setup diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index a8a59f982fc..d344feb2d63 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -361,7 +361,7 @@ Obtaining @value{tramp} @example @group $ cd ~/emacs -$ git clone git://git.savannah.gnu.org/tramp.git +$ git clone https://git.savannah.gnu.org/git/tramp.git @end group @end example diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index fa576fb4d7f..fe5f74e3209 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -115,7 +115,7 @@ put the Emacs source into C:\emacs\emacs-master: mkdir /c/emacs cd /c/emacs - git clone git://git.sv.gnu.org/emacs.git emacs-master + git clone https://git.savannah.gnu.org/git/emacs.git emacs-master This will produce the development sources, i.e. the master branch of the Emacs Git repository, in the directory C:\emacs\emacs-master. commit 69380a88e9292a08822eeef972d8ace639e15519 Author: Dmitry Gutov Date: Sat Feb 4 22:46:41 2023 +0200 c-ts-mode: Highlight name in parameter declarations * lisp/progmodes/c-ts-mode.el (c-ts-mode--font-lock-settings): Uncomment parameter declaration highlighting (bug#61275). (c-ts-mode--fontify-declarator): Check that identifier was found. Some declarations can miss identifier name. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 390f67a8e8c..2a164af26ea 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -440,11 +440,10 @@ c-ts-mode--font-lock-settings declarator: (_) @c-ts-mode--fontify-declarator) (function_definition - declarator: (_) @c-ts-mode--fontify-declarator)) + declarator: (_) @c-ts-mode--fontify-declarator) - ;; Should we highlight identifiers in the parameter list? - ;; (parameter_declaration - ;; declarator: (_) @c-ts-mode--fontify-declarator)) + (parameter_declaration + declarator: (_) @c-ts-mode--fontify-declarator)) :language mode :feature 'assignment @@ -552,9 +551,10 @@ c-ts-mode--fontify-declarator identifier))) ("function_declarator" 'font-lock-function-name-face) (_ 'font-lock-variable-name-face)))) - (treesit-fontify-with-override - (treesit-node-start identifier) (treesit-node-end identifier) - face override start end))) + (when identifier + (treesit-fontify-with-override + (treesit-node-start identifier) (treesit-node-end identifier) + face override start end)))) (defun c-ts-mode--fontify-variable (node override start end &rest _) "Fontify an identifier node if it is a variable. commit 89b550eac2909f1fcd7cc5eb3dfe81e853bf5ed0 Author: Davide Masserut Date: Thu Feb 2 21:00:02 2023 +0100 Fix switch statement indentation for go-ts-mode (bug#61238) * lisp/progmodes/go-ts-mode.el (go-ts-mode--indent-rules): Add indentation for type switch and select case blocks * test/lisp/progmodes/go-ts-mode-resources/indent.erts: New .erts file to test indentation of Go constructs and prevent regression of bug fixes. * test/lisp/progmodes/go-ts-mode-tests.el: New file with go-ts-mode tests. diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 5f3e1ea3e68..95dcf653fc6 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -72,6 +72,7 @@ go-ts-mode--indent-rules ((node-is "labeled_statement") no-indent) ((parent-is "argument_list") parent-bol go-ts-mode-indent-offset) ((parent-is "block") parent-bol go-ts-mode-indent-offset) + ((parent-is "communication_case") parent-bol go-ts-mode-indent-offset) ((parent-is "const_declaration") parent-bol go-ts-mode-indent-offset) ((parent-is "default_case") parent-bol go-ts-mode-indent-offset) ((parent-is "expression_case") parent-bol go-ts-mode-indent-offset) @@ -82,7 +83,10 @@ go-ts-mode--indent-rules ((parent-is "labeled_statement") parent-bol go-ts-mode-indent-offset) ((parent-is "literal_value") parent-bol go-ts-mode-indent-offset) ((parent-is "parameter_list") parent-bol go-ts-mode-indent-offset) + ((parent-is "select_statement") parent-bol 0) + ((parent-is "type_case") parent-bol go-ts-mode-indent-offset) ((parent-is "type_spec") parent-bol go-ts-mode-indent-offset) + ((parent-is "type_switch_statement") parent-bol 0) ((parent-is "var_declaration") parent-bol go-ts-mode-indent-offset) (no-node parent-bol 0))) "Tree-sitter indent rules for `go-ts-mode'.") diff --git a/test/lisp/progmodes/go-ts-mode-resources/indent.erts b/test/lisp/progmodes/go-ts-mode-resources/indent.erts new file mode 100644 index 00000000000..a89d69b307c --- /dev/null +++ b/test/lisp/progmodes/go-ts-mode-resources/indent.erts @@ -0,0 +1,47 @@ +Code: + (lambda () + (go-ts-mode) + (indent-region (point-min) (point-max))) + +Point-Char: | + +Name: Basic + +=-= +package main + +func main() { +} +=-=-= + +Name: Switch and Select + +=-= +package main + +func main() { + var x any + switch x { + case 1: + println("one") + default: + println("default case") + } + + switch x.(type) { + case int: + println("integer") + default: + println("don't know the type") + } + + var c chan int + select { + case x := <-c: + println(x) + default: + println("no communication") + } +} + +=-=-= diff --git a/test/lisp/progmodes/go-ts-mode-tests.el b/test/lisp/progmodes/go-ts-mode-tests.el new file mode 100644 index 00000000000..548465208f9 --- /dev/null +++ b/test/lisp/progmodes/go-ts-mode-tests.el @@ -0,0 +1,31 @@ +;;; go-ts-mode-tests.el --- Tests for Tree-sitter-based Go mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'treesit) + +(ert-deftest go-ts-mode-test-indentation () + (skip-unless (treesit-ready-p 'go)) + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(provide 'go-ts-mode-tests) +;;; go-ts-mode-tests.el ends here commit c39c26e33f6bb45479bbd1a80df8c97cf750a56a Author: Stefan Monnier Date: Sat Feb 4 11:23:31 2023 -0500 nadvice: Fix bug#61179 Advising interactive forms relies on the ability to distinguish interactive forms that do nothing else than return a function. So, be careful to preserve this info. Furthermore, interactive forms are expected to be evaluated in the lexical context captured by the closure to which they belong, so be careful to preserve that context when manipulating those forms. * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyze-form) : Preserve the info that an interactive form does nothing else than return a function. * lisp/emacs-lisp/nadvice.el (advice--interactive-form-1): New function. (advice--interactive-form): Use it. (advice--make-interactive-form): Refine to also accept function values quoted with `quote`. Remove obsolete TODO. * test/lisp/emacs-lisp/nadvice-tests.el: Don't disallow byte-compilation. (advice-test-bug61179): New test. * lisp/emacs-lisp/oclosure.el (cconv--interactive-helper): Allow the `if` arg to be a form. * lisp/simple.el (oclosure-interactive-form): Adjust accordingly. diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index e715bd90a00..e4268c2fb88 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -483,10 +483,13 @@ cconv-convert (bf (if (stringp (car body)) (cdr body) body)) (if (when (eq 'interactive (car-safe (car bf))) (gethash form cconv--interactive-form-funs))) + (wrapped (pcase if (`#'(lambda (_cconv--dummy) .,_) t) (_ nil))) (cif (when if (cconv-convert if env extend))) (_ (pcase cif - (`#'(lambda () ,form) (setf (cadr (car bf)) form) (setq cif nil)) ('nil nil) + (`#',f + (setf (cadr (car bf)) (if wrapped (nth 2 f) f)) + (setq cif nil)) ;; The interactive form needs special treatment, so the form ;; inside the `interactive' won't be used any further. (_ (setf (cadr (car bf)) nil)))) @@ -494,7 +497,8 @@ cconv-convert (if (not cif) ;; Normal case, the interactive form needs no special treatment. cf - `(cconv--interactive-helper ,cf ,cif)))) + `(cconv--interactive-helper + ,cf ,(if wrapped cif `(list 'quote ,cif)))))) (`(internal-make-closure . ,_) (byte-compile-report-error @@ -742,7 +746,8 @@ cconv-analyze-form (when (eq 'interactive (car-safe (car bf))) (let ((if (cadr (car bf)))) (unless (macroexp-const-p if) ;Optimize this common case. - (let ((f `#'(lambda () ,if))) + (let ((f (if (eq 'function (car-safe if)) if + `#'(lambda (_cconv--dummy) ,if)))) (setf (gethash form cconv--interactive-form-funs) f) (cconv-analyze-form f env)))))) (cconv--analyze-function vrs body-forms env form)) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 85934d9ed0a..e457387acc9 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -178,20 +178,38 @@ advice-eval-interactive-spec ;; ((functionp spec) (funcall spec)) (t (eval spec)))) +(defun advice--interactive-form-1 (function) + "Like `interactive-form' but preserves the static context if needed." + (let ((if (interactive-form function))) + (if (or (null if) (not (eq 'closure (car-safe function)))) + if + (cl-assert (eq 'interactive (car if))) + (let ((form (cadr if))) + (if (macroexp-const-p form) + if + ;; The interactive is expected to be run in the static context + ;; that the function captured. + (let ((ctx (nth 1 function))) + `(interactive + ,(let* ((f (if (eq 'function (car-safe form)) (cadr form) form))) + ;; If the form jut returns a function, preserve the fact that + ;; it just returns a function, which is an info we use in + ;; `advice--make-interactive-form'. + (if (eq 'lambda (car-safe f)) + `',(eval form ctx) + `(eval ',form ',ctx)))))))))) + (defun advice--interactive-form (function) "Like `interactive-form' but tries to avoid autoloading functions." (if (not (and (symbolp function) (autoloadp (indirect-function function)))) - (interactive-form function) + (advice--interactive-form-1 function) (when (commandp function) `(interactive (advice-eval-interactive-spec - (cadr (interactive-form ',function))))))) + (cadr (advice--interactive-form-1 ',function))))))) (defun advice--make-interactive-form (iff ifm) - ;; TODO: make it so that interactive spec can be a constant which - ;; dynamically checks the advice--car/cdr to do its job. - ;; For that, advice-eval-interactive-spec needs to be more faithful. (let* ((fspec (cadr iff))) - (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda? + (when (memq (car-safe fspec) '(function quote)) ;; Macroexpanded lambda? (setq fspec (eval fspec t))) (if (functionp fspec) `(funcall ',fspec ',(cadr ifm)) diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index f5a150ac4ae..40f1f54eed0 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -568,7 +568,7 @@ oclosure--mut-setter-prototype (defun cconv--interactive-helper (fun if) "Add interactive \"form\" IF to FUN. Returns a new command that otherwise behaves like FUN. -IF should actually not be a form but a function of no arguments." +IF can be an ELisp form to be interpreted or a function of no arguments." (oclosure-lambda (cconv--interactive-helper (fun fun) (if if)) (&rest args) (apply (if (called-interactively-p 'any) diff --git a/lisp/simple.el b/lisp/simple.el index 22aa043069f..bed6dfb8292 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2738,7 +2738,8 @@ oclosure-interactive-form nil) (cl-defmethod oclosure-interactive-form ((f cconv--interactive-helper)) - `(interactive (funcall ',(cconv--interactive-helper--if f)))) + (let ((if (cconv--interactive-helper--if f))) + `(interactive ,(if (functionp if) `(funcall ',if) if)))) (defun command-execute (cmd &optional record-flag keys special) ;; BEWARE: Called directly from the C code. diff --git a/test/lisp/emacs-lisp/nadvice-tests.el b/test/lisp/emacs-lisp/nadvice-tests.el index 748d42f2120..987483f00b1 100644 --- a/test/lisp/emacs-lisp/nadvice-tests.el +++ b/test/lisp/emacs-lisp/nadvice-tests.el @@ -213,8 +213,16 @@ advice-test-print (should (equal (cl-prin1-to-string (car x)) "#f(advice first :before #f(advice car :after cdr))")))) -;; Local Variables: -;; no-byte-compile: t -;; End: +(ert-deftest advice-test-bug61179 () + (let* ((magic 42) + (ad (lambda (&rest _) + (interactive (lambda (is) + (cons magic (advice-eval-interactive-spec is)))) + nil)) + (sym (make-symbol "adtest"))) + (defalias sym (lambda (&rest args) (interactive (list 'main)) args)) + (should (equal (call-interactively sym) '(main))) + (advice-add sym :before ad) + (should (equal (call-interactively sym) '(42 main))))) ;;; nadvice-tests.el ends here commit 1a123feb1815d6a2ee4ba6abb747fb62fd8b9e0f Author: Eli Zaretskii Date: Sat Feb 4 13:34:42 2023 +0200 Fix bidi reordering of sequence of whitespace characters before a TAB * src/bidi.c (bidi_level_of_next_char): Test the current level only for characters whose original type is BN. (Bug#61269) diff --git a/src/bidi.c b/src/bidi.c index e01251263be..93875d243e4 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -3300,12 +3300,15 @@ bidi_level_of_next_char (struct bidi_it *bidi_it) it belongs to a sequence of WS characters preceding a newline or a TAB or a paragraph separator. */ if ((bidi_it->orig_type == NEUTRAL_WS - || bidi_it->orig_type == WEAK_BN + || (bidi_it->orig_type == WEAK_BN + /* If this BN character is already at base level, we don't + need to consider resetting it, since I1 and I2 below + will not change the level, so avoid the potentially + costly loop below. */ + && level != bidi_it->level_stack[0].level) || bidi_isolate_fmt_char (bidi_it->orig_type)) - && bidi_it->next_for_ws.charpos < bidi_it->charpos - /* If this character is already at base level, we don't need to - reset it, so avoid the potentially costly loop below. */ - && level != bidi_it->level_stack[0].level) + /* This means the informaition about WS resolution is not valid. */ + && bidi_it->next_for_ws.charpos < bidi_it->charpos) { int ch; ptrdiff_t clen = bidi_it->ch_len; @@ -3340,7 +3343,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it) || bidi_it->orig_type == NEUTRAL_S || bidi_it->ch == '\n' || bidi_it->ch == BIDI_EOB || ((bidi_it->orig_type == NEUTRAL_WS - || bidi_it->orig_type == WEAK_BN + || bidi_it->orig_type == WEAK_BN /* L1/Retaining */ || bidi_isolate_fmt_char (bidi_it->orig_type) || bidi_explicit_dir_char (bidi_it->ch)) && (bidi_it->next_for_ws.type == NEUTRAL_B commit 229d0772e235f51812ed8020a31f9a8de366c7ba Author: Theodor Thornhill Date: Fri Feb 3 09:09:49 2023 +0100 Add test for java indentation (bug#61115) * test/lisp/progmodes/java-ts-mode-resources/indent.erts: Add new test case. diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts b/test/lisp/progmodes/java-ts-mode-resources/indent.erts index e59d5fed8e8..c8e0ac71708 100644 --- a/test/lisp/progmodes/java-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts @@ -42,3 +42,12 @@ if (x) { return; } =-=-= + +Name: Field declaration without access modifier (bug#61115) + +=-= +public class T { + @Autowired + String a; +} +=-=-= commit 8870b54db995e4e8fc6ecfcdd85c4b0e6545dd29 Author: Theodor Thornhill Date: Fri Feb 3 09:05:13 2023 +0100 Add tests for compilation support for TypeScript (bug#61104) * test/lisp/progmodes/compile-tests.el (compile-tests--test-regexps-data): Add new test-cases. (compile-test-error-regexps): Increase expected errors diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 53dc7f2a133..078eef36774 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -382,6 +382,10 @@ compile-tests--test-regexps-data ;; sun-ada (sun-ada "/home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: \",\" inserted" 1 6 361 "/home3/xdhar/rcds_rc/main.a") + (typescript-tsc-plain "/home/foo/greeter.ts(30,12): error TS2339: Property 'foo' does not exist." + 1 12 30 "/home/foo/greeter.ts") + (typescript-tsc-pretty "src/resources/document.ts:140:22 - error TS2362: something." + 1 22 140 "src/resources/document.ts") ;; 4bsd (edg-1 "/usr/src/foo/foo.c(8): warning: w may be used before set" 1 nil 8 "/usr/src/foo/foo.c") @@ -495,7 +499,7 @@ compile-test-error-regexps (compilation-num-warnings-found 0) (compilation-num-infos-found 0)) (mapc #'compile--test-error-line compile-tests--test-regexps-data) - (should (eq compilation-num-errors-found 98)) + (should (eq compilation-num-errors-found 100)) (should (eq compilation-num-warnings-found 35)) (should (eq compilation-num-infos-found 28))))) commit 873a0a15085629ac54fdee609c82b66583e3aefc Author: Jostein Kjønigsen Date: Sat Jan 28 15:23:11 2023 +0100 Add support for TypeScript compilation to compile.el (bug#61104) * lisp/progmodes/compile.el (compilation-error-regexp-alist-alist): Add regexps. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 5758eadf996..1e57d0b7bb2 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -649,6 +649,24 @@ compilation-error-regexp-alist-alist ;; we do not know what lines will follow. (guile-file "^In \\(.+\\..+\\):\n" 1 nil nil 0) (guile-line "^ *\\([0-9]+\\): *\\([0-9]+\\)" nil 1 2) + + ;; Typescript compilation prior to tsc version 2.7, "plain" format: + ;; greeter.ts(30,12): error TS2339: Property 'foo' does not exist. + (typescript-tsc-plain + ,(concat + "^[[:blank:]]*" + "\\([^(\r\n)]+\\)(\\([0-9]+\\),\\([0-9]+\\)):[[:blank:]]+" + "error [[:alnum:]]+: [^\r\n]+$") + 1 2 3 2) + + ;; Typescript compilation after tsc version 2.7, "pretty" format: + ;; src/resources/document.ts:140:22 - error TS2362: something. + (typescript-tsc-pretty + ,(concat + "^[[:blank:]]*" + "\\([^(\r\n)]+\\):\\([0-9]+\\):\\([0-9]+\\) - [[:blank:]]*" + "error [[:alnum:]]+: [^\r\n]+$") + 1 2 3 2) )) "Alist of values for `compilation-error-regexp-alist'.") commit 3a64f81ebc153ad26331d9d43659a56bed3247bd Author: Eli Zaretskii Date: Sat Feb 4 10:15:18 2023 +0200 Don't clobber match data in 'y-or-n-p' * lisp/subr.el (y-or-n-p): Avoid clobbering caller's match data. (Bug#61091) diff --git a/lisp/subr.el b/lisp/subr.el index 0f754fcd31f..32c997425cf 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3573,12 +3573,14 @@ y-or-n-p (if (or (zerop l) (eq ?\s (aref prompt (1- l)))) "" " ") (if dialog "" - (substitute-command-keys - (if help-form - (format "(\\`y', \\`n' or \\`%s') " - (key-description - (vector help-char))) - "(\\`y' or \\`n') "))))))) + ;; Don't clobber caller's match data. + (save-match-data + (substitute-command-keys + (if help-form + (format "(\\`y', \\`n' or \\`%s') " + (key-description + (vector help-char))) + "(\\`y' or \\`n') ")))))))) ;; Preserve the actual command that eventually called ;; `y-or-n-p' (otherwise `repeat' will be repeating ;; `exit-minibuffer'). commit 4c765d93ab3dd646c1b9722bdd5a91da525d06f2 Author: Dmitry Gutov Date: Sat Feb 4 04:16:55 2023 +0200 Refine the previous change * lisp/progmodes/ruby-ts-mode.el (ruby-ts--s-p-query): Fix a typo. (ruby-ts--syntax-propertize): Use pcase-exhaustive to avoid typos. Put the last s-t property after heredoc's end (apparently parse-partial-sexp likes that more). Move first s-t property on percent literals to the very beginning (to be refined later). Differentiate the %r{} literals from /.../ ones -- tree-sitter parses them exactly the same. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 02cc1aad5e6..c0971193244 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1026,7 +1026,7 @@ ruby-ts--s-p-query ;; Backtick method redefinition. ((operator "`" @backtick)) ;; TODO: Stop at interpolations. - ((regex "/" @regex-slash)) + ((regex "/" @regex_slash)) ;; =begin...=end ((comment) @comm (:match "\\`=" @comm)) @@ -1037,10 +1037,16 @@ ruby-ts--s-p-query (defun ruby-ts--syntax-propertize (beg end) (let ((captures (treesit-query-capture 'ruby ruby-ts--s-p-query beg end))) (pcase-dolist (`(,name . ,node) captures) - (pcase name + (pcase-exhaustive name ('regex_slash - (put-text-property (treesit-node-start node) (treesit-node-end node) - 'syntax-table (string-to-syntax "\"/"))) + ;; N.B.: A regexp literal with modifiers actually includes them in + ;; the trailing "/" node. + (put-text-property (treesit-node-start node) (1+ (treesit-node-start node)) + 'syntax-table + ;; Differentiate the %r{...} literals. + (if (eq ?/ (char-after (treesit-node-start node))) + (string-to-syntax "\"/") + (string-to-syntax "|")))) ('ident (put-text-property (1- (treesit-node-end node)) (treesit-node-end node) 'syntax-table (string-to-syntax "_"))) @@ -1050,10 +1056,11 @@ ruby-ts--syntax-propertize ('heredoc (put-text-property (treesit-node-start node) (1+ (treesit-node-start node)) 'syntax-table (string-to-syntax "\"")) - (put-text-property (1- (treesit-node-end node)) (treesit-node-end node) + (put-text-property (treesit-node-end node) (1+ (treesit-node-end node)) 'syntax-table (string-to-syntax "\""))) ('percent - (put-text-property (1+ (treesit-node-start node)) (+ 2 (treesit-node-start node)) + ;; TODO: Put the first one on the first paren in both %Q{} and %(). + (put-text-property (treesit-node-start node) (1+ (treesit-node-start node)) 'syntax-table (string-to-syntax "|")) (put-text-property (1- (treesit-node-end node)) (treesit-node-end node) 'syntax-table (string-to-syntax "|"))) commit d99b5151f8c41d45084d10c49c86d6c228d5f730 Author: Dmitry Gutov Date: Sat Feb 4 03:34:22 2023 +0200 Add syntax-propertize-function to ruby-ts-mode * lisp/progmodes/ruby-ts-mode.el (ruby-ts--s-p-query): New variable. (ruby-ts--syntax-propertize): New function. (ruby-ts--parser-after-change): New function. (ruby-ts-mode): Use both of them. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 7725d0824e3..02cc1aad5e6 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -95,6 +95,11 @@ (declare-function treesit-node-end "treesit.c") (declare-function treesit-node-start "treesit.c") (declare-function treesit-node-string "treesit.c") +(declare-function treesit-query-compile "treesit.c") +(declare-function treesit-query-capture "treesit.c") +(declare-function treesit-parser-add-notifier "treesit.c") +(declare-function treesit-parser-buffer "treesit.c") +(declare-function treesit-parser-list "treesit.c") (defgroup ruby-ts nil "Major mode for editing Ruby code." @@ -1002,6 +1007,70 @@ ruby-ts-add-log-current-function (concat result sep method-name) result))) +(defvar ruby-ts--s-p-query + (when (treesit-available-p) + (treesit-query-compile 'ruby + '(((heredoc_body) @heredoc) + ;; $' $" $`. + ((global_variable) @global_var + (:match "\\`\\$[#\"'`:?]" @global_var)) + ;; ?' ?" ?` are character literals. + ((character) @char + (:match "\\`?[#\"'`:?]" @char)) + ;; Symbols like :+, :<=> or :foo=. + ((simple_symbol) @symbol + (:match "[[:punct:]]" @symbol)) + ;; Method calls with name ending with ? or !. + ((call method: (identifier) @ident) + (:match "[?!]\\'" @ident)) + ;; Backtick method redefinition. + ((operator "`" @backtick)) + ;; TODO: Stop at interpolations. + ((regex "/" @regex-slash)) + ;; =begin...=end + ((comment) @comm + (:match "\\`=" @comm)) + ;; Percent literals: %w[], %q{}, ... + ((string) @percent + (:match "\\`%" @percent)))))) + +(defun ruby-ts--syntax-propertize (beg end) + (let ((captures (treesit-query-capture 'ruby ruby-ts--s-p-query beg end))) + (pcase-dolist (`(,name . ,node) captures) + (pcase name + ('regex_slash + (put-text-property (treesit-node-start node) (treesit-node-end node) + 'syntax-table (string-to-syntax "\"/"))) + ('ident + (put-text-property (1- (treesit-node-end node)) (treesit-node-end node) + 'syntax-table (string-to-syntax "_"))) + ('symbol + (put-text-property (1+ (treesit-node-start node)) (treesit-node-end node) + 'syntax-table (string-to-syntax "_"))) + ('heredoc + (put-text-property (treesit-node-start node) (1+ (treesit-node-start node)) + 'syntax-table (string-to-syntax "\"")) + (put-text-property (1- (treesit-node-end node)) (treesit-node-end node) + 'syntax-table (string-to-syntax "\""))) + ('percent + (put-text-property (1+ (treesit-node-start node)) (+ 2 (treesit-node-start node)) + 'syntax-table (string-to-syntax "|")) + (put-text-property (1- (treesit-node-end node)) (treesit-node-end node) + 'syntax-table (string-to-syntax "|"))) + ((or 'global_var 'char) + (put-text-property (treesit-node-start node) (1+ (treesit-node-start node)) + 'syntax-table (string-to-syntax "'")) + (put-text-property (1+ (treesit-node-start node)) (treesit-node-end node) + 'syntax-table (string-to-syntax "_"))) + ('backtick + (put-text-property (treesit-node-start node) (treesit-node-end node) + 'syntax-table (string-to-syntax "_"))) + ('comm + (dolist (pos (list (treesit-node-start node) + (1- (treesit-node-end node)))) + (put-text-property pos (1+ pos) 'syntax-table + (string-to-syntax "!")))))))) + (defvar-keymap ruby-ts-mode-map :doc "Keymap used in Ruby mode" :parent prog-mode-map @@ -1049,7 +1118,21 @@ ruby-ts-mode interpolation literal symbol assignment) ( bracket error function operator punctuation))) - (treesit-major-mode-setup)) + (treesit-major-mode-setup) + + (treesit-parser-add-notifier (car (treesit-parser-list)) + #'ruby-ts--parser-after-change) + + (setq-local syntax-propertize-function #'ruby-ts--syntax-propertize)) + +(defun ruby-ts--parser-after-change (ranges parser) + ;; Make sure we re-syntax-propertize the full node that is being + ;; edited. This is most pertinent to multi-line complex nodes such + ;; as heredocs. + (when ranges + (with-current-buffer (treesit-parser-buffer parser) + (syntax-ppss-flush-cache (cl-loop for r in ranges + minimize (car r)))))) (if (treesit-ready-p 'ruby) ;; Copied from ruby-mode.el. commit 0a95a81d8d36722ccf030a6194ecd953fc257a59 Author: Alan Mackenzie Date: Fri Feb 3 20:55:59 2023 +0000 CC Mode: Fontify a certain foo * bar class by the asymmetric space heuristic This fixes bug #61144. If the space around the * is "symmetric" we leave foo * bar unfontified, a multiplication operation. If it is "asymmetric" we fontify it as a pointer declaration. * lisp/progmodes/cc-engine.el (c-fdoc-assymetric-space-about-asterisk): New macro, extracted from c-forward-decl-or-cast-1. (c-forward-decl-or-cast-1): Invoke the new macro twice, in CASE 16 (new) and CASE 17.5 (the source of the macro). In CASE 16, additionally set unsafe-maybe when appropriate. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index f1e93c1c23c..86bc35baa7c 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -10146,6 +10146,24 @@ c-fdoc-shift-type-backward ;; This identifier is bound only in the inner let. '(setq start id-start)))) +(defmacro c-fdoc-assymetric-space-about-asterisk () + ;; We've got a "*" at `id-start' between two identifiers, the first at + ;; `type-start'. Return non-nil when there is either whitespace between the + ;; first id and the "*" or between the "*" and the second id, but not both. + `(let ((space-before-id + (save-excursion + (goto-char id-start) ; Position of "*". + (and (> (skip-chars-forward "* \t\n\r") 0) + (memq (char-before) '(?\ ?\t ?\n ?\r))))) + (space-after-type + (save-excursion + (goto-char type-start) + (and (c-forward-type nil t) + (or (eolp) + (memq (char-after) '(?\ ?\t))))))) + (not (eq (not space-before-id) + (not space-after-type))))) + (defun c-forward-decl-or-cast-1 (preceding-token-end context last-cast-end &optional inside-macro) ;; Move forward over a declaration or a cast if at the start of one. @@ -11166,19 +11184,25 @@ c-forward-decl-or-cast-1 ;; CASE 16 (when (and got-prefix-before-parens at-type - (or at-decl-end (looking-at "=[^=]")) (memq context '(nil top)) (or (not got-suffix) at-decl-start)) ;; Got something like "foo * bar;". Since we're not inside ;; an arglist it would be a meaningless expression because ;; the result isn't used. We therefore choose to recognize - ;; it as a declaration. We only allow a suffix (which makes - ;; the construct look like a function call) when - ;; `at-decl-start' provides additional evidence that we do - ;; have a declaration. + ;; it as a declaration when there's "symmetrical WS" around + ;; the "*" or the flag `c-assymetry-fontification-flag' is + ;; not set. We only allow a suffix (which makes the + ;; construct look like a function call) when `at-decl-start' + ;; provides additional evidence that we do have a + ;; declaration. (setq maybe-expression t) - (throw 'at-decl-or-cast t)) + (when (or (not c-asymmetry-fontification-flag) + (looking-at "=[^=]") + (c-fdoc-assymetric-space-about-asterisk)) + (when (eq at-type 'maybe) + (setq unsafe-maybe t)) + (throw 'at-decl-or-cast t))) ;; CASE 17 (when (and (or got-suffix-after-parens @@ -11197,24 +11221,12 @@ c-forward-decl-or-cast-1 got-prefix-before-parens at-type (or (not got-suffix) - at-decl-start)) - (let ((space-before-id - (save-excursion - (goto-char id-start) ; Position of "*". - (and (> (skip-chars-forward "* \t\n\r") 0) - (memq (char-before) '(?\ ?\t ?\n ?\r))))) - (space-after-type - (save-excursion - (goto-char type-start) - (and (c-forward-type nil t) - (or (eolp) - (memq (char-after) '(?\ ?\t))))))) - (when (not (eq (not space-before-id) - (not space-after-type))) - (when (eq at-type 'maybe) - (setq unsafe-maybe t)) - (setq maybe-expression t) - (throw 'at-decl-or-cast t))))) + at-decl-start) + (c-fdoc-assymetric-space-about-asterisk)) + (when (eq at-type 'maybe) + (setq unsafe-maybe t)) + (setq maybe-expression t) + (throw 'at-decl-or-cast t))) ;; CASE 18 (when (and at-decl-end commit f25c15ceb7d9b26cc8b93648730571187ef36c85 Author: Stefan Kangas Date: Fri Feb 3 18:02:53 2023 +0100 ; Fix typos diff --git a/admin/notes/tree-sitter/treesit_record_change b/admin/notes/tree-sitter/treesit_record_change index bb0f9edc353..0dc6491e2d1 100644 --- a/admin/notes/tree-sitter/treesit_record_change +++ b/admin/notes/tree-sitter/treesit_record_change @@ -5,7 +5,7 @@ buffer, lest tree-sitter's parse tree would be corrupted/out of sync. All buffer changes in Emacs are made through functions in insdel.c (and casefiddle.c), I augmented functions in those files with calls to -treesit_record_change. Below is a manifest of all the relavent +treesit_record_change. Below is a manifest of all the relevant functions in insdel.c as of Emacs 29: Function Calls diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el index 89e9cec6fcd..4f87ffd0e22 100644 --- a/lisp/display-line-numbers.el +++ b/lisp/display-line-numbers.el @@ -164,7 +164,7 @@ header-line-indent--window-scroll-function ;;;###autoload (define-minor-mode header-line-indent-mode "Minor mode to help with alignment of header line when line numbers are shown. -This minor mode should be turned on in buffers which dispay header-line +This minor mode should be turned on in buffers which display header-line that needs to be aligned with buffer text when `display-line-numbers-mode' is turned on in the buffer. commit 35e238cae8b017486dd2d2a52d0b31af6a167689 Author: Eli Zaretskii Date: Fri Feb 3 16:45:56 2023 +0200 Improve documentation of 'header-line-indent-mode' * doc/lispref/modes.texi (Header Lines): Rewrite the documentation of 'header-line-indent-mode' and its two variables. Fix the example. * doc/lispref/display.texi (Pixel Specification): More accurate description of what happens with :align-to in header-lines. Improve indexing. (Bug#61239) * src/buffer.c (syms_of_buffer) : * lisp/display-line-numbers.el (header-line-indent) (header-line-indent-width, header-line-indent-mode): Doc fixes. * etc/NEWS: Enhance the announcement of 'header-line-indent-mode'. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 5a9a9f95f7b..c5374e1481a 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5285,9 +5285,10 @@ Pixel Specification The @code{left}, @code{center}, and @code{right} positions can be used with @code{:align-to} to specify a position relative to the left edge, center, or right edge of the text area. When the window -displays line numbers, the @code{left} and the @code{center} positions -are offset to account for the screen space taken by the line-number -display. +displays line numbers, and @code{:align-to} is used in display +properties of buffer text (as opposed to header line, see below), the +@code{left} and the @code{center} positions are offset to account for +the screen space taken by the line-number display. Any of the above window elements (except @code{text}) can also be used with @code{:align-to} to specify that the position is relative to @@ -5301,11 +5302,11 @@ Pixel Specification :align-to (+ left-margin (0.5 . left-margin)) @end example - If no specific base offset is set for alignment, it is always relative -to the left edge of the text area. For example, @samp{:align-to 0} in a -header-line aligns with the first text column in the text area. When -the window displays line numbers, the text is considered to start where -the space used for line-number display ends. + If no specific base offset is set for alignment, it is always +relative to the left edge of the text area. For example, +@samp{:align-to 0} aligns with the first text column in the text area. +When the window displays line numbers, the text is considered to start +where the space used for line-number display ends. A value of the form @code{(@var{num} . @var{expr})} stands for the product of the values of @var{num} and @var{expr}. For example, @@ -5317,6 +5318,35 @@ Pixel Specification expressions. The form @code{(- @var{expr} ...)} negates or subtracts the value of the expressions. +@vindex header-line-format@r{, and } :align-to +@cindex aligning header line, when line numbers are displayed +@cindex header line alignment when line numbers are displayed + Text shown in the header line that uses @code{:align-to} display +specifications is not automatically realigned when +@code{display-line-numbers-mode} is turned on and off, or when the +width of line numbers on display changes. To arrange for the +header-line text alignment to be updated, thus keeping the header-line +text aligned with the buffer text, turn on the +@code{header-line-indent-mode} in the buffer and use its two +variables, @code{header-line-indent} and +@code{header-line-indent-width}, in the display specification. +@xref{Header Lines}. Here's a simple example: + +@lisp +(setq header-line-format + (concat (propertize " " + 'display + '(space :align-to + (+ header-line-indent-width 10))) + "Column")) +@end lisp + +@noindent +This will keep the text @samp{Column} on the header line aligned with +column 10 of buffer text, regardless of whether +@code{display-line-numbers-mode} is on or off, and also when +line-number display changes its width. + @node Other Display Specs @subsection Other Display Specifications diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index fe5eb8a1b8d..750c4b47894 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -2578,21 +2578,70 @@ Header Lines is the same as for @code{mode-line-format} (@pxref{Mode Line Data}). It is normally @code{nil}, so that ordinary buffers have no header line. +@end defvar + +If @code{display-line-numbers-mode} is turned on in a buffer +(@pxref{Display Custom, display-line-numbers-mode,, emacs, The GNU +Emacs Manual}), the buffer text is indented on display by the amount +of screen space needed to show the line numbers. By contrast, text of +the header line is not automatically indented, because a header line +never displays a line number, and because the text of the header line +is not necessarily directly related to buffer text below it. If a +Lisp program needs the header-line text to be aligned with buffer text +(for example, if the buffer displays columnar data, like +@code{tabulated-list-mode} does, @pxref{Tabulated List Mode}), it +should turn on the minor mode @code{header-line-indent-mode}. + +@deffn Command header-line-indent-mode +This buffer-local minor mode tracks the changes of the width of the +line-number display on screen (which may vary depending on the range +of line numbers shown in the window), and allows Lisp programs to +arrange that header-line text is always aligned with buffer text when +the line-number width changes. Such Lisp programs should turn on this +mode in the buffer, and use the variables @code{header-line-indent} +and @code{header-line-indent-width} in the @code{header-line-format} +to ensure it is adjusted to the text indentation at all times. +@end deffn -@findex header-line-indent-mode -If @code{display-line-numbers-mode} is used, and you want the header -line to be indented by the same amount as the buffer contents, you can -use the @code{header-line-indent-mode} minor mode. This minor mode -keeps the @code{header-line-indent} variable updated, so that you can -say something like: +@defvar header-line-indent +This variable's value is a whitespace string whose width is kept equal +to the current width of line-numbers on display, provided that +@code{header-line-indent-mode} is turned on in the buffer shown in the +window. The number of spaces is calculated under the assumption that +the face of the header-line text uses the same font, including size, +as the frame's default font; if that assumption is false, use +@code{header-line-indent-width}, described below, instead. This +variable is intended to be used in simple situations where the +header-line text needs to be indented as a whole to be realigned with +buffer text, by prepending this variable's value to the actual +header-line text. For example, the following definition of +@code{header-line-format}: @lisp (setq header-line-format - `("" header-line-format ,my-header-line)) + `("" header-line-indent ,my-header-line)) @end lisp -This can be useful if you're displaying columnar data, and the header -line should align with that data in the buffer. +@noindent +where @code{my-header-line} is the format string that produces the +actual text of the header line, will make sure the header-line text +is always indented like the buffer text below it. +@end defvar + +@defvar header-line-indent-width +This variable's value is kept updated to provide the current width, in +units of the frame's canonical character width, used for displaying +the line numbers, provided that @code{header-line-indent-mode} is +turned on in the buffer shown in the window. It can be used for +aligning the header-line text with the buffer text when +@code{header-line-indent} is not flexible enough. For example, if the +header line uses a font whose metrics is different from the default +face's font, your Lisp program can calculate the width of line-number +display in pixels, by multiplying the value of this variable by the +value returned by @code{frame-char-width} (@pxref{Frame Font}), and +then use the result to align header-line text using the +@code{:align-to} display property spec (@pxref{Specified Space}) in +pixels on the relevant parts of @code{header-line-frormat}. @end defvar @defun window-header-line-height &optional window diff --git a/etc/NEWS b/etc/NEWS index e3cbeb84d30..2d15e39036a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3946,9 +3946,11 @@ This argument can be used to override values of print-related settings. +++ ** New minor mode 'header-line-indent-mode'. -This is meant to be used in modes that have a header line that should -be kept aligned with the buffer contents when the user switches -'display-line-numbers-mode' on or off. +This is meant to be used by Lisp programs that show a header line +which should be kept aligned with the buffer contents when the user +switches 'display-line-numbers-mode' on or off, and when the width of +line-number display changes. See the "(elisp) Header Lines" node in +the Emacs Lisp Reference manual for more information. +++ ** New global minor mode 'lost-selection-mode'. diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el index 37cf7ade46e..89e9cec6fcd 100644 --- a/lisp/display-line-numbers.el +++ b/lisp/display-line-numbers.el @@ -112,19 +112,27 @@ global-display-line-numbers-mode ;;;###autoload (defvar header-line-indent "" - "String to indent at the start if the header line. -This is used in `header-line-indent-mode', and buffers that have -this switched on should have a `header-line-format' that look like: + "String of spaces to indent the beginning of header-line due to line numbers. +This is intended to be used in `header-line-format', and requires +the `header-line-indent-mode' to be turned on, in order for the width +of this string to be kept updated when the line-number width changes +on display. An example of a `header-line-format' that uses this +variable might look like this: (\"\" header-line-indent THE-REST...) +where THE-REST is the format string which produces the actual text +of the header-line. Also see `header-line-indent-width'.") ;;;###autoload (defvar header-line-indent-width 0 - "The width of the current line numbers displayed. -This is updated when `header-line-indent-mode' is switched on. - + "The width of the current line number display in the window. +This is measured in units of the frame's canonical columns. +This is updated when `header-line-indent-mode' is switched on, +and is intended for use in `:align-to' display specifications +that are part of `header-line-format', when portions of header-line +text should be aligned to respective parts of buffer text. Also see `header-line-indent'.") (defun header-line-indent--line-number-width () @@ -155,21 +163,30 @@ header-line-indent--window-scroll-function ;;;###autoload (define-minor-mode header-line-indent-mode - "Mode to indent the header line in `display-line-numbers-mode' buffers. -This means that the header line will be kept indented so that it -has blank space that's as wide as the displayed line numbers in -the buffer. + "Minor mode to help with alignment of header line when line numbers are shown. +This minor mode should be turned on in buffers which dispay header-line +that needs to be aligned with buffer text when `display-line-numbers-mode' +is turned on in the buffer. -Buffers that have this switched on should have a -`header-line-format' that look like: +Buffers that have this switched on should have a `header-line-format' +that uses the `header-line-indent' or the `header-line-indent-width' +variables, which this mode will keep up-to-date with the current +display of line numbers. For example, a `header-line-format' that +looks like this: (\"\" header-line-indent THE-REST...) -The `header-line-indent-width' variable is also kept updated, and -has the width of `header-line-format'. This can be used, for -instance, in `:align-to' specs, like: +will make sure the text produced by THE-REST (which should be +a header-line format string) is always indented to be aligned on +display with the first column of buffer text. + +The `header-line-indent-width' variable is also kept updated, +and can be used, for instance, in `:align-to' specs as part +of `header-line-format', like this: + + (space :align-to (+ header-line-indent-width 10)) - (space :align-to (+ header-line-indent-width 10))" +See also `line-number-display-width'." :lighter nil (if header-line-indent-mode (progn diff --git a/src/buffer.c b/src/buffer.c index 88ca69b0dd8..38648519ba0 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5081,8 +5081,8 @@ syms_of_buffer (void) The header line appears, optionally, at the top of a window; the mode line appears at the bottom. -Also see `header-line-indent-mode' if `display-line-number-mode' is -used. */); +Also see `header-line-indent-mode' if `display-line-numbers-mode' is +turned on and header-line text should be aligned with buffer text. */); DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format), Qnil, commit c3f58a66514b2c1b0d2441c9cf37d94d64bef224 Author: F. Jason Park Date: Fri Feb 3 06:01:04 2023 -0800 Don't casemap erc-sasl-user when set to :nick * lisp/erc/erc-sasl.el (erc-sasl-user): Fix doc string. (erc-sasl--get-user): Don't apply casemapping when the option `erc-sasl-user' is set to `:nick'. While many servers and auth-services providers perform case-folding when comparing SASL usernames, only some recognize RFC1459 mappings, which ERC previously applied blindly. Instead, ERC now behaves like other clients in leaving such preparation in the hands of the server. This bug was introduced with changes new to ERC 5.5 and Emacs 29 (bug#29108). diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index a0b36d07613..97c7c54a517 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -67,12 +67,11 @@ erc-sasl-mechanism (defcustom erc-sasl-user :user "Account username to send when authenticating. -This is also referred to as the authentication identity or +This option specifies the SASL authentication identity, or \"authcid\". A value of `:user' or `:nick' indicates that the -corresponding connection parameter on file should be used. These -are most often derived from arguments provided to the `erc' and -`erc-tls' entry points. In the case of `:nick', a downcased -version is used." +corresponding connection parameter on file should be used. ERC +typically obtains these from arguments given to its entry-point +commands, `erc' and `erc-tls'." :type '(choice string (const :user) (const :nick))) (defcustom erc-sasl-password :password @@ -129,7 +128,7 @@ erc-sasl--state (defun erc-sasl--get-user () (pcase (alist-get 'user erc-sasl--options) (:user erc-session-username) - (:nick (erc-downcase (erc-current-nick))) + (:nick (erc-current-nick)) (v v))) (defun erc-sasl-auth-source-password-as-host (&rest plist) commit e444115d026c809395d4d248a99bb467bc87bb1d Author: Robert Pluim Date: Thu Feb 2 11:37:45 2023 +0100 Improve keymap-global-set and keymap-local-set interactive use fix * lisp/keymap.el (keymap-global-set, keymap-local-set): Add optional `interactive' arg and use it to decide when to convert the key specification to a string. Add `advertised-calling-convention' declarations. (Bug#61149) diff --git a/lisp/keymap.el b/lisp/keymap.el index 201a49cef8c..4f02639ffe2 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -65,7 +65,7 @@ keymap-set (setq definition (key-parse definition))) (define-key keymap (key-parse key) definition)) -(defun keymap-global-set (key command) +(defun keymap-global-set (key command &optional interactive) "Give KEY a global binding as COMMAND. COMMAND is the command definition to use; usually it is a symbol naming an interactively-callable function. @@ -75,13 +75,14 @@ keymap-global-set Note that if KEY has a local binding in the current buffer, that local binding will continue to shadow any global binding that you make with this function." - (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) - (interactive "KSet key globally:\nCSet key %s globally to command: ") - (unless (stringp key) + (declare (compiler-macro (lambda (form) (keymap--compile-check key) form)) + (advertised-calling-convention (key command) "29.1")) + (interactive "KSet key globally: \nCSet key %s globally to command: \np") + (when interactive (setq key (key-description key))) (keymap-set (current-global-map) key command)) -(defun keymap-local-set (key command) +(defun keymap-local-set (key command &optional interactive) "Give KEY a local binding as COMMAND. COMMAND is the command definition to use; usually it is a symbol naming an interactively-callable function. @@ -90,12 +91,13 @@ keymap-local-set The binding goes in the current buffer's local map, which in most cases is shared with all other buffers in the same major mode." - (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) - (interactive "KSet key locally:\nCSet key %s locally to command: ") + (declare (compiler-macro (lambda (form) (keymap--compile-check key) form)) + (advertised-calling-convention (key command) "29.1")) + (interactive "KSet key locally: \nCSet key %s locally to command: \np") (let ((map (current-local-map))) (unless map (use-local-map (setq map (make-sparse-keymap)))) - (unless (stringp key) + (when interactive (setq key (key-description key))) (keymap-set map key command))) commit ac7ec87a7a0db887e4ae7fe9005aea517958b778 Merge: bfd338aad9d 96ea27278b4 Author: Stefan Kangas Date: Fri Feb 3 06:30:24 2023 +0100 Merge from origin/emacs-29 96ea27278b4 ; Fix c-ts-mode indent test d963a8f1355 Make c-ts-mode indent tests side-effect-free 8a6bdf88b4b Call treesit_record_change in insert_from_gap_1 a2b77c79dcc Use c-ts-common-statement-offset for closing brackets too 74e715cb729 ; Go back to original point when filling comments in c-ts... b8009bbf2d8 ; Fix error where we pass t to treesit-node-type in c-ts-... 88ccf78b206 ; * src/treesit.c (treesit_predicate_match): Simplify las... 20454128b8b Minor improvements in sqlite.c 3b3c47d977b (treesit_predicate_match): Match node text against regexp... e8334781c9f Improve documentation of gdb-mi's dedicated windows c4988840598 Avoid spurious pause in kill-ring-save (Bug#60841) 382ab516cef Change the default of 'treesit-defun-tactic' for 'c-ts-mode' 4d3428e95a9 Fix docstring fontification of CL's 'defstruct' 1c125baa3f0 Teach 'hs-minor-mode' about tree-sitter based modes 2de0ab5cbd3 ; Doc fixes in keymap.el c6660a6d6de Improve documentation of 'repeat-mode' and related variables be304bb3286 ; * etc/NEWS: Mention the 'utf-8-auto' bugfix (bug#60750). # Conflicts: # etc/NEWS commit 96ea27278b43ae5ea72643881015944a819f7974 Author: Yuan Fu Date: Thu Feb 2 18:30:11 2023 -0800 ; Fix c-ts-mode indent test * test/lisp/progmodes/c-ts-mode-resources/indent.erts: Move the linux style test case down. diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index 3704f06d2ae..058c6e9099c 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -135,32 +135,6 @@ int main() { } =-=-= -Name: Bracket-less Block-Statement (Linux Style) (bug#61026) - -=-=-= -int main() { - while (true) - if (true) { - puts ("Hello"); - } - for (int i=0; - i<5; - i++) - if (true) { - puts ("Hello"); - } - do - if (true) { - puts ("Hello"); - } - while (true); - if (true) - if (true) { - puts ("Hello"); - } -} -=-=-= - Name: Multiline Parameter List (bug#60398) =-= @@ -244,3 +218,29 @@ label: } } =-=-= + +Name: Bracket-less Block-Statement (Linux Style) (bug#61026) + +=-=-= +int main() { + while (true) + if (true) { + puts ("Hello"); + } + for (int i=0; + i<5; + i++) + if (true) { + puts ("Hello"); + } + do + if (true) { + puts ("Hello"); + } + while (true); + if (true) + if (true) { + puts ("Hello"); + } +} +=-=-= commit d963a8f1355a6d829af3f98182e66705c941e774 Author: Yuan Fu Date: Thu Feb 2 18:23:21 2023 -0800 Make c-ts-mode indent tests side-effect-free Running indent tests changes the global value of c-ts-mode-indent-style. That's not good. This change fixes that. I also refactored the indent style functions a bit. * lisp/progmodes/c-ts-mode.el: (c-ts-mode--prompt-for-style): New function. (c-ts-mode-set-local-style): New function. (c-ts-mode-set-style): Use c-ts-mode--prompt-for-style. Use derived-mode-p when testing for major mode. Remove check of current buffer's major mode since it doesn't matter. * test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts: * test/lisp/progmodes/c-ts-mode-resources/indent.erts: Use c-ts-mode-set-local-style to set the indent style locally. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 00704337cd9..390f67a8e8c 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -100,12 +100,11 @@ c-ts-mode--indent-style-setter (setq-local treesit-simple-indent-rules (treesit--indent-rules-optimize (c-ts-mode--get-indent-style - (if (eq major-mode 'c-ts-mode) 'c 'cpp)))))) + (if (derived-mode-p 'c-ts-mode) 'c 'cpp)))))) res) (let ((buffer (car buffers))) (with-current-buffer buffer - ;; FIXME: Should we use `derived-mode-p' here? - (if (or (eq major-mode 'c-ts-mode) (eq major-mode 'c++-ts-mode)) + (if (derived-mode-p 'c-ts-mode 'c++-ts-mode) (loop (append res (list buffer)) (cdr buffers)) (loop res (cdr buffers)))))))) @@ -134,24 +133,33 @@ c-ts-mode--get-indent-style (alist-get c-ts-mode-indent-style (c-ts-mode--indent-styles mode))))) `((,mode ,@style)))) -(defun c-ts-mode-set-style () - "Set the indent style of C/C++ modes globally. +(defun c-ts-mode--prompt-for-style () + "Prompt for a indent style and return the symbol for it." + (let ((mode (if (derived-mode-p 'c-ts-mode) 'c 'c++))) + (intern + (completing-read + "Style: " + (mapcar #'car (c-ts-mode--indent-styles mode)) + nil t nil nil "gnu")))) + +(defun c-ts-mode-set-style (style) + "Set the indent style of C/C++ modes globally to STYLE. This changes the current indent style of every C/C++ buffer and the default C/C++ indent style in this Emacs session." - (interactive) - ;; FIXME: Should we use `derived-mode-p' here? - (or (eq major-mode 'c-ts-mode) (eq major-mode 'c++-ts-mode) - (error "Buffer %s is not a c-ts-mode (c-ts-mode-set-style)" - (buffer-name))) - (c-ts-mode--indent-style-setter - 'c-ts-mode-indent-style - ;; NOTE: We can probably use the interactive form for this. - (intern - (completing-read - "Select style: " - (mapcar #'car (c-ts-mode--indent-styles (if (eq major-mode 'c-ts-mode) 'c 'cpp))) - nil t nil nil "gnu")))) + (interactive (list (c-ts-mode--prompt-for-style))) + (c-ts-mode--indent-style-setter 'c-ts-mode-indent-style style)) + +(defun c-ts-mode-set-local-style (style) + "Set the C/C++ indent style of the current buffer to STYLE." + (interactive (list (c-ts-mode--prompt-for-style))) + (if (not (derived-mode-p 'c-ts-mode 'c++-ts-mode)) + (user-error "The current buffer is not in `c-ts-mode' nor `c++-ts-mode'") + (setq-local c-ts-mode-indent-style style) + (setq treesit-simple-indent-rules + (treesit--indent-rules-optimize + (c-ts-mode--get-indent-style + (if (derived-mode-p 'c-ts-mode) 'c 'cpp)))))) ;;; Syntax table diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts b/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts index 07698077ffc..ba4f854baf8 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts @@ -1,9 +1,9 @@ Code: (lambda () - (setq indent-tabs-mode nil) - (setq c-ts-mode-indent-offset 2) - (setq c-ts-mode-indent-style 'bsd) (c-ts-mode) + (setq-local indent-tabs-mode nil) + (setq-local c-ts-mode-indent-offset 2) + (c-ts-mode-set-local-style 'bsd) (indent-region (point-min) (point-max))) Point-Char: | diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index 0ecbf922b15..3704f06d2ae 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -1,9 +1,9 @@ Code: (lambda () - (setq indent-tabs-mode nil) - (setq c-ts-mode-indent-offset 2) - (setq c-ts-mode-indent-style 'gnu) (c-ts-mode) + (setq-local indent-tabs-mode nil) + (setq-local c-ts-mode-indent-offset 2) + (c-ts-mode-set-local-style 'gnu) (indent-region (point-min) (point-max))) Point-Char: | @@ -219,10 +219,10 @@ line 2 Code: (lambda () - (setq indent-tabs-mode nil) - (setq c-ts-mode-indent-offset 8) - (setq c-ts-mode-indent-style 'linux) (c-ts-mode) + (setq-local indent-tabs-mode nil) + (setq-local c-ts-mode-indent-offset 8) + (c-ts-mode-set-local-style 'linux) (indent-region (point-min) (point-max))) Name: Labels (Linux Style) commit 8a6bdf88b4b665916cf74dee3a30e9136a9b6df8 Author: Yuan Fu Date: Thu Feb 2 17:22:22 2023 -0800 Call treesit_record_change in insert_from_gap_1 Before this change, insert_from_gap calls treesit_record_change but insert_from_gap_1 doesn't. However, insert_from_gap_1 is a public function and is called in many other places outside of insdel.c. This could lead to tree-sitter's parse tree becoming out-of-sync with the buffer content. This change might fix bug#60650. * src/insdel.c (insert_from_gap_1): Call treesit_record_change. (insert_from_gap): Remove call to treesit_record_change. * admin/notes/tree-sitter/treesit_record_change: New file. diff --git a/admin/notes/tree-sitter/treesit_record_change b/admin/notes/tree-sitter/treesit_record_change new file mode 100644 index 00000000000..bb0f9edc353 --- /dev/null +++ b/admin/notes/tree-sitter/treesit_record_change @@ -0,0 +1,50 @@ +NOTES ON TREESIT_RECORD_CHANGE + +It is vital that Emacs informs tree-sitter of every change made to the +buffer, lest tree-sitter's parse tree would be corrupted/out of sync. + +All buffer changes in Emacs are made through functions in insdel.c +(and casefiddle.c), I augmented functions in those files with calls to +treesit_record_change. Below is a manifest of all the relavent +functions in insdel.c as of Emacs 29: + +Function Calls +---------------------------------------------------------------------- +copy_text (*1) +insert insert_1_both +insert_and_inherit insert_1_both +insert_char insert +insert_string insert +insert_before_markers insert_1_both +insert_before_markers_and_inherit insert_1_both +insert_1_both treesit_record_change +insert_from_string insert_from_string_1 +insert_from_string_before_markers insert_from_string_1 +insert_from_string_1 treesit_record_change +insert_from_gap_1 treesit_record_change +insert_from_gap insert_from_gap_1 +insert_from_buffer treesit_record_change +insert_from_buffer_1 (used by insert_from_buffer) (*2) +replace_range treesit_record_change +replace_range_2 (caller needs to call treesit_r_c) +del_range del_range_1 +del_range_1 del_range_2 +del_range_byte del_range_2 +del_range_both del_range_2 +del_range_2 treesit_record_change + +(*1) This functions is used only to copy from string to string when +used outside of insdel.c, and when used inside insdel.c, the caller +calls treesit_record_change. + +(*2) This function is a static function, and insert_from_buffer is its +only caller. So it should be fine to call treesit_record_change in +insert_from_buffer but not insert_from_buffer_1. I also left a +reminder comment. + + +As for casefiddle.c, do_casify_unibyte_region and +do_casify_multibyte_region modifies buffer, but they are static +functions and are called by casify_region, which calls +treesit_record_change. Other higher-level functions calls +casify_region to do the work. \ No newline at end of file diff --git a/src/insdel.c b/src/insdel.c index 0e1e98664b3..e459d0cfa17 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -1101,6 +1101,10 @@ insert_from_gap_1 (ptrdiff_t nchars, ptrdiff_t nbytes, bool text_at_gap_tail) eassert (NILP (BVAR (current_buffer, enable_multibyte_characters)) ? nchars == nbytes : nchars <= nbytes); +#ifdef HAVE_TREE_SITTER + ptrdiff_t ins_bytepos = GPT_BYTE; +#endif + GAP_SIZE -= nbytes; if (! text_at_gap_tail) { @@ -1115,6 +1119,12 @@ insert_from_gap_1 (ptrdiff_t nchars, ptrdiff_t nbytes, bool text_at_gap_tail) /* Put an anchor to ensure multi-byte form ends at gap. */ if (GAP_SIZE > 0) *(GPT_ADDR) = 0; eassert (GPT <= GPT_BYTE); + +#ifdef HAVE_TREE_SITTER + eassert (nbytes >= 0); + eassert (ins_bytepos >= 0); + treesit_record_change (ins_bytepos, ins_bytepos, ins_bytepos + nbytes); +#endif } /* Insert a sequence of NCHARS chars which occupy NBYTES bytes @@ -1150,12 +1160,6 @@ insert_from_gap (ptrdiff_t nchars, ptrdiff_t nbytes, bool text_at_gap_tail) current_buffer, 0); } -#ifdef HAVE_TREE_SITTER - eassert (nbytes >= 0); - eassert (ins_bytepos >= 0); - treesit_record_change (ins_bytepos, ins_bytepos, ins_bytepos + nbytes); -#endif - if (ins_charpos < PT) adjust_point (nchars, nbytes); @@ -1191,6 +1195,9 @@ insert_from_buffer (struct buffer *buf, #endif } +/* NOTE: If we ever make insert_from_buffer_1 public, make sure to + move the call to treesit_record_change into it. */ + static void insert_from_buffer_1 (struct buffer *buf, ptrdiff_t from, ptrdiff_t nchars, bool inherit) commit a2b77c79dcca64b5e0ae58862206e7cc29640944 Author: Yuan Fu Date: Thu Feb 2 14:57:41 2023 -0800 Use c-ts-common-statement-offset for closing brackets too Merge c-ts-mode--close-bracket-offset into c-ts-common-statement-offset. * lisp/progmodes/c-ts-common.el: (c-ts-common-statement-offset): Handle closing brackets too. (c-ts-mode--close-bracket-offset): Remove function. * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Use c-ts-common-statement-offset for closing brackets. diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 05997e8bd20..8729cae4ba7 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -281,7 +281,7 @@ c-ts-common-indent-bracketless-type-regexp This can be nil, meaning such special handling is not needed.") -(defun c-ts-common-statement-offset (node parent &rest _) +(defun c-ts-common-statement-offset (node parent bol &rest _) "This anchor is used for children of a statement inside a block. This function basically counts the number of block nodes (i.e., @@ -293,14 +293,16 @@ c-ts-common-statement-offset checks whether the opening bracket { is on its own line, if so, it adds an extra level, except for the top-level. -PARENT is NODE's parent." +PARENT is NODE's parent, BOL is the beginning of non-whitespace +characters on the current line." (let ((level 0)) ;; If NODE is a opening/closing bracket on its own line, take off ;; one level because the code below assumes NODE is a statement ;; _inside_ a {} block. (when (and node - (string-match-p c-ts-common-indent-block-type-regexp - (treesit-node-type node))) + (or (string-match-p c-ts-common-indent-block-type-regexp + (treesit-node-type node)) + (save-excursion (goto-char bol) (looking-at-p "}")))) (cl-decf level)) ;; If point is on an empty line, NODE would be nil, but we pretend ;; there is a statement node. @@ -323,9 +325,9 @@ c-ts-common-statement-offset (treesit-node-parent node)))) ;; Case (2). (and parent-type - (or (string-match-p - c-ts-common-indent-block-type-regexp - parent-type)))) + (string-match-p + c-ts-common-indent-block-type-regexp + parent-type))) nil) ;; Add a level. ((looking-back (rx bol (* whitespace)) @@ -352,13 +354,6 @@ c-ts-mode--fix-bracketless-indent (1+ level) level))) -(defun c-ts-mode--close-bracket-offset (node parent &rest _) - "Offset for the closing bracket, NODE. -It's basically one level less that the statements in the block. -PARENT is NODE's parent." - (- (c-ts-common-statement-offset node parent) - (symbol-value c-ts-common-indent-offset))) - (provide 'c-ts-common) ;;; c-ts-common.el ends here diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 9cbba92a194..00704337cd9 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -254,12 +254,16 @@ c-ts-mode--indent-styles ;; int[5] a = { 0, 0, 0, 0 }; ((parent-is "initializer_list") parent-bol c-ts-mode-indent-offset) + ;; Statement in enum. ((parent-is "enumerator_list") point-min c-ts-common-statement-offset) + ;; Statement in struct and union. ((parent-is "field_declaration_list") point-min c-ts-common-statement-offset) - ;; {} blocks. - ((node-is "}") point-min c-ts-mode--close-bracket-offset) + ;; Statement in {} blocks. ((parent-is "compound_statement") point-min c-ts-common-statement-offset) + ;; Closing bracket. + ((node-is "}") point-min c-ts-common-statement-offset) + ;; Opening bracket. ((node-is "compound_statement") point-min c-ts-common-statement-offset) ,@(when (eq mode 'cpp) commit 74e715cb72900143cd9c2f8c58edb88431941d85 Author: Yuan Fu Date: Thu Feb 2 14:48:22 2023 -0800 ; Go back to original point when filling comments in c-ts-mode * lisp/progmodes/c-ts-common.el: (c-ts-common--fill-block-comment): Go to original point. diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index fd16c9713a5..05997e8bd20 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -194,7 +194,8 @@ c-ts-common--fill-block-comment (when end-marker (goto-char end-marker) (delete-region (point) (+ end-len (point))) - (insert (make-string end-len ?\s)))))) + (insert (make-string end-len ?\s))) + (goto-char orig-point)))) (defun c-ts-common-comment-setup () "Set up local variables for C-like comment. commit b8009bbf2d890511d19a31ba0757fbbe53f5c092 Author: Yuan Fu Date: Thu Feb 2 14:42:42 2023 -0800 ; Fix error where we pass t to treesit-node-type in c-ts-common.el * lisp/progmodes/c-ts-common.el: (c-ts-common-statement-offset): Move the form that sets node to t down, also add a check for node’s nullness. diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index c13b01aae5c..fd16c9713a5 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -294,16 +294,17 @@ c-ts-common-statement-offset PARENT is NODE's parent." (let ((level 0)) + ;; If NODE is a opening/closing bracket on its own line, take off + ;; one level because the code below assumes NODE is a statement + ;; _inside_ a {} block. + (when (and node + (string-match-p c-ts-common-indent-block-type-regexp + (treesit-node-type node))) + (cl-decf level)) ;; If point is on an empty line, NODE would be nil, but we pretend ;; there is a statement node. (when (null node) (setq node t)) - ;; If NODE is a opening bracket on its own line, take off one - ;; level because the code below assumes NODE is a statement - ;; _inside_ a {} block. - (when (string-match-p c-ts-common-indent-block-type-regexp - (treesit-node-type node)) - (cl-decf level)) ;; Go up the tree and compute indent level. (while (if (eq node t) (setq node parent) commit 88ccf78b206f7360060c0b1e2c5b9b86b8904134 Author: Eli Zaretskii Date: Thu Feb 2 21:54:15 2023 +0200 ; * src/treesit.c (treesit_predicate_match): Simplify last change. diff --git a/src/treesit.c b/src/treesit.c index 52953573061..8e772523cc7 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2483,8 +2483,8 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures) uint32_t end_byte_offset = ts_node_end_byte (treesit_node); ptrdiff_t start_byte = visible_beg + start_byte_offset; ptrdiff_t end_byte = visible_beg + end_byte_offset; - ptrdiff_t start_pos = buf_bytepos_to_charpos (buffer, start_byte); - ptrdiff_t end_pos = buf_bytepos_to_charpos (buffer, end_byte); + ptrdiff_t start_pos = BYTE_TO_CHAR (start_byte); + ptrdiff_t end_pos = BYTE_TO_CHAR (end_byte); ptrdiff_t old_begv = BEGV; ptrdiff_t old_begv_byte = BEGV_BYTE; ptrdiff_t old_zv = ZV; @@ -2495,8 +2495,8 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures) ZV = end_pos; ZV_BYTE = end_byte; - ptrdiff_t val = search_buffer (regexp, start_pos, start_byte, end_pos, end_byte, - 1, 1, Qnil, Qnil, false); + ptrdiff_t val = search_buffer (regexp, start_pos, start_byte, + end_pos, end_byte, 1, 1, Qnil, Qnil, false); BEGV = old_begv; BEGV_BYTE = old_begv_byte; @@ -2505,10 +2505,7 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures) set_buffer_internal (old_buffer); - if (val > 0) - return true; - else - return false; + return (val > 0); } /* Handles predicate (#pred FN ARG...). Return true if FN returns commit 20454128b8be9fb3b525ac43f7e5dfa9cc639db0 Author: Eli Zaretskii Date: Thu Feb 2 21:45:44 2023 +0200 Minor improvements in sqlite.c * src/sqlite.c (Fsqlite_next): Doc fix. Return nil if SQLITE_DONE was once seen for this statement. (Bug#61151) (row_to_value): Cons the value in reverse, to avoid the Fnreverse call. Patch by Helmut Eller . (Bug#61165) diff --git a/src/sqlite.c b/src/sqlite.c index c96841e63f9..0361514766a 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -399,7 +399,7 @@ row_to_value (sqlite3_stmt *stmt) int len = sqlite3_column_count (stmt); Lisp_Object values = Qnil; - for (int i = 0; i < len; ++i) + for (int i = len - 1; i >= 0; i--) { Lisp_Object v = Qnil; @@ -434,7 +434,7 @@ row_to_value (sqlite3_stmt *stmt) values = Fcons (v, values); } - return Fnreverse (values); + return values; } static Lisp_Object @@ -718,11 +718,15 @@ DEFUN ("sqlite-load-extension", Fsqlite_load_extension, #endif /* HAVE_SQLITE3_LOAD_EXTENSION */ DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0, - doc: /* Return the next result set from SET. */) + doc: /* Return the next result set from SET. +Return nil when the statement has finished executing successfully. */) (Lisp_Object set) { check_sqlite (set, true); + if (XSQLITE (set)->eof) + return Qnil; + int ret = sqlite3_step (XSQLITE (set)->stmt); if (ret != SQLITE_ROW && ret != SQLITE_OK && ret != SQLITE_DONE) xsignal1 (Qsqlite_error, build_string (sqlite3_errmsg (XSQLITE (set)->db))); commit 3b3c47d977bbe27f7157557b6b0e25d1dcf07640 Author: Dmitry Gutov Date: Thu Feb 2 13:32:41 2023 +0200 (treesit_predicate_match): Match node text against regexp without consing * src/treesit.c (treesit_predicate_match): Match node text against regexp without creating a new string object (bug#60953). * src/search.c (search_buffer): Make not static. Delete declaration near the beginning of the file. * src/lisp.h: Declare it here. * lisp/progmodes/ruby-ts-mode.el (ruby-ts--builtin-method-p): Remove function. (ruby-ts--font-lock-settings): Use the regexp with :match directly. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 60215978176..7725d0824e3 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -209,9 +209,6 @@ ruby-ts--comment-font-lock (treesit-fontify-with-override (max plus-1 start) (min node-end end) font-lock-comment-face override))) -(defun ruby-ts--builtin-method-p (node) - (string-match-p ruby-ts--builtin-methods (treesit-node-text node t))) - (defun ruby-ts--font-lock-settings (language) "Tree-sitter font-lock settings for Ruby." (treesit-font-lock-rules @@ -340,7 +337,7 @@ ruby-ts--font-lock-settings :language language :feature 'builtin-function `((((identifier) @font-lock-builtin-face) - (:pred ruby-ts--builtin-method-p @font-lock-builtin-face))) + (:match ,ruby-ts--builtin-methods @font-lock-builtin-face))) ;; Yuan recommends also putting method definitions into the ;; 'function' category (thus keeping it in both). I've opted to diff --git a/src/lisp.h b/src/lisp.h index 70555b3ce91..1276285e2f2 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4802,6 +4802,9 @@ fast_c_string_match_ignore_case (Lisp_Object regexp, ptrdiff_t, ptrdiff_t *); extern ptrdiff_t find_before_next_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t *); +extern EMACS_INT search_buffer (Lisp_Object, ptrdiff_t, ptrdiff_t, + ptrdiff_t, ptrdiff_t, EMACS_INT, + int, Lisp_Object, Lisp_Object, bool); extern void syms_of_search (void); extern void clear_regexp_cache (void); diff --git a/src/search.c b/src/search.c index dbc5a83946f..0bb52c03eef 100644 --- a/src/search.c +++ b/src/search.c @@ -68,9 +68,6 @@ #define REGEXP_CACHE_SIZE 20 static EMACS_INT boyer_moore (EMACS_INT, unsigned char *, ptrdiff_t, Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t, int); -static EMACS_INT search_buffer (Lisp_Object, ptrdiff_t, ptrdiff_t, - ptrdiff_t, ptrdiff_t, EMACS_INT, int, - Lisp_Object, Lisp_Object, bool); Lisp_Object re_match_object; @@ -1510,7 +1507,7 @@ search_buffer_non_re (Lisp_Object string, ptrdiff_t pos, return result; } -static EMACS_INT +EMACS_INT search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t lim, ptrdiff_t lim_byte, EMACS_INT n, int RE, Lisp_Object trt, Lisp_Object inverse_trt, bool posix) diff --git a/src/treesit.c b/src/treesit.c index 405aec1f47e..52953573061 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2470,10 +2470,42 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures) build_string ("The second argument to `match' should " "be a capture name, not a string")); - Lisp_Object text = treesit_predicate_capture_name_to_text (capture_name, + Lisp_Object node = treesit_predicate_capture_name_to_node (capture_name, captures); - if (fast_string_match (regexp, text) >= 0) + struct buffer *old_buffer = current_buffer; + struct buffer *buffer = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer); + set_buffer_internal (buffer); + + TSNode treesit_node = XTS_NODE (node)->node; + ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg; + uint32_t start_byte_offset = ts_node_start_byte (treesit_node); + uint32_t end_byte_offset = ts_node_end_byte (treesit_node); + ptrdiff_t start_byte = visible_beg + start_byte_offset; + ptrdiff_t end_byte = visible_beg + end_byte_offset; + ptrdiff_t start_pos = buf_bytepos_to_charpos (buffer, start_byte); + ptrdiff_t end_pos = buf_bytepos_to_charpos (buffer, end_byte); + ptrdiff_t old_begv = BEGV; + ptrdiff_t old_begv_byte = BEGV_BYTE; + ptrdiff_t old_zv = ZV; + ptrdiff_t old_zv_byte = ZV_BYTE; + + BEGV = start_pos; + BEGV_BYTE = start_byte; + ZV = end_pos; + ZV_BYTE = end_byte; + + ptrdiff_t val = search_buffer (regexp, start_pos, start_byte, end_pos, end_byte, + 1, 1, Qnil, Qnil, false); + + BEGV = old_begv; + BEGV_BYTE = old_begv_byte; + ZV = old_zv; + ZV_BYTE = old_zv_byte; + + set_buffer_internal (old_buffer); + + if (val > 0) return true; else return false; commit e8334781c9ffcf29a56a6eaf449f58d5b18c148a Author: Eli Zaretskii Date: Thu Feb 2 20:49:15 2023 +0200 Improve documentation of gdb-mi's dedicated windows * doc/emacs/building.texi (Other GDB Buffers): Describe the I/O buffer and commands to show individual specialized windows. Improve indexing. diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 98f67ddd9d9..3f6a418de1a 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -961,9 +961,7 @@ GDB Graphical Interface @vindex gud-gdb-command-name To run GDB using just the GUD interaction buffer interface, without these additional features, use @kbd{M-x gud-gdb} (@pxref{Starting -GUD}). You must use this if you want to debug multiple programs -within one Emacs session, as that is currently unsupported by @kbd{M-x -gdb}. +GUD}). Internally, @kbd{M-x gdb} informs GDB that its screen size is unlimited; for correct operation, you must not change GDB's screen @@ -1051,9 +1049,9 @@ GDB User Interface Layout You may also specify additional GDB-related buffers to display, either in the same frame or a different one. Select the buffers you want by typing @kbd{M-x gdb-display-@var{buffertype}-buffer} or -@kbd{M-x gdb-frame-@var{buffertype}-buffer}, where @var{buffertype} -is the relevant buffer type, such as @samp{breakpoints}. You can do -the same with the menu bar, with the @samp{GDB-Windows} and +@kbd{M-x gdb-frame-@var{buffertype}-buffer}, where @var{buffertype} is +the relevant buffer type, such as @samp{breakpoints} or @samp{io}. +You can do the same from the menu bar, with the @samp{GDB-Windows} and @samp{GDB-Frames} sub-menus of the @samp{GUD} menu. @vindex gdb-max-source-window-count @@ -1273,10 +1271,14 @@ Stack Buffer @node Other GDB Buffers @subsubsection Other GDB Buffers +Other buffers provided by @kbd{M-x gdb} whose display you can +optionally request include: + @table @asis +@findex gdb-display-locals-buffer @item Locals Buffer This buffer displays the values of local variables of the current -frame for simple data types (@pxref{Frame Info, Frame Info, +stack frame for simple data types (@pxref{Frame Info, Frame Info, Information on a frame, gdb, The GNU debugger}). Press @key{RET} or click @kbd{mouse-2} on the value if you want to edit it. @@ -1286,20 +1288,35 @@ Other GDB Buffers GDB, use @key{RET} or @kbd{mouse-2} on the type description (@samp{[struct/union]} or @samp{[array]}). @xref{Watch Expressions}. +To display the Locals buffer, type @kbd{M-x gdb-display-locals-buffer}. + +@findex gdb-display-io-buffer +@item I/O Buffer +If the program you are debugging uses standard input and output +streams for interaction with the user, or emits a significant amount +of output to its standard output, you may wish to separate its I/O +from interaction with GDB. Use the command @w{@kbd{M-x +gdb-display-io-buffer}} to show a window with a buffer to which Emacs +redirects the input and output from the program you are debugging. + +@findex gdb-display-registers-buffer @item Registers Buffer -@findex toggle-gdb-all-registers This buffer displays the values held by the registers -(@pxref{Registers,,, gdb, The GNU debugger}). Press @key{RET} or -click @kbd{mouse-2} on a register if you want to edit its value. With -GDB 6.4 or later, recently changed register values display with -@code{font-lock-warning-face}. +(@pxref{Registers,,, gdb, The GNU debugger}). Request the display of +this buffer with the command @kbd{M-x gdb-display-registers-buffer}. +Press @key{RET} or click @kbd{mouse-2} on a register if you want to +edit its value. With GDB 6.4 or later, recently changed register +values display with @code{font-lock-warning-face}. +@findex gdb-display-disassembly-buffer @item Assembler Buffer The assembler buffer displays the current frame as machine code. An arrow points to the current instruction, and you can set and remove breakpoints as in a source buffer. Breakpoint icons also appear in -the fringe or margin. +the fringe or margin. To request the display of this buffer, use +@kbd{M-x gdb-display-disassembly-buffer}. +@findex gdb-display-memory-buffer @item Memory Buffer The memory buffer lets you examine sections of program memory (@pxref{Memory, Memory, Examining memory, gdb, The GNU debugger}). @@ -1307,7 +1324,8 @@ Other GDB Buffers change the starting address or number of data items that the buffer displays. Alternatively, use @kbd{S} or @kbd{N} respectively. Click @kbd{mouse-3} on the header line to select the display format or unit -size for these data items. +size for these data items. Use @w{@kbd{M-x +gdb-display-memory-buffer}} to request display of this buffer. @end table When @code{gdb-many-windows} is non-@code{nil}, the locals buffer commit c4988840598b7da84b25d21a1936ce1ab6f6d666 Author: Kévin Le Gouguec Date: Sun Jan 29 11:23:01 2023 +0100 Avoid spurious pause in kill-ring-save (Bug#60841) 'indicate-copied-region' checks whether the region is "highlighted" and if not, briefly moves point to mark to give a visual cue of the extent of text that was saved to the kill ring. The region is considered "highlighted" if (a) it is active and (b) its face specifies a :background. That latter condition does not account for the multiple ways in which the face can make the region "visually distinct" from the default face, so switch to the more extensive predicate face-differs-from-default-p. The patch also fixes a couple of issues with the predicate's implementation, and introduces a new user option in case anyone happened to enjoy unconditional blinking. * lisp/faces.el (face-differs-from-default-p): Filter out :extend; add rationale for the attributes we ignore. * lisp/simple.el (copy-region-blink-predicate): Add option to let users explicitly opt into or out of blinking point and mark. (region-indistinguishable-p): New function to detect "if there is currently no active region highlighting", leveraging face-differs-from-default-p. (indicate-copied-region): Use it. * src/xfaces.c (merge_face_ref): Allow :stipple to be nil, since it is a documented valid value for that attribute. * etc/NEWS: Announce user option. diff --git a/etc/NEWS b/etc/NEWS index d402cc82c4a..e3cbeb84d30 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1353,6 +1353,18 @@ dragged. Customize this option to limit the number of entries in the menu "Edit → Paste from Kill Menu". The default is 60. +--- +** New user option 'copy-region-blink-predicate'. +By default, when copying a region with 'kill-ring-save', Emacs only +blinks point and mark when the region is not denoted visually, that +is, when either the region is inactive, or the 'region' face is +indistinguishable from the 'default' face. + +Users who would rather enable blinking unconditionally can now set +this user option to 'always'. To disable blinking unconditionally, +either set this option to 'ignore', or set 'copy-region-blink-delay' +to 0. + +++ ** Performing a pinch gesture on a touchpad now increases the text scale. diff --git a/lisp/faces.el b/lisp/faces.el index 3323eab205a..4933b495a6c 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -304,7 +304,16 @@ face-differs-from-default-p If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame." (let ((attrs - (delq :inherit (mapcar 'car face-attribute-name-alist))) + ;; The _value_ of :inherit teaches us nothing about how FACE + ;; looks compared to the default face. Instead, we will ask + ;; `face-attribute' to take inheritance into account when + ;; examining other attributes. + (delq :inherit + ;; A difference in extension past EOL only matters when + ;; relevant attributes (such as :background) also + ;; differ from the default; otherwise this difference + ;; is a false positive. + (delq :extend (mapcar 'car face-attribute-name-alist)))) (differs nil)) (while (and attrs (not differs)) (let* ((attr (pop attrs)) diff --git a/lisp/simple.el b/lisp/simple.el index 861fe193fb8..c58acfe3adc 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5852,6 +5852,25 @@ copy-region-blink-delay :group 'killing :version "28.1") +(defcustom copy-region-blink-predicate #'region-indistinguishable-p + "Whether the cursor must be blinked after a copy. +When this condition holds, and the copied region fits in the +current window, `kill-ring-save' will blink the cursor between +point and mark for `copy-region-blink-delay' seconds." + :type '(radio (function-item region-indistinguishable-p) + (function-item :doc "Always blink point and mark." always) + (function-item :doc "Never blink point and mark." ignore) + (function :tag "Other predicate function")) + :group 'killing + :version "29.1") + +(defun region-indistinguishable-p () + "Whether the current region is not denoted visually. +This holds when the region is inactive, or when the `region' face +cannot be distinguished from the `default' face." + (not (and (region-active-p) + (face-differs-from-default-p 'region)))) + (defun indicate-copied-region (&optional message-len) "Indicate that the region text has been copied interactively. If the mark is visible in the selected window, blink the cursor between @@ -5872,8 +5891,7 @@ indicate-copied-region ;; was selected. Don't do it if the region is highlighted. (when (and (numberp copy-region-blink-delay) (> copy-region-blink-delay 0) - (or (not (region-active-p)) - (not (face-background 'region nil t)))) + (funcall copy-region-blink-predicate)) ;; Swap point and mark. (set-marker (mark-marker) (point) (current-buffer)) (goto-char mark) diff --git a/src/xfaces.c b/src/xfaces.c index 35b79154805..62d7823f308 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -2780,8 +2780,7 @@ merge_face_ref (struct window *w, else if (EQ (keyword, QCstipple)) { #if defined (HAVE_WINDOW_SYSTEM) - Lisp_Object pixmap_p = Fbitmap_spec_p (value); - if (!NILP (pixmap_p)) + if (NILP (value) || !NILP (Fbitmap_spec_p (value))) to[LFACE_STIPPLE_INDEX] = value; else err = true; commit 382ab516cefc974d65622479fb7e844fd982011d Author: Eli Zaretskii Date: Thu Feb 2 20:21:02 2023 +0200 Change the default of 'treesit-defun-tactic' for 'c-ts-mode' * lisp/progmodes/c-ts-mode.el (c-ts-mode): Set 'treesit-defun-tactic' as appropriate for C. (Bug#61208) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 195c23d28c9..9cbba92a194 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -793,6 +793,8 @@ c-ts-mode (c-ts-mode--get-indent-style 'c)) ;; Font-lock. (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c)) + ;; Navigation. + (setq-local treesit-defun-tactic 'top-level) (treesit-major-mode-setup))) ;;;###autoload commit 4d3428e95a9ea38841bc234780b8abfc6a34919e Author: Eli Zaretskii Date: Thu Feb 2 20:12:02 2023 +0200 Fix docstring fontification of CL's 'defstruct' * lisp/emacs-lisp/lisp-mode.el (defstruct): Set 'doc-string' property. Patch by Nicolas Martyanoff . Copyright-paperwork-exempt: yes diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index bacc105a214..367f59e8785 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -182,6 +182,7 @@ lisp-mode-autoload-regexp ;; CL (put 'defconstant 'doc-string-elt 3) (put 'defparameter 'doc-string-elt 3) +(put 'defstruct 'doc-string-elt 2) (defvar lisp-doc-string-elt-property 'doc-string-elt "The symbol property that holds the docstring position info.") commit 1c125baa3f0d908eaf19698bbef2e81653e4f421 Author: Eli Zaretskii Date: Thu Feb 2 19:41:09 2023 +0200 Teach 'hs-minor-mode' about tree-sitter based modes * lisp/progmodes/hideshow.el (hs-special-modes-alist): Teach 'hs-minor-mode' about tree-sitter based modes. (Bug#61232) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index c160e6ad1df..b878986d7a4 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -256,10 +256,14 @@ hs-isearch-open (defvar hs-special-modes-alist (mapcar #'purecopy '((c-mode "{" "}" "/[*/]" nil nil) + (c-ts-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) + (c++-ts-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) + (java-ts-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil) + (js-ts-mode "{" "}" "/[*/]" nil) (mhtml-mode "{\\|<[^/>]*?" "}\\|]*[^/]>" " discardN-preserve-tos(X+Y) from the final pass to the main iteration since it may enable further optimisations. - Don't apply the rule goto(X) ... X: DISCARD --> DISCARD goto(Y) ... X: DISCARD Y: when DISCARD could be merged or deleted instead, which is even better. - Add the rule OP const return -> const return where OP is effect-free. - Generalise the push-pop annihilation rule to PUSH(K) discard(N) -> discard(N-K), N>K PUSH(K) discard(N) -> , N=K to any N, not just N=1. - Add the rule OP goto(X) Y: OP X: -> Y: OP X: for any operation OP. * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Make the changes described above. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 9eb48f5fe0b..861cf95b1ff 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -2042,31 +2042,29 @@ byte-optimize-lapcode ;; optimized but sequences like "dup varset TAG1: discard" are not. ;; You may be tempted to change this; resist that temptation. (cond - ;; pop --> - ;; ...including: - ;; const-X pop --> - ;; varref-X pop --> - ;; dup pop --> - ;; - ((and (eq 'byte-discard (car lap1)) + ;; + ;; PUSH(K) discard(N) --> discard(N-K), N>K + ;; PUSH(K) discard(N) --> , N=K + ;; where PUSH(K) is a side-effect-free op such as const, varref, dup + ;; + ((and (memq (car lap1) '(byte-discard byte-discardN)) (memq (car lap0) side-effect-free)) (setq keep-going t) - (setq tmp (aref byte-stack+-info (symbol-value (car lap0)))) - (setq rest (cdr rest)) - (cond ((eql tmp 1) - (byte-compile-log-lap - " %s discard\t-->\t" lap0) - (setq lap (delq lap0 (delq lap1 lap)))) - ((eql tmp 0) - (byte-compile-log-lap - " %s discard\t-->\t discard" lap0) - (setq lap (delq lap0 lap))) - ((eql tmp -1) - (byte-compile-log-lap - " %s discard\t-->\tdiscard discard" lap0) - (setcar lap0 'byte-discard) - (setcdr lap0 0)) - (t (error "Optimizer error: too much on the stack")))) + (let* ((pushes (aref byte-stack+-info (symbol-value (car lap0)))) + (pops (if (eq (car lap1) 'byte-discardN) (cdr lap1) 1)) + (net-pops (- pops pushes))) + (cond ((= net-pops 0) + (byte-compile-log-lap " %s %s\t-->\t" lap0 lap1) + (setcdr rest (cddr rest)) + (setq lap (delq lap0 lap))) + ((> net-pops 0) + (byte-compile-log-lap + " %s %s\t-->\t discard(%d)" lap0 lap1 net-pops) + (setcar rest (if (eql net-pops 1) + (cons 'byte-discard nil) + (cons 'byte-discardN net-pops))) + (setcdr rest (cddr rest))) + (t (error "Optimizer error: too much on the stack"))))) ;; ;; goto*-X X: --> X: ;; @@ -2353,6 +2351,40 @@ byte-optimize-lapcode (setcar lap0 'byte-return)) (setcdr lap0 (cdr tmp)) (setq keep-going t)))) + + ;; + ;; OP goto(X) Y: OP X: -> Y: OP X: + ;; + ((and (eq (car lap1) 'byte-goto) + (eq (car lap2) 'TAG) + (let ((lap3 (nth 3 rest))) + (and (eq (car lap0) (car lap3)) + (eq (cdr lap0) (cdr lap3)) + (eq (cdr lap1) (nth 4 rest))))) + (byte-compile-log-lap " %s %s %s %s %s\t-->\t%s %s %s" + lap0 lap1 lap2 + (nth 3 rest) (nth 4 rest) + lap2 (nth 3 rest) (nth 4 rest)) + (setcdr rest (cddr rest)) + (setq lap (delq lap0 lap)) + (setq keep-going t)) + + ;; + ;; OP const return --> const return + ;; where OP is side-effect-free (or mere stack manipulation). + ;; + ((and (eq (car lap1) 'byte-constant) + (eq (car (nth 2 rest)) 'byte-return) + (or (memq (car lap0) '( byte-discard byte-discardN + byte-discardN-preserve-tos + byte-stack-set)) + (memq (car lap0) side-effect-free))) + (setq keep-going t) + (setq add-depth 1) ; in case we get rid of too much stack reduction + (setq lap (delq lap0 lap)) + (byte-compile-log-lap " %s %s %s\t-->\t%s %s" + lap0 lap1 (nth 2 rest) lap1 (nth 2 rest))) + ;; ;; goto-*-else-pop X ... X: goto-if-* --> whatever ;; goto-*-else-pop X ... X: discard --> whatever @@ -2491,6 +2523,24 @@ byte-optimize-lapcode ) (setq keep-going t)) + ;; + ;; discardN-preserve-tos(X) discardN-preserve-tos(Y) + ;; --> discardN-preserve-tos(X+Y) + ;; where stack-set(1) is accepted as discardN-preserve-tos(1) + ;; + ((and (or (eq (car lap0) 'byte-discardN-preserve-tos) + (and (eq (car lap0) 'byte-stack-set) (eql (cdr lap0) 1))) + (or (eq (car lap1) 'byte-discardN-preserve-tos) + (and (eq (car lap1) 'byte-stack-set) (eql (cdr lap1) 1)))) + (setq keep-going t) + (let ((new-op (cons 'byte-discardN-preserve-tos + ;; This happens to work even when either + ;; op is stack-set(1). + (+ (cdr lap0) (cdr lap1))))) + (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 new-op) + (setcar rest new-op) + (setcdr rest (cddr rest)))) + ;; ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos ;; stack-set-M [discard/discardN ...] --> discardN @@ -2529,7 +2579,7 @@ byte-optimize-lapcode ;; ;; discardN-preserve-tos return --> return ;; dup return --> return - ;; stack-set-N return --> return ; where N is TOS-1 + ;; stack-set(1) return --> return ;; ((and (eq (car lap1) 'byte-return) (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup)) @@ -2546,8 +2596,15 @@ byte-optimize-lapcode ;; ((and (eq (car lap0) 'byte-goto) (setq tmp (cdr (memq (cdr lap0) lap))) - (memq (caar tmp) '(byte-discard byte-discardN - byte-discardN-preserve-tos))) + (or (memq (caar tmp) '(byte-discard byte-discardN)) + ;; Make sure we don't hoist a discardN-preserve-tos + ;; that really should be merged or deleted instead. + (and (eq (caar tmp) 'byte-discardN-preserve-tos) + (let ((next (cadr tmp))) + (not (or (memq (car next) '(byte-discardN-preserve-tos + byte-return)) + (and (eq (car next) 'byte-stack-set) + (eql (cdr next) 1)))))))) (byte-compile-log-lap " goto-X .. X: \t-->\t%s goto-X.. X: %s Y:" (car tmp) (car tmp)) @@ -2562,11 +2619,16 @@ byte-optimize-lapcode ;; ;; const discardN-preserve-tos ==> discardN const + ;; const stack-set(1) ==> discard const ;; ((and (eq (car lap0) 'byte-constant) - (eq (car lap1) 'byte-discardN-preserve-tos)) + (or (eq (car lap1) 'byte-discardN-preserve-tos) + (and (eq (car lap1) 'byte-stack-set) + (eql (cdr lap1) 1)))) (setq keep-going t) - (let ((newdiscard (cons 'byte-discardN (cdr lap1)))) + (let ((newdiscard (if (eql (cdr lap1) 1) + (cons 'byte-discard nil) + (cons 'byte-discardN (cdr lap1))))) (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 newdiscard lap0) (setf (car rest) newdiscard) @@ -2651,16 +2713,6 @@ byte-optimize-lapcode (setcdr lap1 (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0)) (if (eq (car lap1) 'byte-discard) 1 (cdr lap1)))) (setcar lap1 'byte-discardN)) - - ;; - ;; discardN-preserve-tos-X discardN-preserve-tos-Y --> - ;; discardN-preserve-tos-(X+Y) - ;; - ((and (eq (car lap0) 'byte-discardN-preserve-tos) - (eq (car lap1) 'byte-discardN-preserve-tos)) - (setq lap (delq lap0 lap)) - (setcdr lap1 (+ (cdr lap0) (cdr lap1))) - (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 (car rest))) ) (setq rest (cdr rest))) (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth))) commit f6955482c2933706229044c04d88b807b63a7095 Author: Mattias Engdegård Date: Tue Jan 31 11:15:13 2023 +0100 Clean up LAP peephole logging Make `byte-compile-log-lap` more robust and produce nicer output. This is of interest for Elisp compiler maintainers only. * lisp/emacs-lisp/byte-opt.el (bytecomp--log-lap-arg): New. (byte-compile-log-lap-1): Extract argument conversion and rewrite in a more modern way, fixing bugs. In particular, tags are now displayed as "X:" where X is the tag number, and that tag number is shown as argument to goto-like ops. (byte-optimize-lapcode): Clean up and simplify logging, producing useful information when `byte-optimize-log` is `byte` as intended. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 4d39e28fc8e..9eb48f5fe0b 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -72,34 +72,40 @@ (require 'macroexp) (eval-when-compile (require 'subr-x)) +(defun bytecomp--log-lap-arg (arg) + ;; Convert an argument that may be a LAP operation to something printable. + (cond + ;; Symbols are just stripped of their -byte prefix if any. + ((symbolp arg) + (intern (string-remove-prefix "byte-" (symbol-name arg)))) + ;; Conses are assumed to be LAP ops or tags. + ((and (consp arg) (symbolp (car arg))) + (let* ((head (car arg)) + (tail (cdr arg)) + (op (intern (string-remove-prefix "byte-" (symbol-name head))))) + (cond + ((eq head 'TAG) + (format "%d:" (car tail))) + ((memq head byte-goto-ops) + (format "(%s %d)" op (cadr tail))) + ((memq head byte-constref-ops) + (format "(%s %s)" + (if (eq op 'constant) 'const op) + (if (numberp tail) + (format "" tail) ; closure var reference + (format "%S" (car tail))))) ; actual constant + ;; Ops with an immediate argument. + ((memq op '( stack-ref stack-set call unbind + listN concatN insertN discardN discardN-preserve-tos)) + (format "(%s %S)" op tail)) + ;; Without immediate, print just the symbol. + (t op)))) + ;; Anything else is printed as-is. + (t arg))) + (defun byte-compile-log-lap-1 (format &rest args) (byte-compile-log-1 - (apply #'format-message format - (let (c a) - (mapcar (lambda (arg) - (if (not (consp arg)) - (if (and (symbolp arg) - (string-match "^byte-" (symbol-name arg))) - (intern (substring (symbol-name arg) 5)) - arg) - (if (integerp (setq c (car arg))) - (error "Non-symbolic byte-op %s" c)) - (if (eq c 'TAG) - (setq c arg) - (setq a (cond ((memq c byte-goto-ops) - (car (cdr (cdr arg)))) - ((memq c byte-constref-ops) - (car (cdr arg))) - (t (cdr arg)))) - (setq c (symbol-name c)) - (if (string-match "^byte-." c) - (setq c (intern (substring c 5))))) - (if (eq c 'constant) (setq c 'const)) - (if (and (eq (cdr arg) 0) - (not (memq c '(unbind call const)))) - c - (format "(%s %s)" c a)))) - args))))) + (apply #'format-message format (mapcar #'bytecomp--log-lap-arg args)))) (defmacro byte-compile-log-lap (format-string &rest args) `(and (memq byte-optimize-log '(t byte)) @@ -2073,10 +2079,8 @@ byte-optimize-lapcode (setcar lap0 (setq tmp 'byte-discard)) (setcdr lap0 0)) ((error "Depth conflict at tag %d" (nth 2 lap0)))) - (and (memq byte-optimize-log '(t byte)) - (byte-compile-log " (goto %s) %s:\t-->\t%s %s:" - (nth 1 lap1) (nth 1 lap1) - tmp (nth 1 lap1))) + (byte-compile-log-lap " %s %s\t-->\t%s %s" + lap0 lap1 tmp lap1) (setq keep-going t)) ;; ;; varset-X varref-X --> dup varset-X @@ -2165,7 +2169,7 @@ byte-optimize-lapcode (eq (cdr lap0) lap2)) ; TAG X (let ((inverse (if (eq 'byte-goto-if-nil (car lap0)) 'byte-goto-if-not-nil 'byte-goto-if-nil))) - (byte-compile-log-lap " %s %s %s:\t-->\t%s %s:" + (byte-compile-log-lap " %s %s %s\t-->\t%s %s" lap0 lap1 lap2 (cons inverse (cdr lap1)) lap2) (setq lap (delq lap0 lap)) @@ -2238,9 +2242,8 @@ byte-optimize-lapcode ;; ((and (eq (car lap0) 'TAG) (eq (car lap1) 'TAG)) - (and (memq byte-optimize-log '(t byte)) - (byte-compile-log " adjacent tags %d and %d merged" - (nth 1 lap1) (nth 1 lap0))) + (byte-compile-log-lap " adjacent tags %d and %d merged" + (nth 1 lap1) (nth 1 lap0)) (setq tmp3 lap) (while (setq tmp2 (rassq lap0 tmp3)) (setcdr tmp2 lap1) @@ -2262,8 +2265,7 @@ byte-optimize-lapcode (cl-loop for table in byte-compile-jump-tables when (member lap0 (hash-table-values table)) return nil finally return t)) - (and (memq byte-optimize-log '(t byte)) - (byte-compile-log " unused tag %d removed" (nth 1 lap0))) + (byte-compile-log-lap " unused tag %d removed" (nth 1 lap0)) (setq lap (delq lap0 lap) keep-going t)) ;; @@ -2459,12 +2461,10 @@ byte-optimize-lapcode (memq (car (car tmp)) '(byte-goto byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop))) - ;; (byte-compile-log-lap " %s %s, %s %s --> moved conditional" - ;; lap0 lap1 (cdr lap0) (car tmp)) (let ((newtag (byte-compile-make-tag))) (byte-compile-log-lap - "%s %s: ... %s: %s\t-->\t%s ... %s:" - lap0 (nth 1 lap1) (nth 1 (cdr lap0)) (car tmp) + " %s %s ... %s %s\t-->\t%s ... %s" + lap0 lap1 (cdr lap0) (car tmp) (cons (cdr (assq (car (car tmp)) '((byte-goto-if-nil . byte-goto-if-not-nil) (byte-goto-if-not-nil . byte-goto-if-nil) @@ -2474,8 +2474,7 @@ byte-optimize-lapcode byte-goto-if-nil-else-pop)))) newtag) - (nth 1 newtag) - ) + newtag) (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp))) (if (eq (car (car tmp)) 'byte-goto-if-nil-else-pop) ;; We can handle this case but not the -if-not-nil case, commit c6660a6d6de9450f030db6d77eeaa76b8bdd14ef Author: Eli Zaretskii Date: Thu Feb 2 15:34:58 2023 +0200 Improve documentation of 'repeat-mode' and related variables * lisp/bindings.el (next-error-repeat-map) (page-navigation-repeat-map, undo-repeat-map): * lisp/tab-bar.el (tab-bar-switch-repeat-map) (tab-bar-move-repeat-map): * lisp/window.el (other-window-repeat-map) (resize-window-repeat-map): Mention repeatable commands in the doc strings. * lisp/repeat.el (repeat-exit-timeout, repeat-check-key) (repeat-echo-function, repeat-mode, repeat-check-key) (repeat-check-map, repeat-echo-message-string) (repeat-echo-message, repeat-echo-mode-line) (describe-repeat-maps): Improve wording of doc strings. (describe-repeat-maps): Improve wording of the heading line. (Bug#61183) * doc/emacs/basic.texi (Repeating): Clarify and improve wording of 'repeat-mode' documentation. diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index d8a354ff42d..a271cb65bdc 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -890,17 +890,37 @@ Repeating @findex describe-repeat-maps @vindex repeat-exit-key @vindex repeat-exit-timeout - Also you can activate @code{repeat-mode} that temporarily enables a -transient mode with short keys after a limited number of commands. -Currently supported shorter key sequences are @kbd{C-x u u} instead of -@kbd{C-x u C-x u} to undo many changes, @kbd{C-x o o} instead of -@kbd{C-x o C-x o} to switch several windows, @kbd{C-x @{ @{ @} @} ^ ^ -v v} to resize the selected window interactively, @kbd{M-g n n p p} to -navigate @code{next-error} matches, @kbd{C-x ] ] [ [} to navigate -through pages, and other keys listed by @code{describe-repeat-maps}. -Any other key exits transient mode and then is executed normally. The -user option @code{repeat-exit-key} defines an additional key to exit -this transient mode. Also it's possible to break the repetition chain -automatically after some idle time by customizing the user option + You can also activate @code{repeat-mode} which allows repeating +commands bound to sequences of two or more keys by typing a single +character. For example, after typing @w{@kbd{C-x u}} (@code{undo}, +@pxref{Undo}) to undo the most recent edits, you can undo many more +edits by typing @w{@kbd{u u u@dots{}}}. Similarly, type @w{@kbd{C-x o +o o@dots{}}} instead of @w{@kbd{C-x o C-x o C-x o@dots{}}} to switch +to the window several windows away. This works by entering a +transient repeating mode after you type the full key sequence that +invokes the command; the single-key shortcuts are shown in the echo +area. + +Only some commands support repetition in @code{repeat-mode}; type +@w{@kbd{M-x describe-repeat-maps @key{RET}}} to see which ones. + +The single-character shortcuts enabled by the transient repeating mode +do not need to be identical: for example, after typing @w{@kbd{C-x +@{}}, either @kbd{@{} or @kbd{@}} or @kbd{^} or @kbd{v}, or any series +that mixes these characters in any order, will resize the selected +window in respective ways. Similarly, after @w{@kbd{M-g n}} or +@kbd{M-g p}, typing any sequence of @kbd{n} and/or @kbd{p} in any mix +will repeat @code{next-error} and @code{previous-error} to navigate in +a @file{*compilation*} or @file{*grep*} buffer (@pxref{Compilation +Mode}). + +Typing any key other than those defined to repeat the previous command +exits the transient repeating mode, and then the key you typed is +executed normally. You can also define a key which will exit the +transient repeating mode @emph{without} executing the key which caused +the exit. To this end, customize the user option +@code{repeat-exit-key} to name a key; one natural value is @key{RET}. +Finally, it's possible to break the repetition chain automatically +after some amount of idle time: customize the user option @code{repeat-exit-timeout} to specify the idle time in seconds after -which this transient mode will be turned off. +which this transient repetition mode will be turned off automatically. diff --git a/lisp/bindings.el b/lisp/bindings.el index 34aa8399a96..f4881ac388c 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1009,7 +1009,7 @@ global-map ;; no idea whereas to bind it. Any suggestion welcome. -stef ;; (define-key ctl-x-map "U" 'undo-only) (defvar-keymap undo-repeat-map - :doc "Keymap to repeat undo key sequences \\`C-x u u'. Used in `repeat-mode'." + :doc "Keymap to repeat `undo' commands. Used in `repeat-mode'." :repeat t "u" #'undo) @@ -1106,7 +1106,7 @@ global-map (define-key ctl-x-map "`" 'next-error) (defvar-keymap next-error-repeat-map - :doc "Keymap to repeat `next-error' key sequences. Used in `repeat-mode'." + :doc "Keymap to repeat `next-error' and `previous-error'. Used in `repeat-mode'." :repeat t "n" #'next-error "M-n" #'next-error @@ -1468,7 +1468,7 @@ ctl-x-map (define-key ctl-x-map "]" 'forward-page) (defvar-keymap page-navigation-repeat-map - :doc "Keymap to repeat page navigation key sequences. Used in `repeat-mode'." + :doc "Keymap to repeat `forward-page' and `backward-page'. Used in `repeat-mode'." :repeat t "]" #'forward-page "[" #'backward-page) diff --git a/lisp/repeat.el b/lisp/repeat.el index ce59b310792..37d4aaec985 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -349,7 +349,7 @@ repeat-exit-key :version "28.1") (defcustom repeat-exit-timeout nil - "Break the repetition chain of keys after specified timeout. + "Break the repetition chain of keys after specified amount of idle time. When a number, exit the transient repeating mode after idle time of the specified number of seconds. You can also set the property `repeat-exit-timeout' on the command symbol. @@ -380,12 +380,12 @@ repeat-keep-prefix (defcustom repeat-check-key t "Whether to check that the last key exists in the repeat map. -When non-nil and the last typed key (with or without modifiers) -doesn't exist in the keymap attached by the `repeat-map' property, -then don't activate that keymap for the next command. So only the -same keys among repeatable keys are allowed in the repeating sequence. -For example, with a non-nil value, only \\`C-x u u' repeats undo, -whereas \\`C-/ u' doesn't. +When non-nil, and the last typed key (with or without modifiers) +doesn't exist in the keymap specified by the `repeat-map' property +of the command, don't activate that keymap for the next command. +Thus, when this is non-nil, only the same keys among repeatable +keys are allowed in the repeating sequence. For example, with a +non-nil value, only \\`C-x u u' repeats undo, whereas \\`C-/ u' doesn't. You can also set the property `repeat-check-key' on the command symbol. This property can override the value of this variable. @@ -398,7 +398,7 @@ 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: +The function is called after every repeatable command with one argument: 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" @@ -422,8 +422,12 @@ repeat-map ;;;###autoload (define-minor-mode repeat-mode "Toggle Repeat mode. -When Repeat mode is enabled, and the command symbol has the property named -`repeat-map', this map is activated temporarily for the next command. +When Repeat mode is enabled, certain commands bound to multi-key +sequences can be repeated by typing a single key, after typing the +full key sequence once. +The commands which can be repeated like that are those whose symbol + has the property `repeat-map' which specifies a keymap of single +keys for repeating. See `describe-repeat-maps' for a list of all repeatable commands." :global t :group 'repeat (if (not repeat-mode) @@ -459,7 +463,7 @@ repeat-get-map rep-map)))) (defun repeat-check-key (key map) - "Check if the last key is suitable to activate the repeating MAP." + "Check if the last KEY is suitable for activating the repeating MAP." (let* ((prop (repeat--command-property 'repeat-check-key)) (check-key (unless (eq prop 'no) (or prop repeat-check-key)))) (or (not check-key) @@ -471,7 +475,7 @@ repeat--prev-mb "Previous minibuffer state.") (defun repeat-check-map (map) - "Decides whether MAP can be used for the next command." + "Decide whether MAP can be used for the next command." (and map ;; Detect changes in the minibuffer state to allow repetitions ;; in the same minibuffer, but not when the minibuffer is activated @@ -547,7 +551,7 @@ repeat--exit (setq repeat-exit-function nil))) (defun repeat-echo-message-string (keymap) - "Return a string with a list of repeating keys." + "Return a string with the list of repeating keys in KEYMAP." (let (keys) (map-keymap (lambda (key cmd) (and cmd (push key keys))) keymap) (format-message "Repeat with %s%s" @@ -565,7 +569,8 @@ repeat-echo-message-string "")))) (defun repeat-echo-message (keymap) - "Display available repeating keys in the echo area." + "Display in the echo area the repeating keys defined by KEYMAP. +See `repeat-echo-function' to enable/disable." (let ((message-log-max nil)) (if keymap (let ((message (repeat-echo-message-string keymap))) @@ -586,7 +591,9 @@ repeat-echo-mode-line-string "String displayed in the mode line in repeating mode.") (defun repeat-echo-mode-line (keymap) - "Display the repeat indicator in the mode line." + "Display the repeat indicator in the mode line. +KEYMAP should be non-nil, but is otherwise ignored. +See `repeat-echo-function' to enable/disable." (if keymap (unless (assq 'repeat-in-progress mode-line-modes) (add-to-list 'mode-line-modes (list 'repeat-in-progress @@ -596,9 +603,11 @@ repeat-echo-mode-line (declare-function help-fns--analyze-function "help-fns" (function)) (defun describe-repeat-maps () - "Describe mappings of commands repeatable by symbol property `repeat-map'. -If `repeat-mode' is enabled, these keymaps determine which single key -can be used to repeat a command invoked via a full key sequence." + "Describe transient keymaps installed for repeating multi-key commands. +These keymaps enable repetition of commands bound to multi-key +sequences by typing just one key, when `repeat-mode' is enabled. +Commands that can be repeated this way must have their symbol +to have the `repeat-map' property whose value specified a keymap." (interactive) (require 'help-fns) (let ((help-buffer-under-preparation t)) @@ -613,7 +622,9 @@ describe-repeat-maps (with-help-window (help-buffer) (with-current-buffer standard-output (setq-local outline-regexp "[*]+") - (insert "A list of keymaps used by commands with the symbol property `repeat-map'.\n") + (insert "\ +A list of keymaps and their single-key shortcuts for repeating commands. +Click on a keymap to see the commands repeatable by the keymap.\n") (dolist (keymap (sort keymaps (lambda (a b) (when (and (symbolp (car a)) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 119a243d6b3..dce6fa735fc 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -2624,14 +2624,14 @@ 'tab-list (keymap-set tab-prefix-map "t" #'other-tab-prefix) (defvar-keymap tab-bar-switch-repeat-map - :doc "Keymap to repeat tab switch key sequences \\`C-x t o o O'. + :doc "Keymap to repeat tab switch commands `tab-next' and `tab-previous'. Used in `repeat-mode'." :repeat t "o" #'tab-next "O" #'tab-previous) (defvar-keymap tab-bar-move-repeat-map - :doc "Keymap to repeat tab move key sequences \\`C-x t m m M'. + :doc "Keymap to repeat tab move commands `tab-move' and `tab-bar-move-tab-backward'. Used in `repeat-mode'." :repeat t "m" #'tab-move diff --git a/lisp/window.el b/lisp/window.el index 0cd30822ff6..2d9f746d8fb 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -10567,8 +10567,7 @@ ctl-x-4-map (define-key ctl-x-4-map "4" 'other-window-prefix) (defvar-keymap other-window-repeat-map - :doc "Keymap to repeat `other-window' key sequences. -Used in `repeat-mode'." + :doc "Keymap to repeat `other-window'. Used in `repeat-mode'." :repeat t "o" #'other-window "O" (lambda () @@ -10578,6 +10577,8 @@ other-window-repeat-map (defvar-keymap resize-window-repeat-map :doc "Keymap to repeat window resizing commands. +Repeatable commands are `enlarge-window' and `shrink-window', +and also `enlarge-window-horizontally' and `shrink-window-horizontally'. Used in `repeat-mode'." :repeat t ;; Standard keys: commit be304bb3286eb27e1aa8248eb3904925ed73dfcb Author: Eli Zaretskii Date: Thu Feb 2 12:35:16 2023 +0200 ; * etc/NEWS: Mention the 'utf-8-auto' bugfix (bug#60750). diff --git a/etc/NEWS b/etc/NEWS index fb211f9b7d0..d402cc82c4a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -563,6 +563,20 @@ The variable 'font-lock-support-mode' is occasionally useful for debugging purposes. It is now a regular variable (instead of a user option) and can be set to nil to disable Just-in-time Lock mode. ++++ +** The 'utf-8-auto' coding-system now produces BOM on encoding. +This is actually a bugfix, since this is how 'utf-8-auto' was +documented from day one; it just didn't behave according to +documentation. It turns out some Lisp programs were using this +coding-system on the wrong assumption that the "auto" part means some +automagic handling of the end-of-line (EOL) format conversion; those +program will now start to fail, because BOM signature in UTF-8 encoded +text is rarely expected. That is the reason we mention this bugfix +here. + +In general, this coding-system should probably never be used for +encoding, only for decoding. + * Changes in Emacs 29.1 commit 0571a3cc87f7c449796bb3eef38af4b2719b0bdf Merge: c831f55b234 9715715ac16 Author: Stefan Kangas Date: Thu Feb 2 06:30:28 2023 +0100 Merge from origin/emacs-29 9715715ac16 (eshell--complete-commands-list): Fix regression in fix t... ea1bb263153 * doc/emacs/basic.texi (Repeating): Mention describe-repe... f91bf9df892 Unbreak the MS-Windows build commit 9715715ac163fc0b3ce6e170eb9c74b5f4ad8267 Author: Nicolas Martyanoff Date: Wed Feb 1 22:17:57 2023 -0500 (eshell--complete-commands-list): Fix regression in fix to bug#48995 Copyright-Paperwork-Exempt: Yes * lisp/eshell/em-cmpl.el (eshell--complete-commands-list): Fix misuse of `completion-table-dynamic` when completing a file name. diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index ca51cee2558..4f656b16a8e 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -378,31 +378,6 @@ eshell-complete-parse-arguments args) posns))) -(defun eshell--pcomplete-executables () - "Complete amongst a list of directories and executables. - -Wrapper for `pcomplete-executables' or `pcomplete-dirs-or-entries', -depending on the value of `eshell-force-execution'. - -Adds path prefix to candidates independent of `action' value." - ;; `pcomplete-entries' returns filenames without path on `action' to - ;; use current string directory as done in `completion-file-name-table' - ;; when `action' is nil to construct executable candidates. - (let ((table (if eshell-force-execution - (pcomplete-dirs-or-entries nil #'file-readable-p) - (pcomplete-executables)))) - (lambda (string pred action) - (let ((cands (funcall table string pred action))) - (if (eq action t) - (let ((specdir (file-name-directory string))) - (mapcar - (lambda (cand) - (if (stringp cand) - (file-name-concat specdir cand) - cand)) - cands)) - cands))))) - (defun eshell--complete-commands-list () "Generate list of applicable, visible commands." ;; Building the commands list can take quite a while, especially over Tramp @@ -413,11 +388,19 @@ eshell--complete-commands-list ;; we complete. Adjust `pcomplete-stub' accordingly! (if (and (> (length pcomplete-stub) 0) (eq (aref pcomplete-stub 0) eshell-explicit-command-char)) - (setq pcomplete-stub (substring pcomplete-stub 1))))) - (completion-table-dynamic - (lambda (filename) - (if (file-name-directory filename) - (eshell--pcomplete-executables) + (setq pcomplete-stub (substring pcomplete-stub 1)))) + (filename (pcomplete-arg))) + ;; Do not use `completion-table-dynamic' when completing a command file + ;; name since it doesn't know about boundaries and would end up doing silly + ;; things like adding a SPC char when completing to "/usr/sbin/". + ;; + ;; If you work on this function, be careful not to reintroduce bug#48995. + (if (file-name-directory filename) + (if eshell-force-execution + (pcomplete-dirs-or-entries nil #'file-readable-p) + (pcomplete-executables)) + (completion-table-dynamic + (lambda (filename) (let* ((paths (eshell-get-path)) (cwd (file-name-as-directory (expand-file-name default-directory))) commit c831f55b234725a99f908656f996f3e6addc8825 Author: Juri Linkov Date: Wed Feb 1 20:14:06 2023 +0200 * lisp/progmodes/ruby-ts-mode.el: Extend treesit-sexp-type-regexp. (ruby-ts-mode): Add more node types to treesit-sexp-type-regexp. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 1144caf79b6..9fc0c360a2a 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1042,9 +1042,12 @@ ruby-ts-mode "parenthesized_statements" "if" "case" + "when" "block" "do_block" - "begin"))) + "begin" + "binary" + "assignment"))) ;; AFAIK, Ruby can not nest methods (setq-local treesit-defun-prefer-top-level nil) commit ea1bb263153d406479e782872820af4f9926ac7d Author: Juri Linkov Date: Wed Feb 1 20:05:52 2023 +0200 * doc/emacs/basic.texi (Repeating): Mention describe-repeat-maps (bug#61183). * lisp/repeat.el (describe-repeat-maps): Add more explanation to the docstring. Suggested by Robert Pluim . diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index 2cc45a8805e..d8a354ff42d 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -887,6 +887,7 @@ Repeating subsequent @kbd{z} repeats it once again. @findex repeat-mode +@findex describe-repeat-maps @vindex repeat-exit-key @vindex repeat-exit-timeout Also you can activate @code{repeat-mode} that temporarily enables a @@ -895,11 +896,11 @@ Repeating @kbd{C-x u C-x u} to undo many changes, @kbd{C-x o o} instead of @kbd{C-x o C-x o} to switch several windows, @kbd{C-x @{ @{ @} @} ^ ^ v v} to resize the selected window interactively, @kbd{M-g n n p p} to -navigate @code{next-error} matches, and @kbd{C-x ] ] [ [} to navigate -through pages. Any other key exits transient mode and then is -executed normally. The user option @code{repeat-exit-key} defines an -additional key to exit this transient mode. Also it's possible to -break the repetition chain automatically after some idle time by -customizing the user option @code{repeat-exit-timeout} to specify the -idle time in seconds after which this transient mode will be turned -off. +navigate @code{next-error} matches, @kbd{C-x ] ] [ [} to navigate +through pages, and other keys listed by @code{describe-repeat-maps}. +Any other key exits transient mode and then is executed normally. The +user option @code{repeat-exit-key} defines an additional key to exit +this transient mode. Also it's possible to break the repetition chain +automatically after some idle time by customizing the user option +@code{repeat-exit-timeout} to specify the idle time in seconds after +which this transient mode will be turned off. diff --git a/lisp/repeat.el b/lisp/repeat.el index 0124ff4bc0c..ce59b310792 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -597,7 +597,8 @@ repeat-echo-mode-line (defun describe-repeat-maps () "Describe mappings of commands repeatable by symbol property `repeat-map'. -Used in `repeat-mode'." +If `repeat-mode' is enabled, these keymaps determine which single key +can be used to repeat a command invoked via a full key sequence." (interactive) (require 'help-fns) (let ((help-buffer-under-preparation t)) commit 8c6a4639318f09720cda295e6a93677153046d84 Author: Michael Albinus Date: Wed Feb 1 18:40:11 2023 +0100 Handle large process output strings for Tramp * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Improve handling of connection-type `pipe'. * test/lisp/tramp-tests.el (tramp-test29-start-file-process) (tramp-test30-make-process): Extend tests. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 48d91bd733e..d1f723e9807 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3003,13 +3003,21 @@ tramp-sh-handle-make-process (process-put p 'remote-pid pid) (tramp-set-connection-property p "remote-pid" pid)) - ;; Disable carriage return to newline - ;; translation. This does not work on - ;; macOS, see Bug#50748. - (when (and (memq connection-type '(nil pipe)) - (not - (tramp-check-remote-uname v "Darwin"))) - (tramp-send-command v "stty -icrnl")) + (when (memq connection-type '(nil pipe)) + ;; Disable carriage return to newline + ;; translation. This does not work on + ;; macOS, see Bug#50748. + ;; We must also disable buffering, + ;; otherwise strings larger than 4096 + ;; bytes, sent by the process, could + ;; block, see termios(3) and + ;; . + ;; FIXME: Shall we rather use "stty raw"? + (if (tramp-check-remote-uname v "Darwin") + (tramp-send-command + v "stty -icanon min 1 time 0") + (tramp-send-command + v "stty -icrnl -icanon min 1 time 0"))) ;; `tramp-maybe-open-connection' and ;; `tramp-send-command-and-read' could ;; have trashed the connection buffer. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 338482d2b61..cc93970be28 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4923,6 +4923,9 @@ tramp-test29-start-file-process (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) + ;; Give the pipe process a chance to start. + (when (memq process-connection-type '(nil pipe)) + (sit-for 0.1 'nodisp)) (process-send-string proc "foo\r\n") (process-send-eof proc) ;; Read output. @@ -5194,7 +5197,7 @@ tramp-test30-make-process ;; `process-connection-type' is taken when ;; `:connection-type' is nil. (dolist (process-connection-type - (unless connection-type '(nil pipe t pty))) + (if connection-type '(nil pipe t pty) '(nil))) (unwind-protect (with-temp-buffer (setq command '("hexdump" "-v" "-e" "/1 \"%02X\n\"") @@ -5210,6 +5213,10 @@ tramp-test30-make-process (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) + ;; Give the pipe process a chance to start. + (when (or (eq connection-type 'pipe) + (memq process-connection-type '(nil pipe))) + (sit-for 0.1 'nodisp)) (process-send-string proc "foo\r\n") (process-send-eof proc) ;; Read output. commit f91bf9df892417a2e4add6d0d77ac5123a579bfc Author: Eli Zaretskii Date: Wed Feb 1 14:13:54 2023 +0200 Unbreak the MS-Windows build * src/treesit.c (ts_query_pattern_count) [WINDOWSNT]: Load from the library and define as macro. diff --git a/src/treesit.c b/src/treesit.c index b163685419f..405aec1f47e 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -72,6 +72,7 @@ Copyright (C) 2021-2023 Free Software Foundation, Inc. #undef ts_query_cursor_set_byte_range #undef ts_query_delete #undef ts_query_new +#undef ts_query_pattern_count #undef ts_query_predicates_for_pattern #undef ts_query_string_value_for_id #undef ts_set_allocator @@ -135,6 +136,7 @@ DEF_DLL_FN (void, ts_query_cursor_set_byte_range, DEF_DLL_FN (void, ts_query_delete, (TSQuery *)); DEF_DLL_FN (TSQuery *, ts_query_new, (const TSLanguage *, const char *, uint32_t, uint32_t *, TSQueryError *)); +DEF_DLL_FN (uint32_t, ts_query_pattern_count, (const TSQuery *)); DEF_DLL_FN (const TSQueryPredicateStep *, ts_query_predicates_for_pattern, ( const TSQuery *, uint32_t, uint32_t *)); DEF_DLL_FN (const char *, ts_query_string_value_for_id, @@ -200,6 +202,7 @@ init_treesit_functions (void) LOAD_DLL_FN (library, ts_query_cursor_set_byte_range); LOAD_DLL_FN (library, ts_query_delete); LOAD_DLL_FN (library, ts_query_new); + LOAD_DLL_FN (library, ts_query_pattern_count); LOAD_DLL_FN (library, ts_query_predicates_for_pattern); LOAD_DLL_FN (library, ts_query_string_value_for_id); LOAD_DLL_FN (library, ts_set_allocator); @@ -256,6 +259,7 @@ #define ts_query_cursor_next_match fn_ts_query_cursor_next_match #define ts_query_cursor_set_byte_range fn_ts_query_cursor_set_byte_range #define ts_query_delete fn_ts_query_delete #define ts_query_new fn_ts_query_new +#define ts_query_pattern_count fn_ts_query_pattern_count #define ts_query_predicates_for_pattern fn_ts_query_predicates_for_pattern #define ts_query_string_value_for_id fn_ts_query_string_value_for_id #define ts_set_allocator fn_ts_set_allocator commit 0214e9021b4dbbda1b6040e3b692f29d77a3b8cc Merge: cfde8a14900 f7fcc62b78a Author: Stefan Kangas Date: Wed Feb 1 06:30:39 2023 +0100 ; Merge from origin/emacs-29 The following commit was skipped: f7fcc62b78a ; Auto-commit of loaddefs files. commit cfde8a1490072f43297af8f85b50f3b18db892ef Merge: f724fca732a 66aa9cb450a Author: Stefan Kangas Date: Wed Feb 1 06:30:39 2023 +0100 Merge from origin/emacs-29 66aa9cb450a ; (Ftreesit_query_capture): Fix typo f711f4e99f7 (Ftreesit_query_capture): Cache list of predicates for gi... 47ab9ba55d7 * lisp/keymap.el (keymap-global-unset): Correct prompt 49b61405582 Fix cursor-in-echo-area on TTY frames commit f724fca732a61536c684d07f21ef34c0f7ca335e Author: Stefan Kangas Date: Wed Feb 1 05:08:57 2023 +0100 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 4d5921582cc..73d47804e5d 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -2918,13 +2918,18 @@ "bytecomp" (register-definition-prefixes "semantic/bovine/c" '("semantic")) + +;;; Generated autoloads from progmodes/c-ts-common.el + +(register-definition-prefixes "c-ts-common" '("c-ts-")) + ;;; Generated autoloads from progmodes/c-ts-mode.el (autoload 'c-ts-base-mode "c-ts-mode" "\ Major mode for editing C, powered by tree-sitter. -\\{c-ts-mode-map} +\\{c-ts-base-mode-map} (fn)" t) (autoload 'c-ts-mode "c-ts-mode" "\ @@ -2932,14 +2937,47 @@ "semantic/bovine/c" This mode is independent from the classic cc-mode.el based `c-mode', so configuration variables of that mode, like -`c-basic-offset', don't affect this mode. +`c-basic-offset', doesn't affect this mode. + +To use tree-sitter C/C++ modes by default, evaluate + + (add-to-list \\='major-mode-remap-alist \\='(c-mode . c-ts-mode)) + (add-to-list \\='major-mode-remap-alist \\='(c++-mode . c++-ts-mode)) + (add-to-list \\='major-mode-remap-alist + \\='(c-or-c++-mode . c-or-c++-ts-mode)) + +in your configuration. (fn)" t) (autoload 'c++-ts-mode "c-ts-mode" "\ Major mode for editing C++, powered by tree-sitter. +This mode is independent from the classic cc-mode.el based +`c++-mode', so configuration variables of that mode, like +`c-basic-offset', don't affect this mode. + +To use tree-sitter C/C++ modes by default, evaluate + + (add-to-list \\='major-mode-remap-alist \\='(c-mode . c-ts-mode)) + (add-to-list \\='major-mode-remap-alist \\='(c++-mode . c++-ts-mode)) + (add-to-list \\='major-mode-remap-alist + \\='(c-or-c++-mode . c-or-c++-ts-mode)) + +in your configuration. + (fn)" t) -(register-definition-prefixes "c-ts-mode" '("c-ts-mode-")) +(autoload 'c-or-c++-ts-mode "c-ts-mode" "\ +Analyze buffer and enable either C or C++ mode. + +Some people and projects use .h extension for C++ header files +which is also the one used for C header files. This makes +matching on file name insufficient for detecting major mode that +should be used. + +This function attempts to use file contents to determine whether +the code is C or C++ and based on that chooses whether to enable +`c-ts-mode' or `c++-ts-mode'." t) +(register-definition-prefixes "c-ts-mode" '("c-ts-")) ;;; Generated autoloads from calendar/cal-bahai.el @@ -4652,7 +4690,6 @@ "cmacexp" ;;; Generated autoloads from progmodes/cmake-ts-mode.el -(add-to-list 'auto-mode-alist '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode)) (autoload 'cmake-ts-mode "cmake-ts-mode" "\ Major mode for editing CMake files, powered by tree-sitter. @@ -5635,7 +5672,6 @@ "semantic/symref/cscope" ;;; Generated autoloads from progmodes/csharp-mode.el -(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) (autoload 'csharp-mode "csharp-mode" "\ Major mode for editing Csharp code. @@ -8011,7 +8047,6 @@ "doc-view" ;;; Generated autoloads from progmodes/dockerfile-ts-mode.el -(add-to-list 'auto-mode-alist '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . dockerfile-ts-mode)) (autoload 'dockerfile-ts-mode "dockerfile-ts-mode" "\ Major mode for editing Dockerfiles, powered by tree-sitter. @@ -9157,7 +9192,7 @@ "edt-vt100" ;;; Generated autoloads from progmodes/eglot.el -(push (purecopy '(eglot 1 10)) package--builtin-versions) +(push (purecopy '(eglot 1 11)) package--builtin-versions) (autoload 'eglot "eglot" "\ Start LSP server in support of PROJECT's buffers under MANAGED-MAJOR-MODE. @@ -9195,7 +9230,7 @@ "edt-vt100" LANGUAGE-ID is the language ID string to send to the server for MANAGED-MAJOR-MODE, which matters to a minority of servers. -INTERACTIVE is t if called interactively. +INTERACTIVE is ignored and provided for backward compatibility. (fn MANAGED-MAJOR-MODE PROJECT CLASS CONTACT LANGUAGE-ID &optional INTERACTIVE)" t) (autoload 'eglot-ensure "eglot" "\ @@ -14368,12 +14403,12 @@ "gnutls" ;;; Generated autoloads from progmodes/go-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode)) (autoload 'go-ts-mode "go-ts-mode" "\ Major mode for editing Go, powered by tree-sitter. +\\{go-ts-mode-map} + (fn)" t) -(add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode)) (autoload 'go-mod-ts-mode "go-ts-mode" "\ Major mode for editing go.mod files, powered by tree-sitter. @@ -16204,6 +16239,15 @@ "holidays" (register-definition-prefixes "semantic/html" '("semantic-")) + +;;; Generated autoloads from textmodes/html-ts-mode.el + +(autoload 'html-ts-mode "html-ts-mode" "\ +Major mode for editing Html, powered by tree-sitter. + +(fn)" t) +(register-definition-prefixes "html-ts-mode" '("html-ts-mode-")) + ;;; Generated autoloads from htmlfontify.el @@ -25121,7 +25165,7 @@ "ede/proj-shared" ;;; Generated autoloads from progmodes/project.el -(push (purecopy '(project 0 9 4)) package--builtin-versions) +(push (purecopy '(project 0 9 6)) package--builtin-versions) (autoload 'project-current "project" "\ Return the project instance in DIRECTORY, defaulting to `default-directory'. @@ -27362,6 +27406,7 @@ "ruby-mode" ;;; Generated autoloads from progmodes/ruby-ts-mode.el +(push (purecopy '(ruby-ts-mode 0 2)) package--builtin-versions) (autoload 'ruby-ts-mode "ruby-ts-mode" "\ Major mode for editing Ruby, powered by tree-sitter. @@ -27397,7 +27442,6 @@ "ruler-mode" ;;; Generated autoloads from progmodes/rust-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode)) (autoload 'rust-ts-mode "rust-ts-mode" "\ Major mode for editing Rust, powered by tree-sitter. @@ -33066,8 +33110,6 @@ "type-break" ;;; Generated autoloads from progmodes/typescript-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode)) -(add-to-list 'auto-mode-alist '("\\.tsx\\'" . tsx-ts-mode)) (autoload 'typescript-ts-base-mode "typescript-ts-mode" "\ Major mode for editing TypeScript. @@ -33808,7 +33850,7 @@ "url-vars" ;;; Generated autoloads from use-package/use-package.el -(push (purecopy '(use-package 2 4 4)) package--builtin-versions) +(push (purecopy '(use-package 2 4 5)) package--builtin-versions) ;;; Generated autoloads from use-package/use-package-bind-key.el @@ -34415,7 +34457,8 @@ 'vc-update operation on the current branch, prompting for the precise command if required. Optional prefix ARG non-nil forces a prompt for the VCS command to run. If this is successful, a \"push\" -operation will then be done. +operation will then be done. This is supported only in backends +where the pull operation returns a process. On a non-distributed version control system, this signals an error. It also signals an error in a Bazaar bound branch. @@ -37012,7 +37055,6 @@ "xwidget" ;;; Generated autoloads from textmodes/yaml-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode)) (autoload 'yaml-ts-mode "yaml-ts-mode" "\ Major mode for editing YAML, powered by tree-sitter. commit f7fcc62b78a7617b12f3d1f39801e0eef69ee3b6 Author: Stefan Kangas Date: Wed Feb 1 05:08:25 2023 +0100 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index a463a7da67e..dfb076e52df 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -2918,13 +2918,18 @@ "bytecomp" (register-definition-prefixes "semantic/bovine/c" '("semantic")) + +;;; Generated autoloads from progmodes/c-ts-common.el + +(register-definition-prefixes "c-ts-common" '("c-ts-")) + ;;; Generated autoloads from progmodes/c-ts-mode.el (autoload 'c-ts-base-mode "c-ts-mode" "\ Major mode for editing C, powered by tree-sitter. -\\{c-ts-mode-map} +\\{c-ts-base-mode-map} (fn)" t) (autoload 'c-ts-mode "c-ts-mode" "\ @@ -2932,7 +2937,16 @@ "semantic/bovine/c" This mode is independent from the classic cc-mode.el based `c-mode', so configuration variables of that mode, like -`c-basic-offset', don't affect this mode. +`c-basic-offset', doesn't affect this mode. + +To use tree-sitter C/C++ modes by default, evaluate + + (add-to-list \\='major-mode-remap-alist \\='(c-mode . c-ts-mode)) + (add-to-list \\='major-mode-remap-alist \\='(c++-mode . c++-ts-mode)) + (add-to-list \\='major-mode-remap-alist + \\='(c-or-c++-mode . c-or-c++-ts-mode)) + +in your configuration. (fn)" t) (autoload 'c++-ts-mode "c-ts-mode" "\ @@ -2942,8 +2956,28 @@ "semantic/bovine/c" `c++-mode', so configuration variables of that mode, like `c-basic-offset', don't affect this mode. +To use tree-sitter C/C++ modes by default, evaluate + + (add-to-list \\='major-mode-remap-alist \\='(c-mode . c-ts-mode)) + (add-to-list \\='major-mode-remap-alist \\='(c++-mode . c++-ts-mode)) + (add-to-list \\='major-mode-remap-alist + \\='(c-or-c++-mode . c-or-c++-ts-mode)) + +in your configuration. + (fn)" t) -(register-definition-prefixes "c-ts-mode" '("c-ts-mode-")) +(autoload 'c-or-c++-ts-mode "c-ts-mode" "\ +Analyze buffer and enable either C or C++ mode. + +Some people and projects use .h extension for C++ header files +which is also the one used for C header files. This makes +matching on file name insufficient for detecting major mode that +should be used. + +This function attempts to use file contents to determine whether +the code is C or C++ and based on that chooses whether to enable +`c-ts-mode' or `c++-ts-mode'." t) +(register-definition-prefixes "c-ts-mode" '("c-ts-")) ;;; Generated autoloads from calendar/cal-bahai.el @@ -4656,7 +4690,6 @@ "cmacexp" ;;; Generated autoloads from progmodes/cmake-ts-mode.el -(add-to-list 'auto-mode-alist '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode)) (autoload 'cmake-ts-mode "cmake-ts-mode" "\ Major mode for editing CMake files, powered by tree-sitter. @@ -5639,7 +5672,6 @@ "semantic/symref/cscope" ;;; Generated autoloads from progmodes/csharp-mode.el -(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) (autoload 'csharp-mode "csharp-mode" "\ Major mode for editing Csharp code. @@ -8015,7 +8047,6 @@ "doc-view" ;;; Generated autoloads from progmodes/dockerfile-ts-mode.el -(add-to-list 'auto-mode-alist '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . dockerfile-ts-mode)) (autoload 'dockerfile-ts-mode "dockerfile-ts-mode" "\ Major mode for editing Dockerfiles, powered by tree-sitter. @@ -9159,7 +9190,7 @@ "edt-vt100" ;;; Generated autoloads from progmodes/eglot.el -(push (purecopy '(eglot 1 10)) package--builtin-versions) +(push (purecopy '(eglot 1 11)) package--builtin-versions) (autoload 'eglot "eglot" "\ Start LSP server in support of PROJECT's buffers under MANAGED-MAJOR-MODE. @@ -9197,7 +9228,7 @@ "edt-vt100" LANGUAGE-ID is the language ID string to send to the server for MANAGED-MAJOR-MODE, which matters to a minority of servers. -INTERACTIVE is t if called interactively. +INTERACTIVE is ignored and provided for backward compatibility. (fn MANAGED-MAJOR-MODE PROJECT CLASS CONTACT LANGUAGE-ID &optional INTERACTIVE)" t) (autoload 'eglot-ensure "eglot" "\ @@ -14368,12 +14399,10 @@ "gnutls" ;;; Generated autoloads from progmodes/go-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode)) (autoload 'go-ts-mode "go-ts-mode" "\ Major mode for editing Go, powered by tree-sitter. (fn)" t) -(add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode)) (autoload 'go-mod-ts-mode "go-ts-mode" "\ Major mode for editing go.mod files, powered by tree-sitter. @@ -25116,7 +25145,7 @@ "ede/proj-shared" ;;; Generated autoloads from progmodes/project.el -(push (purecopy '(project 0 9 4)) package--builtin-versions) +(push (purecopy '(project 0 9 6)) package--builtin-versions) (autoload 'project-current "project" "\ Return the project instance in DIRECTORY, defaulting to `default-directory'. @@ -27357,6 +27386,7 @@ "ruby-mode" ;;; Generated autoloads from progmodes/ruby-ts-mode.el +(push (purecopy '(ruby-ts-mode 0 2)) package--builtin-versions) (autoload 'ruby-ts-mode "ruby-ts-mode" "\ Major mode for editing Ruby, powered by tree-sitter. @@ -27392,7 +27422,6 @@ "ruler-mode" ;;; Generated autoloads from progmodes/rust-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode)) (autoload 'rust-ts-mode "rust-ts-mode" "\ Major mode for editing Rust, powered by tree-sitter. @@ -33074,8 +33103,6 @@ "type-break" ;;; Generated autoloads from progmodes/typescript-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode)) -(add-to-list 'auto-mode-alist '("\\.tsx\\'" . tsx-ts-mode)) (autoload 'typescript-ts-base-mode "typescript-ts-mode" "\ Major mode for editing TypeScript. @@ -33816,7 +33843,7 @@ "url-vars" ;;; Generated autoloads from use-package/use-package.el -(push (purecopy '(use-package 2 4 4)) package--builtin-versions) +(push (purecopy '(use-package 2 4 5)) package--builtin-versions) ;;; Generated autoloads from use-package/use-package-bind-key.el @@ -34423,7 +34450,8 @@ 'vc-update operation on the current branch, prompting for the precise command if required. Optional prefix ARG non-nil forces a prompt for the VCS command to run. If this is successful, a \"push\" -operation will then be done. +operation will then be done. This is supported only in backends +where the pull operation returns a process. On a non-distributed version control system, this signals an error. It also signals an error in a Bazaar bound branch. @@ -37001,7 +37029,6 @@ "xwidget" ;;; Generated autoloads from textmodes/yaml-ts-mode.el -(add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode)) (autoload 'yaml-ts-mode "yaml-ts-mode" "\ Major mode for editing YAML, powered by tree-sitter. commit 66aa9cb450ae3f313e836eed27de553df736e0f3 Author: Dmitry Gutov Date: Wed Feb 1 03:53:38 2023 +0200 ; (Ftreesit_query_capture): Fix typo diff --git a/src/treesit.c b/src/treesit.c index a5815903b4d..b163685419f 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2755,7 +2755,8 @@ DEFUN ("treesit-query-capture", Lisp_Object predicates = AREF (predicates_table, match.pattern_index); if (EQ (predicates, Qt)) { - predicates = treesit_predicates_for_pattern (treesit_query, 0); + predicates = treesit_predicates_for_pattern (treesit_query, + match.pattern_index); ASET (predicates_table, match.pattern_index, predicates); } commit f711f4e99f7f2b213e70d14c808261b93ed10c36 Author: Dmitry Gutov Date: Wed Feb 1 03:45:55 2023 +0200 (Ftreesit_query_capture): Cache list of predicates for given pattern index * src/treesit.c (Ftreesit_query_capture): Cache list of predicates for given pattern index (bug#60953). diff --git a/src/treesit.c b/src/treesit.c index b210ec0923a..a5815903b4d 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2720,8 +2720,10 @@ DEFUN ("treesit-query-capture", every for loop and nconc it to RESULT every time. That is indeed the initial implementation in which Yoav found nconc being the bottleneck (98.4% of the running time spent on nconc). */ + uint32_t patterns_count = ts_query_pattern_count (treesit_query); Lisp_Object result = Qnil; Lisp_Object prev_result = result; + Lisp_Object predicates_table = make_vector (patterns_count, Qt); while (ts_query_cursor_next_match (cursor, &match)) { /* Record the checkpoint that we may roll back to. */ @@ -2750,9 +2752,12 @@ DEFUN ("treesit-query-capture", result = Fcons (cap, result); } /* Get predicates. */ - Lisp_Object predicates - = treesit_predicates_for_pattern (treesit_query, - match.pattern_index); + Lisp_Object predicates = AREF (predicates_table, match.pattern_index); + if (EQ (predicates, Qt)) + { + predicates = treesit_predicates_for_pattern (treesit_query, 0); + ASET (predicates_table, match.pattern_index, predicates); + } /* captures_lisp = Fnreverse (captures_lisp); */ struct capture_range captures_range = { result, prev_result }; commit 47ab9ba55d77746a666bfa0819ccb465184949dc Author: Robert Pluim Date: Tue Jan 31 18:17:41 2023 +0100 * lisp/keymap.el (keymap-global-unset): Correct prompt diff --git a/lisp/keymap.el b/lisp/keymap.el index caabedd5aec..de90b03ba64 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -107,7 +107,7 @@ keymap-global-unset instead of unsetting it. See `keymap-unset' for details." (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) (interactive - (list (key-description (read-key-sequence "Set key locally: ")) + (list (key-description (read-key-sequence "Unset key globally: ")) current-prefix-arg)) (keymap-unset (current-global-map) key remove)) commit 49b61405582edaa1cda05ea37b056d46b423271b Author: Eli Zaretskii Date: Tue Jan 31 18:03:28 2023 +0200 Fix cursor-in-echo-area on TTY frames * src/dispnew.c (update_frame_1): Fix off-by-one error when positioning the cursor in the echo-area. (Bug#61184) diff --git a/src/dispnew.c b/src/dispnew.c index a0a37acb804..87ec83acdf3 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5009,6 +5009,10 @@ update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p, } while (row > top && col == 0); + /* We exit the loop with COL at the glyph _after_ the last one. */ + if (col > 0) + col--; + /* Make sure COL is not out of range. */ if (col >= FRAME_CURSOR_X_LIMIT (f)) { commit a73b046c7d5cb1d0eb2a69f2c96646d71dfbf66e Merge: e7d0aa248e6 1684e254a3b Author: Stefan Kangas Date: Tue Jan 31 06:30:26 2023 +0100 Merge from origin/emacs-29 1684e254a3b Update to Transient v0.3.7-196-gb91f509 327941b2112 CC Mode: Fix a coding bug in c-make-keywords-re. This sh... 2f3683cd4dc * lisp/isearch.el (isearch-emoji-by-name): Disable derive... 86b03046c00 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/... e866490a077 Fix keymap inheritance in descendants of 'c-ts-base-mode' f67a9a12b7b Fix interactive use of `keymap-local-set' and `keymap-glo... commit e7d0aa248e684a6de0d655d93bfcfee06cc8ff09 Author: Jim Porter Date: Sun Jan 22 13:20:46 2023 -0800 During completion, convert all Eshell arguments to strings Eshell was already converting some types (numbers, nil) to strings, as well as fixing up multiple-dot forms like ".../", so this way is more consistent and should produce fewer problems for Pcomplete functions. * lisp/eshell/em-cmpl.el (eshell-complete-parse-arguments): Always convert parsed arguments to strings. * test/lisp/eshell/em-cmpl-tests.el (eshell-arguments-equal, eshell-arguments-equal--equal-explainer): New functions. (em-cmpl-test/parse-arguments/pipeline) (em-cmpl-test/parse-arguments/multiple-dots) (em-cmpl-test/parse-arguments/variable/numeric) (em-cmpl-test/parse-arguments/variable/nil) (em-cmpl-test/parse-arguments/variable/list) (em-cmpl-test/parse-arguments/variable/splice): Use 'eshell-arguments-equal'. diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index d1c7e81090a..acbf206a3c6 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -386,17 +386,19 @@ eshell-complete-parse-arguments ;; Convert arguments to forms that Pcomplete can understand. (cons (mapcar (lambda (arg) - (cond - ((numberp arg) - (number-to-string arg)) - ;; Expand ".../" etc that only Eshell understands to the - ;; standard "../../". - ((and (stringp arg) (string-match "\\.\\.\\.+/" arg)) - (eshell-expand-multiple-dots arg)) - ((null arg) - "") - (t - arg))) + (pcase arg + ;; Expand ".../" etc that only Eshell understands to + ;; the standard "../../". + ((rx ".." (+ ".") "/") + (propertize (eshell-expand-multiple-dots arg) + 'pcomplete-arg-value arg)) + ((pred stringp) + arg) + ('nil + (propertize "" 'pcomplete-arg-value arg)) + (_ + (propertize (eshell-stringify arg) + 'pcomplete-arg-value arg)))) args) posns))) diff --git a/test/lisp/eshell/em-cmpl-tests.el b/test/lisp/eshell/em-cmpl-tests.el index 3f8f890f6e5..12a156fbb38 100644 --- a/test/lisp/eshell/em-cmpl-tests.el +++ b/test/lisp/eshell/em-cmpl-tests.el @@ -44,6 +44,26 @@ eshell-insert-and-complete (completion-at-point) (eshell-get-old-input)) +(defun eshell-arguments-equal (actual expected) + "Return t if ACTUAL and EXPECTED are equal, including properties of strings. +ACTUAL and EXPECTED should both be lists of strings." + (when (length= actual (length expected)) + (catch 'not-equal + (cl-mapc (lambda (i j) + (unless (equal-including-properties i j) + (throw 'not-equal nil))) + actual expected) + t))) + +(defun eshell-arguments-equal--equal-explainer (actual expected) + "Explain the result of `eshell-arguments-equal'." + `(nonequal-result + (actual ,actual) + (expected ,expected))) + +(put 'eshell-arguments-equal 'ert-explainer + #'eshell-arguments-equal--equal-explainer) + ;;; Tests: (ert-deftest em-cmpl-test/parse-arguments/pipeline () @@ -51,47 +71,57 @@ em-cmpl-test/parse-arguments/pipeline (with-temp-eshell (let ((eshell-test-value '("foo" "bar"))) (insert "echo hi | cat") - (should (equal (car (eshell-complete-parse-arguments)) - '("cat")))))) + (should (eshell-arguments-equal + (car (eshell-complete-parse-arguments)) + '("cat")))))) (ert-deftest em-cmpl-test/parse-arguments/multiple-dots () "Test parsing arguments with multiple dots like \".../\"." (with-temp-eshell (insert "echo .../file.txt") - (should (equal (car (eshell-complete-parse-arguments)) - '("echo" "../../file.txt"))))) + (should (eshell-arguments-equal + (car (eshell-complete-parse-arguments)) + `("echo" ,(propertize "../../file.txt" + 'pcomplete-arg-value + ".../file.txt")))))) (ert-deftest em-cmpl-test/parse-arguments/variable/numeric () "Test parsing arguments with a numeric variable interpolation." (with-temp-eshell (let ((eshell-test-value 42)) (insert "echo $eshell-test-value") - (should (equal (car (eshell-complete-parse-arguments)) - '("echo" "42")))))) + (should (eshell-arguments-equal + (car (eshell-complete-parse-arguments)) + `("echo" ,(propertize "42" 'pcomplete-arg-value 42))))))) (ert-deftest em-cmpl-test/parse-arguments/variable/nil () "Test parsing arguments with a nil variable interpolation." (with-temp-eshell (let ((eshell-test-value nil)) (insert "echo $eshell-test-value") - (should (equal (car (eshell-complete-parse-arguments)) - '("echo" "")))))) + (should (eshell-arguments-equal + (car (eshell-complete-parse-arguments)) + `("echo" ,(propertize "" 'pcomplete-arg-value nil))))))) (ert-deftest em-cmpl-test/parse-arguments/variable/list () "Test parsing arguments with a list variable interpolation." (with-temp-eshell (let ((eshell-test-value '("foo" "bar"))) (insert "echo $eshell-test-value") - (should (equal (car (eshell-complete-parse-arguments)) - '("echo" ("foo" "bar"))))))) + (should (eshell-arguments-equal + (car (eshell-complete-parse-arguments)) + `("echo" ,(propertize "(\"foo\" \"bar\")" + 'pcomplete-arg-value + eshell-test-value))))))) (ert-deftest em-cmpl-test/parse-arguments/variable/splice () "Test parsing arguments with a spliced variable interpolation." (with-temp-eshell (let ((eshell-test-value '("foo" "bar"))) (insert "echo $@eshell-test-value") - (should (equal (car (eshell-complete-parse-arguments)) - '("echo" "foo" "bar")))))) + (should (eshell-arguments-equal + (car (eshell-complete-parse-arguments)) + '("echo" "foo" "bar")))))) (ert-deftest em-cmpl-test/file-completion/unique () "Test completion of file names when there's a unique result." commit cc5a2ed457eb34543bb7aaf6b39663af2599805d Author: Jim Porter Date: Sun Jan 15 16:44:23 2023 -0800 Properly parse Eshell variable splices for interactive completion Previously, the code simply ignored the splice operator, which usually worked, but isn't actually correct. * lisp/eshell/em-cmpl.el (eshell-complete-eval-argument-form): New function. (eshell-complete-parse-arguments): Properly parse variable splices. * test/lisp/eshell/em-cmpl-tests.el (em-cmpl-test/parse-arguments/variable/splice): New test. diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 4206ad048fa..d1c7e81090a 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -306,6 +306,12 @@ eshell--pcomplete-insert-tab (insert-and-inherit "\t") (throw 'pcompleted t))) +(defun eshell-complete--eval-argument-form (arg) + "Evaluate a single Eshell argument form ARG for the purposes of completion." + (let ((result (eshell-do-eval `(eshell-commands ,arg) t))) + (cl-assert (eq (car result) 'quote)) + (cadr result))) + (defun eshell-complete-parse-arguments () "Parse the command line arguments for `pcomplete-argument'." (when (and eshell-no-completion-during-jobs @@ -344,11 +350,6 @@ eshell-complete-parse-arguments (cl-assert (= (length args) (length posns))) (let ((a args) (i 0) new-start) (while a - ;; Remove any top-level `eshell-splice-args' sigils. These - ;; are meant to be rewritten and can't actually be called. - (when (and (consp (car a)) - (eq (caar a) 'eshell-splice-args)) - (setcar a (cadar a))) ;; If there's an unreplaced `eshell-operator' sigil, consider ;; the token after it the new start of our arguments. (when (and (consp (car a)) @@ -364,23 +365,38 @@ eshell-complete-parse-arguments (not (eq (char-before (1- end)) ?\\))) (nconc args (list "")) (nconc posns (list (point)))) + ;; Evaluate and expand Eshell forms. + (let (evaled-args evaled-posns) + (cl-mapc + (lambda (arg posn) + (pcase arg + (`(eshell-splice-args ,val) + (dolist (subarg (eshell-complete--eval-argument-form val)) + (push subarg evaled-args) + (push posn evaled-posns))) + ((pred listp) + (push (eshell-complete--eval-argument-form arg) evaled-args) + (push posn evaled-posns)) + (_ + (push arg evaled-args) + (push posn evaled-posns)))) + args posns) + (setq args (nreverse evaled-args) + posns (nreverse evaled-posns))) + ;; Convert arguments to forms that Pcomplete can understand. (cons (mapcar (lambda (arg) - (let ((val - (if (listp arg) - (let ((result - (eshell-do-eval - (list 'eshell-commands arg) t))) - (cl-assert (eq (car result) 'quote)) - (cadr result)) - arg))) - (cond ((numberp val) - (setq val (number-to-string val))) - ;; expand .../ etc that only eshell understands to - ;; standard ../../ - ((and (stringp val)) (string-match "\\.\\.\\.+/" val) - (setq val (eshell-expand-multiple-dots val)))) - (or val ""))) + (cond + ((numberp arg) + (number-to-string arg)) + ;; Expand ".../" etc that only Eshell understands to the + ;; standard "../../". + ((and (stringp arg) (string-match "\\.\\.\\.+/" arg)) + (eshell-expand-multiple-dots arg)) + ((null arg) + "") + (t + arg))) args) posns))) diff --git a/test/lisp/eshell/em-cmpl-tests.el b/test/lisp/eshell/em-cmpl-tests.el index 32b0781dd75..3f8f890f6e5 100644 --- a/test/lisp/eshell/em-cmpl-tests.el +++ b/test/lisp/eshell/em-cmpl-tests.el @@ -85,6 +85,14 @@ em-cmpl-test/parse-arguments/variable/list (should (equal (car (eshell-complete-parse-arguments)) '("echo" ("foo" "bar"))))))) +(ert-deftest em-cmpl-test/parse-arguments/variable/splice () + "Test parsing arguments with a spliced variable interpolation." + (with-temp-eshell + (let ((eshell-test-value '("foo" "bar"))) + (insert "echo $@eshell-test-value") + (should (equal (car (eshell-complete-parse-arguments)) + '("echo" "foo" "bar")))))) + (ert-deftest em-cmpl-test/file-completion/unique () "Test completion of file names when there's a unique result." (with-temp-eshell commit 79154f625cc4f1db3cd2b9df1a3d88def27e0d56 Author: Jim Porter Date: Sun Jan 15 16:44:17 2023 -0800 Add regression tests for Eshell completions * lisp/eshell/esh-cmd.el (eshell-complete-lisp-symbols): Fix docstring. * test/lisp/eshell/em-cmpl-tests.el: New file. diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 99c3d7f627d..b5f1d60ff18 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -343,7 +343,7 @@ eshell-cmd-initialize #'eshell-complete-lisp-symbols nil t))) (defun eshell-complete-lisp-symbols () - "If there is a user reference, complete it." + "If there is a Lisp symbol, complete it." (let ((arg (pcomplete-actual-arg))) (when (string-match (concat "\\`" eshell-lisp-regexp) arg) (setq pcomplete-stub (substring arg (match-end 0)) diff --git a/test/lisp/eshell/em-cmpl-tests.el b/test/lisp/eshell/em-cmpl-tests.el new file mode 100644 index 00000000000..32b0781dd75 --- /dev/null +++ b/test/lisp/eshell/em-cmpl-tests.el @@ -0,0 +1,170 @@ +;;; em-cmpl-tests.el --- em-cmpl test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Tests for Eshell's interactive completion. + +;;; Code: + +(require 'ert) +(require 'eshell) +(require 'em-cmpl) +(require 'em-dirs) +(require 'em-hist) +(require 'em-tramp) +(require 'em-unix) + +(require 'eshell-tests-helpers + (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory)))) + +(defvar eshell-test-value nil) + +(defun eshell-insert-and-complete (input) + "Insert INPUT and invoke completion, returning the result." + (insert input) + (completion-at-point) + (eshell-get-old-input)) + +;;; Tests: + +(ert-deftest em-cmpl-test/parse-arguments/pipeline () + "Test that parsing arguments for completion discards earlier commands." + (with-temp-eshell + (let ((eshell-test-value '("foo" "bar"))) + (insert "echo hi | cat") + (should (equal (car (eshell-complete-parse-arguments)) + '("cat")))))) + +(ert-deftest em-cmpl-test/parse-arguments/multiple-dots () + "Test parsing arguments with multiple dots like \".../\"." + (with-temp-eshell + (insert "echo .../file.txt") + (should (equal (car (eshell-complete-parse-arguments)) + '("echo" "../../file.txt"))))) + +(ert-deftest em-cmpl-test/parse-arguments/variable/numeric () + "Test parsing arguments with a numeric variable interpolation." + (with-temp-eshell + (let ((eshell-test-value 42)) + (insert "echo $eshell-test-value") + (should (equal (car (eshell-complete-parse-arguments)) + '("echo" "42")))))) + +(ert-deftest em-cmpl-test/parse-arguments/variable/nil () + "Test parsing arguments with a nil variable interpolation." + (with-temp-eshell + (let ((eshell-test-value nil)) + (insert "echo $eshell-test-value") + (should (equal (car (eshell-complete-parse-arguments)) + '("echo" "")))))) + +(ert-deftest em-cmpl-test/parse-arguments/variable/list () + "Test parsing arguments with a list variable interpolation." + (with-temp-eshell + (let ((eshell-test-value '("foo" "bar"))) + (insert "echo $eshell-test-value") + (should (equal (car (eshell-complete-parse-arguments)) + '("echo" ("foo" "bar"))))))) + +(ert-deftest em-cmpl-test/file-completion/unique () + "Test completion of file names when there's a unique result." + (with-temp-eshell + (ert-with-temp-directory default-directory + (write-region nil nil (expand-file-name "file.txt")) + (should (equal (eshell-insert-and-complete "echo fi") + "echo file.txt "))))) + +(ert-deftest em-cmpl-test/file-completion/non-unique () + "Test completion of file names when there are multiple results." + (with-temp-eshell + (ert-with-temp-directory default-directory + (write-region nil nil (expand-file-name "file.txt")) + (write-region nil nil (expand-file-name "file.el")) + (should (equal (eshell-insert-and-complete "echo fi") + "echo file.")) + ;; Now try completing again. + (let ((minibuffer-message-timeout 0) + (inhibit-message t)) + (completion-at-point)) + ;; FIXME: We can't use `current-message' here. + (with-current-buffer (messages-buffer) + (save-excursion + (goto-char (point-max)) + (forward-line -1) + (should (looking-at "Complete, but not unique"))))))) + +(ert-deftest em-cmpl-test/file-completion/after-list () + "Test completion of file names after previous list arguments. +See bug#59956." + (with-temp-eshell + (ert-with-temp-directory default-directory + (write-region nil nil (expand-file-name "file.txt")) + (should (equal (eshell-insert-and-complete "echo (list 1 2) fi") + "echo (list 1 2) file.txt "))))) + +(ert-deftest em-cmpl-test/lisp-symbol-completion () + "Test completion of Lisp forms like \"#'symbol\" and \"`symbol\". +See ." + (with-temp-eshell + (should (equal (eshell-insert-and-complete "echo #'system-nam") + "echo #'system-name "))) + (with-temp-eshell + (should (equal (eshell-insert-and-complete "echo `system-nam") + "echo `system-name ")))) + +(ert-deftest em-cmpl-test/lisp-function-completion () + "Test completion of Lisp forms like \"(func)\". +See ." + (with-temp-eshell + (should (equal (eshell-insert-and-complete "echo (eshell/ech") + "echo (eshell/echo")))) + +(ert-deftest em-cmpl-test/variable-ref-completion () + "Test completion of variable references like \"$var\". +See ." + (with-temp-eshell + (should (equal (eshell-insert-and-complete "echo $system-nam") + "echo $system-name ")))) + +(ert-deftest em-cmpl-test/variable-assign-completion () + "Test completion of variable assignments like \"var=value\". +See ." + (with-temp-eshell + (ert-with-temp-directory default-directory + (write-region nil nil (expand-file-name "file.txt")) + (should (equal (eshell-insert-and-complete "VAR=f") + "VAR=file.txt "))))) + +(ert-deftest em-cmpl-test/user-ref-completion () + "Test completeion of user references like \"~user\". +See ." + (unwind-protect + (with-temp-eshell + (cl-letf (((symbol-function 'eshell-read-user-names) + (lambda () (setq eshell-user-names '((1234 . "user")))))) + ;; FIXME: Should this really add a space at the end? + (should (equal (eshell-insert-and-complete "echo ~us") + "echo ~user/ ")))) + ;; Clear the cached user names we set above. + (setq eshell-user-names nil))) + +;;; em-cmpl-tests.el ends here commit 1684e254a3b95b474753275fa9bfc2567a83b2fa Author: Jonas Bernoulli Date: Mon Jan 30 22:39:38 2023 +0100 Update to Transient v0.3.7-196-gb91f509 diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index 2cd4e985dd2..8ac5df9904c 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -31,7 +31,7 @@ @finalout @titlepage @title Transient User and Developer Manual -@subtitle for version 0.3.7 +@subtitle for version 0.3.7.50 @author Jonas Bernoulli @page @vskip 0pt plus 1filll @@ -64,8 +64,17 @@ Top Calling a suffix command usually causes the transient to be exited but suffix commands can also be configured to not exit the transient. +@quotation +The second part of this manual, which describes how to modify existing +transients and create new transients from scratch, can be hard to +digest if you are just getting started. A useful resource to get over +that hurdle is Psionic K's interactive tutorial, available at +@uref{https://github.com/positron-solutions/transient-showcase}. + +@end quotation + @noindent -This manual is for Transient version 0.3.7. +This manual is for Transient version 0.3.7.50. @insertcopying @end ifnottex @@ -447,10 +456,10 @@ Saving Values Save the value of the active transient persistently across Emacs sessions. -@item @kbd{C-x C-k} (@code{transient-save}) +@item @kbd{C-x C-k} (@code{transient-reset}) @kindex C-x C-k -@findex transient-save -Clear the set and saved value of the active transient. +@findex transient-reset +Clear the set and saved values of the active transient. @end table @defopt transient-values-file @@ -893,7 +902,16 @@ Modifying Existing Transients To an extent, transients can be customized interactively, see @ref{Enabling and Disabling Suffixes}. This section explains how existing -transients can be further modified non-interactively. +transients can be further modified non-interactively. Let's begin +with an example: + +@lisp +(transient-append-suffix 'magit-patch-apply "-3" + '("-R" "Apply in reverse" "--reverse")) +@end lisp + +This inserts a new infix argument to toggle the @code{--reverse} argument +after the infix argument that toggles @code{-3} in @code{magit-patch-apply}. The following functions share a few arguments: @@ -911,7 +929,6 @@ Modifying Existing Transients @var{SUFFIX} may also be a group in the same form as expected by @code{transient-define-prefix}. @xref{Group Specifications}. - @item @var{LOC} is a command, a key vector, a key description (a string as returned by @code{key-description}), or a list specifying coordinates (the @@ -1044,6 +1061,18 @@ Defining Transients the branch whose variables are being configured. @end defmac +It is possible to define one or more groups independently of a prefix +definition, which is useful when those groups are to be used by more +than just one prefix command. + +@defmac transient-define-groups name group... +This macro defines one or more groups of infix and suffix commands +and stores them in a property of the symbol @var{NAME}. @var{GROUP} has the +same form as for @code{transient-define-prefix}. Subsequently @var{NAME} can +be used in a @var{GROUP} of @code{transient-define-prefix}, as described in the +next section. +@end defmac + @node Binding Suffix and Infix Commands @section Binding Suffix and Infix Commands @@ -1139,11 +1168,17 @@ Group Specifications @item The value of @code{:setup-children}, if non-@code{nil}, is a function that takes -two arguments the group object itself and a list of children. -The children are given as a (potentially empty) list consisting -of either group or suffix specifications. It can make arbitrary -changes to the children including constructing new children from -scratch. Also see @code{transient-setup-children}. +one argument, a potentially list of children, and must return a list +of children or an empty list. This can either be used to somehow +transform the group's children that were defined the normal way, or +to dynamically create the children from scratch. + +The returned children must have the same form as stored in the +prefix's @code{transient--layout} property, but it is often more convenient +to use the same form as understood by @code{transient-define-prefix}, +described below. If you use the latter approach, you can use the +@code{transient-parse-child} and @code{transient-parse-children} functions to +transform them from the convenient to the expected form. @item The boolean @code{:pad-keys} argument controls whether keys of all suffixes @@ -1151,23 +1186,35 @@ Group Specifications descriptions. @end itemize -The @var{ELEMENT}s are either all subgroups (vectors), or all suffixes -(lists) and strings. (At least currently no group type exists that -would allow mixing subgroups with commands at the same level, though -in principle there is nothing that prevents that.) +The @var{ELEMENT}s are either all subgroups, or all suffixes and strings. +(At least currently no group type exists that would allow mixing +subgroups with commands at the same level, though in principle there +is nothing that prevents that.) If the @var{ELEMENT}s are not subgroups, then they can be a mixture of lists -that specify commands and strings. Strings are inserted verbatim. -The empty string can be used to insert gaps between suffixes, which is -particularly useful if the suffixes are outlined as a table. - -Variables are supported inside group specifications. For example in -place of a direct subgroup specification, a variable can be used whose -value is a vector that qualifies as a group specification. Likewise, -a variable can be used where a suffix specification is expected. -Lists of group or suffix specifications are also supported. Indirect -specifications are resolved when the transient prefix is being -defined. +that specify commands and strings. Strings are inserted verbatim into +the buffer. The empty string can be used to insert gaps between +suffixes, which is particularly useful if the suffixes are outlined as +a table. + +Inside group specifications, including inside contained suffix +specifications, nothing has to be quoted and quoting anyway is +invalid. + +How symbols are treated, depends on context. Inside suffix +specifications they often name functions. However if they appear in +a place where a group is expected, then they are treated as indirect +group specifications. Such a symbol must have an associated group +specification, created using @code{transient-define-groups}. + +Likewise a symbol can appear in a place where a suffix specification +is expected. The value of the @code{transient--layout} property of that +symbol must be a single suffix specification or a list of such +specifications. Currently no macro exist that would create such a +symbol, and this feature should usually not be used. + +The value following a keyword, can be explicitly unquoted using @code{,}. +This feature is experimental and should be avoided as well. The form of suffix specifications is documented in the next node. @@ -1232,7 +1279,7 @@ Suffix Specifications with it (as would be the case if @code{transient-define-suffix} or @code{transient-define-infix} were used to define it). -Anonymous, dynamically defined suffix commands are also support. +Anonymous, dynamically defined suffix commands are also supported. See information about the @code{:setup-children} function in @ref{Group Specifications}. As mentioned above, the object that is associated with a command can @@ -1515,7 +1562,18 @@ Transient State @anchor{Pre-commands for Suffixes} @subheading Pre-commands for Suffixes -The default for suffixes is @code{transient--do-exit}. +By default, invoking a suffix causes the transient to be exited. + +If you want a different default behavior for a certain transient +prefix command, then set its @code{:transient-suffix} slot. The value can be +a boolean, answering the question "does the transient stay active, +when a suffix command is invoked?" @code{t} means that the transient stays +active, while @code{nil} means that invoking a suffix exits the transient. +In either case, the exact behavior depends on whether the suffix is +itself a prefix (i.e., a sub-prefix), an infix or a regular suffix. + +The behavior for an individual suffix command can be changed by +setting its @code{transient} slot to one of the following pre-commands. @defun transient--do-exit Call the command after exporting variables and exit the transient. @@ -1566,21 +1624,32 @@ Transient State @anchor{Pre-commands for Non-Suffixes} @subheading Pre-commands for Non-Suffixes -The default for non-suffixes, i.e., commands that are bound in other -keymaps beside the transient keymap, is @code{transient--do-warn}. Silently -ignoring the user-error is also an option, though probably not a good -one. +By default, non-suffixes (commands that are bound in other keymaps +beside the transient keymap) cannot be invoked. Trying to invoke +such a command results in a warning and the transient stays active. -If you want to let the user invoke non-suffix commands, then use -@code{transient--do-stay} as the value of the prefix's @code{transient-non-suffix} -slot. +If you want a different behavior, then set the @code{:transient-non-suffix} +slot of the transient prefix command. The value can be a boolean, +answering the question, "is it allowed to invoke non-suffix commands?" + +If the value is @code{t} or @code{transient--do-stay}, then non-suffixes can be +invoked, when it is @code{nil} or @code{transient--do-warn} (the default) then they +cannot be invoked. + +The only other recommended value is @code{transient--do-leave}. If that is +used, then non-suffixes can be invoked, but if one is invoked, then +that exits the transient. @defun transient--do-warn Call @code{transient-undefined} and stay transient. @end defun -@defun transient--do-noop -Call @code{transient-noop} and stay transient. +@defun transient--do-stay +Call the command without exporting variables and stay transient. +@end defun + +@defun transient--do-leave +Call the command without exporting variables and exit the transient. @end defun @anchor{Special Pre-Commands} @@ -1810,7 +1879,7 @@ Suffix Classes @item Classes used for infix commands that represent variables should -derived from the abstract @code{transient-variables} class. +derived from the abstract @code{transient-variable} class. @end itemize Magit defines additional classes, which can serve as examples for the @@ -2045,7 +2114,7 @@ Suffix Slots @item @code{show-help} A function used to display help for the suffix. If -unspecified, the prefix controls how hlep is displayed for its +unspecified, the prefix controls how help is displayed for its suffixes. @end itemize diff --git a/lisp/transient.el b/lisp/transient.el index eb3c4ab6bca..cd8640a7d74 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/magit/transient ;; Keywords: extensions -;; Package-Version: 0.3.7 +;; Package-Version: 0.3.7.50 ;; Package-Requires: ((emacs "26.1")) ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -798,8 +798,8 @@ transient-row (defclass transient-columns (transient-group) () "Group class that displays elements organized in columns. Direct elements have to be groups whose elements have to be -commands or string. Each subgroup represents a column. This -class takes care of inserting the subgroups' elements.") +commands or strings. Each subgroup represents a column. +This class takes care of inserting the subgroups' elements.") (defclass transient-subgroups (transient-group) () "Group class that wraps other groups. @@ -860,7 +860,7 @@ transient-define-prefix (indent defun) (doc-string 3)) (pcase-let ((`(,class ,slots ,suffixes ,docstr ,body) - (transient--expand-define-args args))) + (transient--expand-define-args args arglist))) `(progn (defalias ',name ,(if body @@ -913,7 +913,7 @@ transient-define-suffix (indent defun) (doc-string 3)) (pcase-let ((`(,class ,slots ,_ ,docstr ,body) - (transient--expand-define-args args))) + (transient--expand-define-args args arglist))) `(progn (defalias ',name (lambda ,arglist ,@body)) (put ',name 'interactive-only t) @@ -921,7 +921,7 @@ transient-define-suffix (put ',name 'transient--suffix (,(or class 'transient-suffix) :command ',name ,@slots))))) -(defmacro transient-define-infix (name _arglist &rest args) +(defmacro transient-define-infix (name arglist &rest args) "Define NAME as a transient infix command. ARGLIST is always ignored and reserved for future use. @@ -962,7 +962,7 @@ transient-define-infix (indent defun) (doc-string 3)) (pcase-let ((`(,class ,slots ,_ ,docstr ,_) - (transient--expand-define-args args))) + (transient--expand-define-args args arglist))) `(progn (defalias ',name ,(transient--default-infix-command)) (put ',name 'interactive-only t) @@ -980,7 +980,9 @@ 'transient-define-argument \(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)") -(defun transient--expand-define-args (args) +(defun transient--expand-define-args (args &optional arglist) + (unless (listp arglist) + (error "Mandatory ARGLIST is missing")) (let (class keys suffixes docstr) (when (stringp (car args)) (setq docstr (pop args))) @@ -1150,7 +1152,7 @@ transient-parse-suffix PREFIX is a prefix command, a symbol. SUFFIX is a suffix command or a group specification (of the same forms as expected by `transient-define-prefix'). -Intended for use in PREFIX's `:setup-children' function." +Intended for use in a group's `:setup-children' function." (eval (car (transient--parse-child prefix suffix)))) (defun transient-parse-suffixes (prefix suffixes) @@ -1158,7 +1160,7 @@ transient-parse-suffixes PREFIX is a prefix command, a symbol. SUFFIXES is a list of suffix command or a group specification (of the same forms as expected by `transient-define-prefix'). -Intended for use in PREFIX's `:setup-children' function." +Intended for use in a group's `:setup-children' function." (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes)) ;;; Edit @@ -1469,14 +1471,24 @@ transient-suffix-object (cl-check-type command command)) (if (or transient--prefix transient-current-prefix) - (cl-find-if (lambda (obj) - (eq (transient--suffix-command obj) + (let ((suffixes + (cl-remove-if-not + (lambda (obj) + (eq (transient--suffix-command obj) + (or command ;; When `this-command' is `transient-set-level', ;; its reader needs to know what command is being ;; configured. - (or command this-original-command))) - (or transient--suffixes - transient-current-suffixes)) + this-original-command))) + (or transient--suffixes + transient-current-suffixes)))) + (or (and (cdr suffixes) + (cl-find-if + (lambda (obj) + (equal (listify-key-sequence (transient--kbd (oref obj key))) + (listify-key-sequence (this-command-keys)))) + suffixes)) + (car suffixes))) (when-let* ((obj (get (or command this-command) 'transient--suffix)) (obj (clone obj))) ;; Cannot use and-let* because of debbugs#31840. @@ -2203,7 +2215,7 @@ transient--delay-post-command (unless abort-only (setq post-command (lambda () "@transient--delay-post-command" - (let ((act (and (not (eq (this-command-keys-vector) [])) + (let ((act (and (not (equal (this-command-keys-vector) [])) (or (eq this-command command) ;; `execute-extended-command' was ;; used to call another command @@ -2236,7 +2248,7 @@ transient--post-command (transient--debug 'post-command) (transient--with-emergency-exit (cond - ((and (eq (this-command-keys-vector) []) + ((and (equal (this-command-keys-vector) []) (= (minibuffer-depth) (1+ transient--minibuffer-depth))) (transient--suspend-override) @@ -2407,6 +2419,10 @@ transient--do-exit (transient--stack-zap) transient--exit) +(defun transient--do-leave () + "Call the command without exporting variables and exit the transient." + transient--stay) + (defun transient--do-push-button () "Call the command represented by the activated button. Use that command's pre-command to determine transient behavior." @@ -3376,7 +3392,7 @@ transient--insert-group (insert ?\n) (insert (propertize " " 'display `(space :align-to (,(nth (1+ c) cc))))))) - (insert (make-string (- (nth c cc) (current-column)) ?\s)) + (insert (make-string (max 1 (- (nth c cc) (current-column))) ?\s)) (when-let ((cell (nth r (nth c columns)))) (insert cell)) (when (= c (1- cs)) @@ -4119,7 +4135,10 @@ transient-format-value 'face 'transient-value)) (cl-defmethod transient-prompt ((obj transient-lisp-variable)) - (format "Set %s: " (oref obj variable))) + (if (and (slot-boundp obj 'prompt) + (oref obj prompt)) + (cl-call-next-method obj) + (format "Set %s: " (oref obj variable)))) (defun transient-lisp-variable--reader (prompt initial-input _history) (read--expression prompt initial-input)) commit 327941b211299013868469e65050d92ea513f067 Author: Alan Mackenzie Date: Mon Jan 30 20:02:36 2023 +0000 CC Mode: Fix a coding bug in c-make-keywords-re. This should fix bug #61135 * lisp/progmodes/cc-defs.el (c-make-keywords-re): Generate "\>" components in result regexp when argument ADORN is `appendable'. This fully fixes a bug which was half-fixed on 2019-01-22. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index bdbc03e7c94..aa6f33e9cab 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1994,7 +1994,7 @@ c-make-keywords-re ;; doesn't occur in any word in LIST. Append it to all ;; the alternatives where we want to add \>. Run through ;; `regexp-opt' and then replace it with \>. - (let ((unique "") pos) + (let ((unique "") (list1 (copy-tree list)) pos) (while (let (found) (setq unique (concat unique "@") pos list) @@ -2005,13 +2005,12 @@ c-make-keywords-re t)) (setq pos (cdr pos))) found)) - (setq pos (copy-tree list) - ) + (setq pos list1) (while pos (if (string-match "\\w\\'" (car pos)) (setcar pos (concat (car pos) unique))) (setq pos (cdr pos))) - (setq re (regexp-opt list)) + (setq re (regexp-opt list1)) (setq pos 0) (while (string-match unique re pos) (setq pos (+ (match-beginning 0) 2) commit e19b91f946a99aa812a21bbeff654569bad945d2 Author: Eli Zaretskii Date: Mon Jan 30 20:25:59 2023 +0200 Revert "Fix incremental build failures with tree-sitter" This reverts commit 176830fe2bb1c80ee128e515f6223cddc8b0a2ca. That commit isn't needed, since the problem was fixed in another way, in the defcustom's :set function. diff --git a/lisp/treesit.el b/lisp/treesit.el index 059707b0123..d11e57fef8a 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -86,7 +86,6 @@ (declare-function treesit-search-subtree "treesit.c") (declare-function treesit-search-forward "treesit.c") -(declare-function treesit-subtree-stat "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-subtree-stat "treesit.c") @@ -267,14 +266,12 @@ treesit-buffer-root-node Use the first parser in the parser list if LANGUAGE is omitted. If LANGUAGE is non-nil, use the first parser for LANGUAGE in the parser list, or create one if none exists." - ;; Otherwise the incremental build is broken without tree-sitter. - (when (treesit-available-p) - (if-let ((parser - (if language - (treesit-parser-create language) - (or (car (treesit-parser-list)) - (signal 'treesit-no-parser (list (current-buffer))))))) - (treesit-parser-root-node parser)))) + (if-let ((parser + (if language + (treesit-parser-create language) + (or (car (treesit-parser-list)) + (signal 'treesit-no-parser (list (current-buffer))))))) + (treesit-parser-root-node parser))) (defun treesit-filter-child (node pred &optional named) "Return children of NODE that satisfies predicate PRED. commit cdc8f7c28ebfd8423854aabeeed9d245a2c15b91 Author: Eric Abrahamsen Date: Mon Jan 30 09:55:40 2023 -0800 Gnus nnimap date search string must use C locale * lisp/gnus/gnus-search.el (gnus-search-imap-handle-date): The %b needs to be the English month name for IMAP search. diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 27c71fa6c6a..22c84bc39cf 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1330,9 +1330,10 @@ gnus-search-imap-handle-date (1- nyear) nyear)) (setq dmonth 1)))) - (format-time-string - "%e-%b-%Y" - (encode-time 0 0 0 dday dmonth dyear)))) + (with-locale-environment "C" + (format-time-string + "%e-%b-%Y" + (encode-time 0 0 0 dday dmonth dyear))))) (cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap) (str string)) commit 2f3683cd4dc1e2358ae5f8c11f30a773f4540df7 Author: Juri Linkov Date: Mon Jan 30 19:39:33 2023 +0200 * lisp/isearch.el (isearch-emoji-by-name): Disable derived emoji (bug#60740). Let-bind emoji--derived to nil to avoid the subsequent selection of derived emoji that fails in transient.el. diff --git a/lisp/isearch.el b/lisp/isearch.el index bb46c89ae20..22e27764127 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2774,6 +2774,7 @@ isearch-char-by-name (mapconcat 'isearch-text-char-description string "")))))))) +(defvar emoji--derived) (defun isearch-emoji-by-name (&optional count) "Read an Emoji name and add it to the search string COUNT times. COUNT (interactively, the prefix argument) defaults to 1. @@ -2782,7 +2783,13 @@ isearch-emoji-by-name (interactive "p") (with-isearch-suspended (let ((emoji (with-temp-buffer - (emoji-search) + ;; Derived emoji not supported yet (bug#60740). + ;; So first load `emoji--labels', then `emoji--init' + ;; will not fill `emoji--derived' that is set + ;; to an empty hash table below. + (ignore-errors (require 'emoji-labels)) + (let ((emoji--derived (make-hash-table :test #'equal))) + (emoji-search)) (if (and (integerp count) (> count 1)) (apply 'concat (make-list count (buffer-string))) (buffer-string))))) commit c53952164fe54fee41343fd4008f610f7a284d26 Merge: 48ed4228a75 f67a9a12b7b Author: Po Lu Date: Mon Jan 30 21:47:39 2023 +0800 Merge from origin/emacs-29 f67a9a12b7b Fix interactive use of `keymap-local-set' and `keymap-glo... dda4baa58b7 ; Fix build and startup without tree-sitter commit 48ed4228a75907ae1bb7a2d4314ffb3277c75e3a Merge: 176830fe2bb 99e40959f40 Author: Po Lu Date: Mon Jan 30 21:47:39 2023 +0800 ; Merge from origin/emacs-29 The following commit was skipped: 99e40959f40 Fix password prompt in Tramp (do not merge) commit 86b03046c0097aa7bd342efe9b9fde711ed81755 Merge: e866490a077 f67a9a12b7b Author: Eli Zaretskii Date: Mon Jan 30 15:45:54 2023 +0200 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/emacs into emacs-29 commit e866490a077c4c8a64550a8f85c8b9688112ed60 Author: Eli Zaretskii Date: Mon Jan 30 15:42:06 2023 +0200 Fix keymap inheritance in descendants of 'c-ts-base-mode' * lisp/progmodes/c-ts-mode.el (c-ts-base-mode-map): Rename from 'c-ts-mode-map'. (c-ts-base-mode): Adjust accordingly. (Bug#60983) diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 612c41bf073..195c23d28c9 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -697,8 +697,8 @@ c-ts-mode-indent-defun ;;; Modes -(defvar-keymap c-ts-mode-map - :doc "Keymap for the C language with tree-sitter" +(defvar-keymap c-ts-base-mode-map + :doc "Keymap for C and C-like languages with tree-sitter" :parent prog-mode-map "C-c C-q" #'c-ts-mode-indent-defun "C-c ." #'c-ts-mode-set-style) @@ -707,7 +707,7 @@ c-ts-mode-map (define-derived-mode c-ts-base-mode prog-mode "C" "Major mode for editing C, powered by tree-sitter. -\\{c-ts-mode-map}" +\\{c-ts-base-mode-map}" :syntax-table c-ts-mode--syntax-table ;; Navigation. commit 176830fe2bb1c80ee128e515f6223cddc8b0a2ca Author: Po Lu Date: Mon Jan 30 21:33:27 2023 +0800 Fix incremental build failures with tree-sitter * lisp/treesit.el (treesit-subtree-stat): Declare missing function. (treesit-buffer-root-node): Return nil if tree-sitter not present. diff --git a/lisp/treesit.el b/lisp/treesit.el index c9f2e339dc2..202a383ed7d 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -86,6 +86,7 @@ (declare-function treesit-search-subtree "treesit.c") (declare-function treesit-search-forward "treesit.c") +(declare-function treesit-subtree-stat "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-available-p "treesit.c") @@ -265,12 +266,14 @@ treesit-buffer-root-node Use the first parser in the parser list if LANGUAGE is omitted. If LANGUAGE is non-nil, use the first parser for LANGUAGE in the parser list, or create one if none exists." - (if-let ((parser - (if language - (treesit-parser-create language) - (or (car (treesit-parser-list)) - (signal 'treesit-no-parser (list (current-buffer))))))) - (treesit-parser-root-node parser))) + ;; Otherwise the incremental build is broken without tree-sitter. + (when (treesit-available-p) + (if-let ((parser + (if language + (treesit-parser-create language) + (or (car (treesit-parser-list)) + (signal 'treesit-no-parser (list (current-buffer))))))) + (treesit-parser-root-node parser)))) (defun treesit-filter-child (node pred &optional named) "Return children of NODE that satisfies predicate PRED. commit f67a9a12b7b0cdd6030cb080a6d6838255789a08 Author: Robert Pluim Date: Mon Jan 30 10:51:30 2023 +0100 Fix interactive use of `keymap-local-set' and `keymap-global-set' * lisp/keymap.el (keymap-global-set, keymap-local-set): Convert the read key sequence to a string when called interactively. Based on a patch from Stephen Berman . (Bug#61149) diff --git a/lisp/keymap.el b/lisp/keymap.el index 791221f2459..caabedd5aec 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -76,12 +76,9 @@ keymap-global-set that local binding will continue to shadow any global binding that you make with this function." (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) - (interactive - (let* ((menu-prompting nil) - (key (read-key-sequence "Set key globally: " nil t))) - (list key - (read-command (format "Set key %s to command: " - (key-description key)))))) + (interactive "KSet key globally:\nCSet key %s globally to command: ") + (unless (stringp key) + (setq key (key-description key))) (keymap-set (current-global-map) key command)) (defun keymap-local-set (key command) @@ -94,10 +91,12 @@ keymap-local-set The binding goes in the current buffer's local map, which in most cases is shared with all other buffers in the same major mode." (declare (compiler-macro (lambda (form) (keymap--compile-check key) form))) - (interactive "KSet key locally: \nCSet key %s locally to command: ") + (interactive "KSet key locally:\nCSet key %s locally to command: ") (let ((map (current-local-map))) (unless map (use-local-map (setq map (make-sparse-keymap)))) + (unless (stringp key) + (setq key (key-description key))) (keymap-set map key command))) (defun keymap-global-unset (key &optional remove) commit dda4baa58b7e6a5c70f4c40c80463221b3c479c1 Author: Eli Zaretskii Date: Mon Jan 30 14:22:19 2023 +0200 ; Fix build and startup without tree-sitter * lisp/treesit.el (treesit--font-lock-level-setter): Don't loop over all the buffers if tree-sitter is not built-in, or else initialization of defcustom will fail. (Bug#61155) * lisp/progmodes/rust-ts-mode.el (treesit-node-parent): * lisp/progmodes/c-ts-common.el (treesit-node-parent): Declare, to * avoid byte-compilation warnings. diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 2d4a0d41c2a..c13b01aae5c 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -50,6 +50,7 @@ (declare-function treesit-node-start "treesit.c") (declare-function treesit-node-end "treesit.c") (declare-function treesit-node-type "treesit.c") +(declare-function treesit-node-parent "treesit.c") ;;; Comment indentation and filling diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 2812e39c101..e317793d211 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -37,6 +37,7 @@ (declare-function treesit-node-child-by-field-name "treesit.c") (declare-function treesit-node-start "treesit.c") (declare-function treesit-node-type "treesit.c") +(declare-function treesit-node-parent "treesit.c") (defcustom rust-ts-mode-indent-offset 4 "Number of spaces for each indentation step in `rust-ts-mode'." diff --git a/lisp/treesit.el b/lisp/treesit.el index 92833fb007c..98f446a1456 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -87,6 +87,7 @@ (declare-function treesit-search-subtree "treesit.c") (declare-function treesit-search-forward "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") +(declare-function treesit-subtree-stat "treesit.c") (declare-function treesit-available-p "treesit.c") @@ -557,20 +558,22 @@ 'treesit-font-lock-error (defun treesit--font-lock-level-setter (sym val) "Custom setter for `treesit-font-lock-level'." (set-default sym val) - (named-let loop ((res nil) - (buffers (buffer-list))) - (if (null buffers) - (mapc (lambda (b) - (with-current-buffer b - (setq-local treesit-font-lock-level val) - (treesit-font-lock-recompute-features) - (treesit-font-lock-fontify-region (point-min) (point-max)))) - res) - (let ((buffer (car buffers))) - (with-current-buffer buffer - (if (treesit-parser-list) - (loop (append res (list buffer)) (cdr buffers)) - (loop res (cdr buffers)))))))) + (and (treesit-available-p) + (named-let loop ((res nil) + (buffers (buffer-list))) + (if (null buffers) + (mapc (lambda (b) + (with-current-buffer b + (setq-local treesit-font-lock-level val) + (treesit-font-lock-recompute-features) + (treesit-font-lock-fontify-region (point-min) + (point-max)))) + res) + (let ((buffer (car buffers))) + (with-current-buffer buffer + (if (treesit-parser-list) + (loop (append res (list buffer)) (cdr buffers)) + (loop res (cdr buffers))))))))) (defcustom treesit-font-lock-level 3 "Decoration level to be used by tree-sitter fontifications. commit 3f069bd796b0024033640051b5f74ba9834985f8 Author: Michael Albinus Date: Mon Jan 30 11:55:23 2023 +0100 Fix password prompt in Tramp * lisp/net/tramp.el (tramp-password-prompt-regexp): Allow alternative trailing colons. (Bug#61168) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3871ee4dddd..21dbd40b1d2 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -642,7 +642,7 @@ tramp-password-prompt-regexp (rx bol (* nonl) (group (regexp (regexp-opt password-word-equivalents))) - (* nonl) ":" (? "\^@") (* blank)) + (* nonl) (any ":：៖") (? "\^@") (* blank)) "Regexp matching password-like prompts. The regexp should match at end of buffer. @@ -652,7 +652,7 @@ tramp-password-prompt-regexp instead of altering this variable. The `sudo' program appears to insert a `^@' character into the prompt." - :version "24.4" + :version "29.1" :type 'regexp) (defcustom tramp-wrong-passwd-regexp commit 99e40959f4036debe099f144ed2664a38e23563d Author: Michael Albinus Date: Mon Jan 30 11:43:04 2023 +0100 Fix password prompt in Tramp (do not merge) * lisp/net/tramp.el (tramp-password-prompt-regexp): Allow alternative trailing colons. (Bug#61168) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1916d50af03..eaddc36b54a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -643,7 +643,7 @@ tramp-password-prompt-regexp (tramp-compat-rx bol (* nonl) (group (regexp (regexp-opt password-word-equivalents))) - (* nonl) ":" (? "\^@") (* blank)) + (* nonl) (any ":：៖") (? "\^@") (* blank)) "Regexp matching password-like prompts. The regexp should match at end of buffer. @@ -653,7 +653,7 @@ tramp-password-prompt-regexp instead of altering this variable. The `sudo' program appears to insert a `^@' character into the prompt." - :version "24.4" + :version "29.1" :type 'regexp) (defcustom tramp-wrong-passwd-regexp commit 207a0d9408cb97b9ae78469e2487e3075ade03f8 Merge: 254c75fc293 8360e12f0ea Author: Stefan Kangas Date: Mon Jan 30 07:19:43 2023 +0100 Merge from origin/emacs-29 8360e12f0ea Update to Org 9.6.1-23-gc45a05 9058601308d ; * doc/emacs/misc.texi (Document View): Remove @footnote... 197f994384c Document tree-sitter features in the user manual b73539832d9 ; Remove treesit--font-lock-fast-mode-grace-count 64fee21d5f8 Fix dockerfile-ts-mode line continuation indentation (bug... 1970726e26a Use treesit-subtree-stat to determine treesit--font-lock-... 382e018856a Add treesit-subtree-stat a3003492ace Move c-ts-mode--statement-offset to c-ts-common.el 4b1714571c8 ; Fix byte-compile warnings in c-ts-mode.el f50cb7d7c4b ; Improve docstring of c-ts-mode--indent-style-setter 1c3ca3bb649 Fix <> syntax in rust-ts-mode 56e8607dc99 Fix spurious errors on Windows when deleting temporary *.... 2bd0b947538 Fix java class member without access modifier (bug#61115) 1de6ebf2878 Make treesit-font-lock-level a defcustom 6e50ee8bbb5 Add c-ts-mode-set-style and :set for c-ts-mode-indent-style 450db0587a9 Minor documentation improvements for outline-minor-mode (... 578e8926713 ; * doc/lispref/variables.texi (File Local Variables): Im... bc5ee2b7bf0 ; * src/comp.c: Remove Local Variables section to avoid w... 362678d90e1 python.el: Use correct regexp when enabling python-ts-mode 76bb46db9df ; * doc/emacs/frames.texi (Mouse References): Improve ind... # Conflicts: # doc/emacs/programs.texi # etc/NEWS # lisp/progmodes/c-ts-mode.el commit 8360e12f0ea3a3ccf0305adab3c7ea7e38af36c1 Author: Kyle Meyer Date: Sun Jan 29 21:42:17 2023 -0500 Update to Org 9.6.1-23-gc45a05 diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 2d194ad3413..63107e8e6a4 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -3474,13 +3474,17 @@ org-fix-agenda-info (when (setq tmp (plist-get props 'date)) (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) (let ((calendar-date-display-form - '(year "-" (string-pad month 2 ?0 'left) "-" (string-pad day 2 ?0 'left)))) + '((format "%s-%.2d-%.2d" year + (string-to-number month) + (string-to-number day))))) (setq tmp (calendar-date-string tmp))) (setq props (plist-put props 'date tmp))) (when (setq tmp (plist-get props 'day)) (when (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) (let ((calendar-date-display-form - '(year "-" (string-pad month 2 ?0 'left) "-" (string-pad day 2 ?0 'left)))) + '((format "%s-%.2d-%.2d" year + (string-to-number month) + (string-to-number day))))) (setq tmp (calendar-date-string tmp))) (setq props (plist-put props 'day tmp)) (setq props (plist-put props 'agenda-day tmp))) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 07c668a807d..8d7b0b034f8 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -46,7 +46,7 @@ org-assert-version ;; `org-git-version' check because the generated Org version strings ;; will not match. `(unless (equal (org-release) ,(org-release)) - (warn "Org version mismatch. Make sure that correct `load-path' is set early in init.el + (warn "Org version mismatch. Org loading aborted. This warning usually appears when a built-in Org version is loaded prior to the more recent Org version. diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 22f952d7a30..8372a0be4a5 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -11,7 +11,7 @@ org-release (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.6.1-16-ge37e9b")) + (let ((org-git-version "release_9.6.1-23-gc45a05")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index 153e860f9a5..1b829d837c7 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -8608,6 +8608,7 @@ org-agenda-start-on-weekday (defvar org-agenda-buffer-name) (defun org-follow-timestamp-link () "Open an agenda view for the time-stamp date/range at point." + (require 'org-agenda) ;; Avoid changing the global value. (let ((org-agenda-buffer-name org-agenda-buffer-name)) (cond diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 65f9ff18279..6f819def93a 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -6600,14 +6600,14 @@ org-export-to-buffer Optional argument POST-PROCESS is a function which should accept no argument. It is always called within the current process, from BUFFER, with point at its beginning. Export back-ends can -use it to set a major mode there, e.g, +use it to set a major mode there, e.g., (defun org-latex-export-as-latex (&optional async subtreep visible-only body-only ext-plist) (interactive) (org-export-to-buffer \\='latex \"*Org LATEX Export*\" async subtreep visible-only body-only ext-plist - #'LaTeX-mode)) + #\\='LaTeX-mode)) When expressed as an anonymous function, using `lambda', POST-PROCESS needs to be quoted. commit 9058601308db4892fbc3e599b83fe4326fef9886 Author: Eli Zaretskii Date: Sun Jan 29 19:00:59 2023 +0200 ; * doc/emacs/misc.texi (Document View): Remove @footnote (bug#61152). diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 80a1b3f55ed..acabce57223 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -470,11 +470,7 @@ Document View searching inside documents. It works by converting the document to a set of images using the @command{gs} (GhostScript) or @command{pdfdraw}/@command{mutool draw} (MuPDF) commands and other -external tools @footnote{PostScript files require GhostScript, DVI -files require @code{dvipdf} or @code{dvipdfm}, OpenDocument and -Microsoft Office documents require the @code{unoconv} tool, and EPUB, -CBZ, FB2, XPS and OXPS files require @code{mutool} to be available.}, -and displaying those images. +external tools, and then displays those converted images. @findex doc-view-toggle-display @findex doc-view-minor-mode commit 197f994384cb37ae4ae7a771815bbe565d4ae242 Author: Eli Zaretskii Date: Sun Jan 29 15:22:20 2023 +0200 Document tree-sitter features in the user manual * lisp/progmodes/c-ts-mode.el (c-ts-mode-map): Bind "C-c .", for consistency with CC mode. * lisp/treesit.el (treesit-font-lock-level): Doc fix. * doc/emacs/programs.texi (C Indent, Custom C Indent): Document the indentation features of 'c-ts-mode'. (Moving by Defuns): Document 'treesit-defun-tactic'. * doc/emacs/files.texi (Visiting): Document 'treesit-max-buffer-size'. * doc/emacs/display.texi (Traditional Font Lock) (Parser-based Font Lock): New subsections. * doc/emacs/emacs.texi (Top): Update top-level menu. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index f77ab569483..97732b65e32 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1024,17 +1024,65 @@ Font Lock use that customization buffer to customize the appearance of these faces. @xref{Face Customization}. +@cindex just-in-time (JIT) font-lock +@cindex background syntax highlighting + Fontifying very large buffers can take a long time. To avoid large +delays when a file is visited, Emacs initially fontifies only the +visible portion of a buffer. As you scroll through the buffer, each +portion that becomes visible is fontified as soon as it is displayed; +this type of Font Lock is called @dfn{Just-In-Time} (or @dfn{JIT}) +Lock. You can control how JIT Lock behaves, including telling it to +perform fontification while idle, by customizing variables in the +customization group @samp{jit-lock}. @xref{Specific Customization}. + + The information that major modes use for determining which parts of +buffer text to fontify and what faces to use can be based on several +different ways of analyzing the text: + +@itemize @bullet +@item +Search for keywords and other textual patterns based on regular +expressions (@pxref{Regexp Search,, Regular Expression Search}). + +@item +Find syntactically distinct parts of text based on built-in syntax +tables (@pxref{Syntax Tables,,, elisp, The Emacs Lisp Reference +Manual}). + +@item +Use syntax tree produced by a full-blown parser, via a special-purpose +library, such as the tree-sitter library (@pxref{Parsing Program +Source,,, elisp, The Emacs Lisp Reference Manual}), or an external +program. +@end itemize + +@menu +* Traditional Font Lock:: Font Lock based on regexps and syntax tables. +* Parser-based Font Lock:: Font Lock based on external parser. +@end menu + +@node Traditional Font Lock +@subsection Traditional Font Lock +@cindex traditional font-lock + + ``Traditional'' methods of providing font-lock information are based +on regular-expression search and on syntactic analysis using syntax +tables built into Emacs. This subsection describes the use and +customization of font-lock for major modes which use these traditional +methods. + @vindex font-lock-maximum-decoration - You can customize the variable @code{font-lock-maximum-decoration} -to alter the amount of fontification applied by Font Lock mode, for -major modes that support this feature. The value should be a number -(with 1 representing a minimal amount of fontification; some modes -support levels as high as 3); or @code{t}, meaning ``as high as -possible'' (the default). To be effective for a given file buffer, -the customization of @code{font-lock-maximum-decoration} should be -done @emph{before} the file is visited; if you already have the file -visited in a buffer when you customize this variable, kill the buffer -and visit the file again after the customization. + You can control the amount of fontification applied by Font Lock +mode by customizing the variable @code{font-lock-maximum-decoration}, +for major modes that support this feature. The value of this variable +should be a number (with 1 representing a minimal amount of +fontification; some modes support levels as high as 3); or @code{t}, +meaning ``as high as possible'' (the default). To be effective for a +given file buffer, the customization of +@code{font-lock-maximum-decoration} should be done @emph{before} the +file is visited; if you already have the file visited in a buffer when +you customize this variable, kill the buffer and visit the file again +after the customization. You can also specify different numbers for particular major modes; for example, to use level 1 for C/C++ modes, and the default level @@ -1082,16 +1130,59 @@ Font Lock @pxref{Customizing Keywords,,, elisp, The Emacs Lisp Reference Manual}. -@cindex just-in-time (JIT) font-lock -@cindex background syntax highlighting - Fontifying large buffers can take a long time. To avoid large -delays when a file is visited, Emacs initially fontifies only the -visible portion of a buffer. As you scroll through the buffer, each -portion that becomes visible is fontified as soon as it is displayed; -this type of Font Lock is called @dfn{Just-In-Time} (or @dfn{JIT}) -Lock. You can control how JIT Lock behaves, including telling it to -perform fontification while idle, by customizing variables in the -customization group @samp{jit-lock}. @xref{Specific Customization}. +@node Parser-based Font Lock +@subsection Parser-based Font Lock +@cindex font-lock via tree-sitter +@cindex parser-based font-lock + If your Emacs was built with the tree-sitter library, it can use the +results of parsing the buffer text by that library for the purposes of +fontification. This is usually faster and more accurate than the +``traditional'' methods described in the previous subsection, since +the tree-sitter library provides full-blown parsers for programming +languages and other kinds of formatted text which it supports. Major +modes which utilize the tree-sitter library are named +@code{@var{foo}-ts-mode}, with the @samp{-ts-} part indicating the use +of the library. This subsection documents the Font Lock support based +on the tree-sitter library. + +@vindex treesit-font-lock-level + You can control the amount of fontification applied by Font Lock +mode of major modes based on tree-sitter by customizing the variable +@code{treesit-font-lock-level}. Its value is a number between 1 and +4: + +@table @asis +@item Level 1 +This level usually fontifies only comments and function names in +function definitions. +@item Level 2 +This level adds fontification of keywords, strings, and data types. +@item Level 3 +This is the default level; it adds fontification of assignments, +numbers, properties, etc. +@item Level 4 +This level adds everything else that can be fontified: operators, +delimiters, brackets, other punctuation, function names in function +calls, variables, etc. +@end table + +@vindex treesit-font-lock-feature-list +@noindent +What exactly constitutes each of the syntactical categories mentioned +above depends on the major mode and the parser grammar used by +tree-sitter for the major-mode's language. However, in general the +categories follow the conventions of the programming language or the +file format supported by the major mode. The buffer-local value of +the variable @code{treesit-font-lock-feature-list} holds the +fontification features supported by a tree-sitter based major mode, +where each sub-list shows the features provided by the corresponding +fontification level. + + Once you change the value of @code{treesit-font-lock-level} via +@w{@kbd{M-x customize-variable}} (@pxref{Specific Customization}), it +takes effect immediately in all the existing buffers and for files you +visit in the future in the same session. + @node Highlight Interactively @section Interactive Highlighting diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index b6d149eb3ef..7071ea44edd 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -383,6 +383,10 @@ Top * Visual Line Mode:: Word wrap and screen line-based editing. * Display Custom:: Information on variables for customizing display. +Font Lock +* Traditional Font Lock:: Font Lock based on regexps and syntax tables. +* Parser-based Font Lock:: Font Lock based on external parser. + Searching and Replacement * Incremental Search:: Search happens as you type the string. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 6d666831612..c0e702da947 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -215,6 +215,17 @@ Visiting try, Emacs displays an error message saying that the maximum buffer size has been exceeded. +@vindex treesit-max-buffer-size + If you try to visit a file whose major mode (@pxref{Major Modes}) +uses the tree-sitter parsing library, Emacs will display a warning if +the file's size in bytes is larger than the value of the variable +@code{treesit-max-buffer-size}. The default value is 40 megabytes for +64-bit Emacs and 15 megabytes for 32-bit Emacs. This avoids the +danger of having Emacs run out of memory by preventing the activation +of major modes based on tree-sitter in such large buffers, because a +typical tree-sitter parser needs about 10 times as much memory as the +text it parses. + @cindex wildcard characters in file names @vindex find-file-wildcards If the file name you specify contains shell-style wildcard diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 4aac150934b..e9268ff2a0d 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -254,6 +254,17 @@ Moving by Defuns language. Other major modes may replace any or all of these key bindings for that purpose. +@cindex nested defuns +@vindex treesit-defun-tactic + Some programming languages supported @dfn{nested defuns}, whereby a +defun (such as a function or a method or a class) can be defined +inside (i.e., as part of the body) of another defun. The commands +described above by default find the beginning and the end of the +@emph{innermost} defun around point. Major modes based on the +tree-sitter library provide control of this behavior: if the variable +@code{treesit-defun-tactic} is set to the value @code{top-level}, the +defun commands will find the @emph{outermost} defuns instead. + @node Imenu @subsection Imenu @cindex index of buffer definitions @@ -520,15 +531,19 @@ C Indent @item C-c C-q @kindex C-c C-q @r{(C mode)} @findex c-indent-defun +@findex c-ts-mode-indent-defun Reindent the current top-level function definition or aggregate type -declaration (@code{c-indent-defun}). +declaration (@code{c-indent-defun} in CC mode, +@code{c-ts-mode-indent-defun} in @code{c-ts-mode} based on tree-sitter). @item C-M-q @kindex C-M-q @r{(C mode)} @findex c-indent-exp -Reindent each line in the balanced expression that follows point -(@code{c-indent-exp}). A prefix argument inhibits warning messages -about invalid syntax. +@findex prog-indent-sexp +Reindent each line in the balanced expression that follows point. In +CC mode, this invokes @code{c-indent-exp}; in tree-sitter based +@code{c-ts-mode} this invokes a more general @code{prog-indent-sexp}. +A prefix argument inhibits warning messages about invalid syntax. @item @key{TAB} @findex c-indent-line-or-region @@ -568,7 +583,8 @@ Custom C Indent @table @kbd @item C-c . @var{style} @key{RET} -Select a predefined style @var{style} (@code{c-set-style}). +Select a predefined style @var{style} (@code{c-set-style} in CC mode, +@code{c-ts-mode-set-style} in @code{c-ts-mode} based on tree-sitter). @end table A @dfn{style} is a named collection of customizations that can be @@ -584,6 +600,7 @@ Custom C Indent @kindex C-c . @r{(C mode)} @findex c-set-style +@findex c-ts-mode-set-style To choose a style for the current buffer, use the command @w{@kbd{C-c .}}. Specify a style name as an argument (case is not significant). This command affects the current buffer only, and it affects only @@ -592,11 +609,11 @@ Custom C Indent new style, you can type @kbd{C-x h C-M-\}. @vindex c-default-style - You can also set the variable @code{c-default-style} to specify the -default style for various major modes. Its value should be either the -style's name (a string) or an alist, in which each element specifies -one major mode and which indentation style to use for it. For -example, + When using CC mode, you can also set the variable +@code{c-default-style} to specify the default style for various major +modes. Its value should be either the style's name (a string) or an +alist, in which each element specifies one major mode and which +indentation style to use for it. For example, @example (setq c-default-style @@ -613,6 +630,11 @@ Custom C Indent style for Java mode, you can make it take effect in an existing Java mode buffer by typing @kbd{M-x java-mode} there. +@vindex c-ts-mode-indent-style + When using the tree-sitter based @code{c-ts-mode}, you can set the +default indentation style by customizing the variable +@code{c-ts-mode-indent-style}. + The @code{gnu} style specifies the formatting recommended by the GNU Project for C; it is the default, so as to encourage use of our recommended style. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index b2f92b93193..612c41bf073 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -700,7 +700,8 @@ c-ts-mode-indent-defun (defvar-keymap c-ts-mode-map :doc "Keymap for the C language with tree-sitter" :parent prog-mode-map - "C-c C-q" #'c-ts-mode-indent-defun) + "C-c C-q" #'c-ts-mode-indent-defun + "C-c ." #'c-ts-mode-set-style) ;;;###autoload (define-derived-mode c-ts-base-mode prog-mode "C" diff --git a/lisp/treesit.el b/lisp/treesit.el index 5fb6a2eef6e..92833fb007c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -580,16 +580,21 @@ treesit-font-lock-level fontifications. Level 1 usually contains only comments and definitions. -Level 2 usually adds keywords, strings, constants, types, etc. -Level 3 usually represents a full-blown fontification, including -assignment, constants, numbers, properties, etc. +Level 2 usually adds keywords, strings, data types, etc. +Level 3 usually represents full-blown fontifications, including +assignments, constants, numbers and literals, properties, etc. Level 4 adds everything else that can be fontified: delimiters, -operators, brackets, all functions and variables, etc. +operators, brackets, punctuation, all functions and variables, etc. In addition to the decoration level, individual features can be turned on/off by calling `treesit-font-lock-recompute-features'. Changing the decoration level requires calling -`treesit-font-lock-recompute-features' to have an effect." +`treesit-font-lock-recompute-features' to have an effect, unless +done via `customize-variable'. + +To see which syntactical categories are fontified by each level +in a particular major mode, examine the buffer-local value of the +variable `treesit-font-lock-feature-list'." :type 'integer :set #'treesit--font-lock-level-setter :version "29.1") commit 254c75fc2935e7edef079166d90b231278115a2f Author: Mattias Engdegård Date: Sun Jan 29 13:34:48 2023 +0100 Better commutative binary numerical op codegen * lisp/emacs-lisp/bytecomp.el (byte-compile-variadic-numeric): Put a constant argument last for better LAP code opportunities. This applies to commutative binary operations (+ and *). `min` and `max` are not included being not quite commutative. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index bfb9be4712b..e8a8fe37756 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4063,9 +4063,15 @@ byte-compile-variadic-numeric (byte-compile-constant 1) (byte-compile-out (get '* 'byte-opcode) 0)) (3 - (byte-compile-form (nth 1 form)) - (byte-compile-form (nth 2 form)) - (byte-compile-out (get (car form) 'byte-opcode) 0)) + (let ((arg1 (nth 1 form)) + (arg2 (nth 2 form))) + (when (and (memq (car form) '(+ *)) + (macroexp-const-p arg1)) + ;; Put constant argument last for better LAP optimisation. + (cl-rotatef arg1 arg2)) + (byte-compile-form arg1) + (byte-compile-form arg2) + (byte-compile-out (get (car form) 'byte-opcode) 0))) (_ ;; >2 args: compile as a single function call. (byte-compile-normal-call form)))) commit e55855c5a1e85e230d2860c973358a34eb72da64 Author: Mattias Engdegård Date: Sat Jan 28 16:26:37 2023 +0100 Better compilation of n-ary comparisons Transform n-ary comparisons to a chain of binary comparisons in the Lisp optimiser instead of in codegen, to allow for subsequent optimisations. This generalises the transform, so that (< 1 X 10) -> (let ((x X)) (and (< 1 x) (< x 10))) where (< 1 x) is then flipped to (> x 1) in codegen since it's slightly more efficient to have the constant argument last. Arguments that are neither constants nor variables are given temporary bindings. This results in about 2× speedup for 3-ary comparisons of fixnums with nontrivial arguments, and also improves the code slightly for binary comparisons with a constant first argument. * lisp/emacs-lisp/byte-opt.el (byte-opt--nary-comparison): New, set as the `byte-optimizer` property for =, <, <=, >, and >=. * lisp/emacs-lisp/bytecomp.el (byte-compile-and-folded): Rename to... (byte-compile-cmp): ...and rewrite. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index b1a46d520e6..4d39e28fc8e 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -975,6 +975,43 @@ byte-optimize-binary-predicate (t ;; Moving the constant to the end can enable some lapcode optimizations. (list (car form) (nth 2 form) (nth 1 form))))) +(defun byte-opt--nary-comparison (form) + "Optimise n-ary comparisons such as `=', `<' etc." + (let ((nargs (length (cdr form)))) + (cond + ((= nargs 1) + `(progn (cadr form) t)) + ((>= nargs 3) + ;; At least 3 arguments: transform to N-1 binary comparisons, + ;; since those have their own byte-ops which are particularly + ;; fast for fixnums. + (let* ((op (car form)) + (bindings nil) + (rev-args nil)) + (if (memq nil (mapcar #'macroexp-copyable-p (cddr form))) + ;; At least one arg beyond the first is non-constant non-variable: + ;; create temporaries for all args to guard against side-effects. + ;; The optimiser will eliminate trivial bindings later. + (let ((i 1)) + (dolist (arg (cdr form)) + (let ((var (make-symbol (format "arg%d" i)))) + (push var rev-args) + (push (list var arg) bindings) + (setq i (1+ i))))) + ;; All args beyond the first are copyable: no temporary variables + ;; required. + (setq rev-args (reverse (cdr form)))) + (let ((prev (car rev-args)) + (exprs nil)) + (dolist (arg (cdr rev-args)) + (push (list op arg prev) exprs) + (setq prev arg)) + (let ((and-expr (cons 'and exprs))) + (if bindings + (list 'let (nreverse bindings) and-expr) + and-expr))))) + (t form)))) + (defun byte-optimize-constant-args (form) (let ((ok t) (rest (cdr form))) @@ -1130,13 +1167,18 @@ byte-optimize-string-greaterp (put 'max 'byte-optimizer #'byte-optimize-min-max) (put 'min 'byte-optimizer #'byte-optimize-min-max) -(put '= 'byte-optimizer #'byte-optimize-binary-predicate) (put 'eq 'byte-optimizer #'byte-optimize-eq) (put 'eql 'byte-optimizer #'byte-optimize-equal) (put 'equal 'byte-optimizer #'byte-optimize-equal) (put 'string= 'byte-optimizer #'byte-optimize-binary-predicate) (put 'string-equal 'byte-optimizer #'byte-optimize-binary-predicate) +(put '= 'byte-optimizer #'byte-opt--nary-comparison) +(put '< 'byte-optimizer #'byte-opt--nary-comparison) +(put '<= 'byte-optimizer #'byte-opt--nary-comparison) +(put '> 'byte-optimizer #'byte-opt--nary-comparison) +(put '>= 'byte-optimizer #'byte-opt--nary-comparison) + (put 'string-greaterp 'byte-optimizer #'byte-optimize-string-greaterp) (put 'string> 'byte-optimizer #'byte-optimize-string-greaterp) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index aa9521e5a65..bfb9be4712b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3748,7 +3748,7 @@ byte-defop-compiler '((0 . byte-compile-no-args) (1 . byte-compile-one-arg) (2 . byte-compile-two-args) - (2-and . byte-compile-and-folded) + (2-cmp . byte-compile-cmp) (3 . byte-compile-three-args) (0-1 . byte-compile-zero-or-one-arg) (1-2 . byte-compile-one-or-two-args) @@ -3827,11 +3827,11 @@ memq (byte-defop-compiler cons 2) (byte-defop-compiler aref 2) (byte-defop-compiler set 2) -(byte-defop-compiler (= byte-eqlsign) 2-and) -(byte-defop-compiler (< byte-lss) 2-and) -(byte-defop-compiler (> byte-gtr) 2-and) -(byte-defop-compiler (<= byte-leq) 2-and) -(byte-defop-compiler (>= byte-geq) 2-and) +(byte-defop-compiler (= byte-eqlsign) 2-cmp) +(byte-defop-compiler (< byte-lss) 2-cmp) +(byte-defop-compiler (> byte-gtr) 2-cmp) +(byte-defop-compiler (<= byte-leq) 2-cmp) +(byte-defop-compiler (>= byte-geq) 2-cmp) (byte-defop-compiler get 2) (byte-defop-compiler nth 2) (byte-defop-compiler substring 1-3) @@ -3895,18 +3895,20 @@ byte-compile-two-args (byte-compile-form (nth 2 form)) (byte-compile-out (get (car form) 'byte-opcode) 0))) -(defun byte-compile-and-folded (form) - "Compile calls to functions like `<='. -These implicitly `and' together a bunch of two-arg bytecodes." - (let ((l (length form))) - (cond - ((< l 3) (byte-compile-form `(progn ,(nth 1 form) t))) - ((= l 3) (byte-compile-two-args form)) - ;; Don't use `cl-every' here (see comment where we require cl-lib). - ((not (memq nil (mapcar #'macroexp-copyable-p (nthcdr 2 form)))) - (byte-compile-form `(and (,(car form) ,(nth 1 form) ,(nth 2 form)) - (,(car form) ,@(nthcdr 2 form))))) - (t (byte-compile-normal-call form))))) +(defun byte-compile-cmp (form) + "Compile calls to numeric comparisons such as `<', `=' etc." + ;; Lisp-level transforms should already have reduced valid calls to 2 args. + (if (not (= (length form) 3)) + (byte-compile-subr-wrong-args form "1 or more") + (byte-compile-two-args + (if (macroexp-const-p (nth 1 form)) + ;; First argument is constant: flip it so that the constant + ;; is last, which may allow more lapcode optimisations. + (let* ((op (car form)) + (flipped-op (cdr (assq op '((< . >) (<= . >=) + (> . <) (>= . <=) (= . =)))))) + (list flipped-op (nth 2 form) (nth 1 form))) + form)))) (defun byte-compile-three-args (form) (if (not (= (length form) 4)) commit e2b37f901d16d8e621d2adfed84f46a21a3716ab Author: Michael Albinus Date: Sun Jan 29 10:33:43 2023 +0100 Fix host name completion for Tramp "podman" method * lisp/net/tramp-container.el (tramp-container--completion-function): Rename from `tramp-docker--completion-function'. Add argument PROGRAM. Use it for "docker" and "podman" host name completion. * lisp/net/tramp.el (tramp-set-completion-function): Check, that cdr of FUNCTION-LIST entries is a string. diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 1dd29190f10..5ae9ebaefb2 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -121,15 +121,16 @@ tramp-toolbox-method "Tramp method name to use to connect to Toolbox containers.") ;;;###tramp-autoload -(defun tramp-docker--completion-function (&rest _args) - "List Docker-like containers available for connection. +(defun tramp-container--completion-function (program) + "List running containers available for connection. +PROGRAM is the program to be run for \"ps\", either +`tramp-docker-program' or `tramp-podman-program'. This function is used by `tramp-set-completion-function', please see its function help for a description of the format." (when-let ((default-directory tramp-compat-temporary-file-directory) (raw-list (shell-command-to-string - (concat tramp-docker-program - " ps --format '{{.ID}}\t{{.Names}}'"))) + (concat program " ps --format '{{.ID}}\t{{.Names}}'"))) (lines (split-string raw-list "\n" 'omit)) (names (mapcar (lambda (line) @@ -139,7 +140,7 @@ tramp-docker--completion-function line) (or (match-string 2 line) (match-string 1 line)))) lines))) - (mapcar (lambda (m) (list nil m)) (delq nil names)))) + (mapcar (lambda (name) (list nil name)) (delq nil names)))) ;;;###tramp-autoload (defun tramp-kubernetes--completion-function (&rest _args) @@ -153,9 +154,7 @@ tramp-kubernetes--completion-function " get pods --no-headers " "-o custom-columns=NAME:.metadata.name"))) (names (split-string raw-list "\n" 'omit))) - (mapcar (lambda (name) - (list nil name)) - names))) + (mapcar (lambda (name) (list nil name)) (delq nil names)))) (defun tramp-kubernetes--current-context-data (vec) "Return Kubernetes current context data as JSON string." @@ -194,7 +193,7 @@ tramp-toolbox--completion-function line) (match-string 1 line))) lines))) - (mapcar (lambda (m) (list nil m)) (delq nil names)))) + (mapcar (lambda (name) (list nil name)) (delq nil names)))) ;;;###tramp-autoload (defvar tramp-default-remote-shell) ;; Silence byte compiler. @@ -256,11 +255,13 @@ tramp-default-remote-shell (tramp-set-completion-function tramp-docker-method - '((tramp-docker--completion-function ""))) + `((tramp-container--completion-function + ,(executable-find tramp-docker-program)))) (tramp-set-completion-function tramp-podman-method - '((tramp-docker--completion-function ""))) + `((tramp-container--completion-function + ,(executable-find tramp-podman-program)))) (tramp-set-completion-function tramp-kubernetes-method diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 50e1e2479d5..3871ee4dddd 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2458,13 +2458,14 @@ tramp-set-completion-function (setcdr v (delete (car v) (cdr v)))) ;; Check for function and file or registry key. (unless (and (functionp (nth 0 (car v))) + (stringp (nth 1 (car v))) (cond ;; Windows registry. ((string-prefix-p "HKEY_CURRENT_USER" (nth 1 (car v))) (and (memq system-type '(cygwin windows-nt)) (zerop (tramp-call-process - v "reg" nil nil nil "query" (nth 1 (car v)))))) + nil "reg" nil nil nil "query" (nth 1 (car v)))))) ;; DNS-SD service type. ((string-match-p tramp-dns-sd-service-regexp (nth 1 (car v)))) commit b73539832d9c4e802925cb8f261a13473da383b3 Author: Yuan Fu Date: Sun Jan 29 00:30:53 2023 -0800 ; Remove treesit--font-lock-fast-mode-grace-count * lisp/treesit.el: (treesit--font-lock-fast-mode-grace-count): Remove. Should've been removed in the last change. diff --git a/lisp/treesit.el b/lisp/treesit.el index f4976502fc1..5fb6a2eef6e 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -927,14 +927,6 @@ treesit--font-lock-fast-mode See comments in `treesit-font-lock-fontify-region' for more detail.") -(defvar-local treesit--font-lock-fast-mode-grace-count 5 - "Grace counts before we turn on the fast mode. - -When query takes abnormally long time to execute, we turn on the -\"fast mode\", but just to be on the safe side, we only turn on -the fast mode after this number of offenses. See bug#60691, -bug#60223.") - ;; Some details worth explaining: ;; ;; 1. When we apply face to a node, we clip the face into the commit 64fee21d5f85db465198970a4d636cb17d500f26 Author: Randy Taylor Date: Sat Jan 28 21:21:29 2023 -0500 Fix dockerfile-ts-mode line continuation indentation (bug#61131) Without this rule, line continuations are only indented after entering the contents for the line and hitting TAB or RET. For example: ``` EXPOSE 1 \ ``` After hitting RET to go to the next line, point would end up at BOL instead of lining up with the previous entry, like so: ``` EXPOSE 1 \ 2 ``` The new rule will indent it as so: ``` EXPOSE 1 \ 2 ``` * lisp/progmodes/dockerfile-ts-mode.el: (dockerfile-ts-mode--indent-rules): New rule. (dockerfile-ts-mode--line-continuation-p) (dockerfile-ts-mode--line-continuation-anchor): New functions. diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el index 2a295e885b0..f2f30cf2617 100644 --- a/lisp/progmodes/dockerfile-ts-mode.el +++ b/lisp/progmodes/dockerfile-ts-mode.el @@ -51,9 +51,27 @@ dockerfile-ts-mode--indent-rules ((parent-is "expose_instruction") (nth-sibling 1) 0) ((parent-is "label_instruction") (nth-sibling 1) 0) ((parent-is "shell_command") first-sibling 0) - ((parent-is "string_array") first-sibling 1))) + ((parent-is "string_array") first-sibling 1) + ((dockerfile-ts-mode--line-continuation-p) dockerfile-ts-mode--line-continuation-anchor 0))) "Tree-sitter indent rules.") +(defun dockerfile-ts-mode--line-continuation-p () + "Return t if the current node is a line continuation node." + (lambda (node _ _ &rest _) + (string= (treesit-node-type node) "\n"))) + +(defun dockerfile-ts-mode--line-continuation-anchor (_ _ &rest _) + "This anchor is used to align any nodes that are part of a line +continuation to the previous entry." + (save-excursion + (forward-line -1) + (let ((prev-node (treesit-node-at (point)))) + (if (string= (treesit-node-type prev-node) "\\\n") + (back-to-indentation) + (forward-word) + (forward-char)) + (+ 1 (- (point) (pos-bol)))))) + (defvar dockerfile-ts-mode--keywords '("ADD" "ARG" "AS" "CMD" "COPY" "CROSS_BUILD" "ENTRYPOINT" "ENV" "EXPOSE" "FROM" "HEALTHCHECK" "LABEL" "MAINTAINER" "ONBUILD" "RUN" commit 1970726e26a979243925fabe32686ba2ee757c6b Author: Yuan Fu Date: Sun Jan 29 00:07:46 2023 -0800 Use treesit-subtree-stat to determine treesit--font-lock-fast-mode * lisp/treesit.el: (treesit--children-covering-range-recurse): Return nil if LIMIT is exceeded. (treesit--font-lock-fast-mode): Change to a ternary value. (treesit-font-lock-fontify-region): Enable fast mode based on the result of treesit-subtree-stat. diff --git a/lisp/treesit.el b/lisp/treesit.el index b3029707376..f4976502fc1 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -913,14 +913,15 @@ treesit--children-covering-range-recurse (push r result)) (push child result)) (setq child (treesit-node-next-sibling child))) - ;; If NODE has no child, keep NODE. - (or result (list node)))) + ;; If NODE has no child, keep NODE. If LIMIT is exceeded, return + ;; nil. + (or result (and (> limit 0) (list node))))) (defsubst treesit--node-length (node) "Return the length of the text of NODE." (- (treesit-node-end node) (treesit-node-start node))) -(defvar-local treesit--font-lock-fast-mode nil +(defvar-local treesit--font-lock-fast-mode 'unspecified "If this variable is t, change the way we query so it's faster. This is not a general optimization and should be RARELY needed! See comments in `treesit-font-lock-fontify-region' for more @@ -985,36 +986,34 @@ treesit-font-lock-fontify-region (enable (nth 1 setting)) (override (nth 3 setting)) (language (treesit-query-language query))) - (when-let ((nodes (list (treesit-buffer-root-node language))) - ;; Only activate if ENABLE flag is t. - (activate (eq t enable))) - (ignore activate) - ;; If we run into problematic files, use the "fast mode" to - ;; try to recover. See comment #2 above for more explanation. - (when treesit--font-lock-fast-mode - (setq nodes (treesit--children-covering-range-recurse - (car nodes) start end (* 4 jit-lock-chunk-size)))) + ;; Use deterministic way to decide whether to turn on "fast + ;; mode". (See bug#60691, bug#60223.) + (when (eq treesit--font-lock-fast-mode 'unspecified) + (pcase-let ((`(,max-depth ,max-width) + (treesit-subtree-stat + (treesit-buffer-root-node language)))) + (if (or (> max-depth 100) (> max-width 4000)) + (setq treesit--font-lock-fast-mode t) + (setq treesit--font-lock-fast-mode nil)))) + + (when-let* ((root (treesit-buffer-root-node language)) + (nodes (if (eq t treesit--font-lock-fast-mode) + (treesit--children-covering-range-recurse + root start end (* 4 jit-lock-chunk-size)) + (list (treesit-buffer-root-node language)))) + ;; Only activate if ENABLE flag is t. + (activate (eq t enable))) + (ignore activate) ;; Query each node. (dolist (sub-node nodes) (let* ((delta-start (car treesit--font-lock-query-expand-range)) (delta-end (cdr treesit--font-lock-query-expand-range)) - (start-time (current-time)) (captures (treesit-query-capture sub-node query (max (- start delta-start) (point-min)) - (min (+ end delta-end) (point-max)))) - (end-time (current-time))) - ;; If for any query the query time is strangely long, - ;; switch to fast mode (see comments above). - (when (and (null treesit--font-lock-fast-mode) - (> (time-to-seconds - (time-subtract end-time start-time)) - 0.01)) - (if (> treesit--font-lock-fast-mode-grace-count 0) - (cl-decf treesit--font-lock-fast-mode-grace-count) - (setq-local treesit--font-lock-fast-mode t))) + (min (+ end delta-end) (point-max))))) ;; For each captured node, fontify that node. (with-silent-modifications @@ -1023,12 +1022,14 @@ treesit-font-lock-fontify-region (node (cdr capture)) (node-start (treesit-node-start node)) (node-end (treesit-node-end node))) + ;; If node is not in the region, take them out. See ;; comment #3 above for more detail. (if (and (facep face) (or (>= start node-end) (>= node-start end))) (when (or loudly treesit--font-lock-verbose) (message "Captured node %s(%s-%s) but it is outside of fontifing region" node node-start node-end)) + (cond ((facep face) (treesit-fontify-with-override @@ -1036,6 +1037,7 @@ treesit-font-lock-fontify-region face override)) ((functionp face) (funcall face node override start end))) + ;; Don't raise an error if FACE is neither a face nor ;; a function. This is to allow intermediate capture ;; names used for #match and #eq. commit 382e018856a884a96a94ad551dbc1d7b0317b2e5 Author: Yuan Fu Date: Sun Jan 29 00:06:09 2023 -0800 Add treesit-subtree-stat * src/treesit.c (Ftreesit_subtree_stat): New function. * lisp/treesit.el (treesit): Add to shortdoc. diff --git a/lisp/treesit.el b/lisp/treesit.el index 363692eabdf..b3029707376 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2972,10 +2972,10 @@ treesit :no-value (treesit-parser-set-included-ranges parser '((1 . 4) (5 . 8)))) (treesit-parser-included-ranges :no-eval (treesit-parser-included-ranges parser) - :eg-result '((1 . 4) (5 . 8))) + :eg-result ((1 . 4) (5 . 8))) (treesit-query-range :no-eval (treesit-query-range node '((script_element) @cap)) - :eg-result-string '((1 . 4) (5 . 8))) + :eg-result ((1 . 4) (5 . 8))) "Retrieving a node" @@ -3121,7 +3121,12 @@ treesit :eg-result-string "#") (treesit-query-string :no-eval (treesit-query-string "int c = 0;" '((identifier) @id) 'c) - :eg-result-string "((id . #))")) + :eg-result-string "((id . #))") + + "Misc" + (treesit-subtree-stat + :no-eval (treesit-subtree-stat node) + :eg-result (6 33 487))) (provide 'treesit) diff --git a/src/treesit.c b/src/treesit.c index 917db582676..b210ec0923a 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -3312,6 +3312,68 @@ DEFUN ("treesit-induce-sparse-tree", return parent; } +DEFUN ("treesit-subtree-stat", + Ftreesit_subtree_stat, + Streesit_subtree_stat, 1, 1, 0, + doc: /* Return information about the subtree of NODE. + +Return a list (MAX-DEPTH MAX-WIDTH COUNT), where MAX-DEPTH is the +maximum depth of the subtree, MAX-WIDTH is the maximum number of +direct children of nodes in the subtree, and COUNT is the number of +nodes in the subtree, including NODE. */) + (Lisp_Object node) +{ + /* Having a limit on the depth to traverse doesn't have much impact + on the time it takes, so I left that out. */ + CHECK_TS_NODE (node); + + treesit_initialize (); + + TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (node)->node); + ptrdiff_t max_depth = 1; + ptrdiff_t max_width = 0; + ptrdiff_t count = 0; + ptrdiff_t current_depth = 0; + + /* Traverse the subtree depth-first. */ + while (true) + { + count++; + + /* Go down depth-first. */ + while (ts_tree_cursor_goto_first_child (&cursor)) + { + current_depth++; + count++; + /* While we're at here, measure the number of siblings. */ + ptrdiff_t width_count = 1; + while (ts_tree_cursor_goto_next_sibling (&cursor)) + width_count++; + max_width = max (max_width, width_count); + /* Go back to the first sibling. */ + treesit_assume_true (ts_tree_cursor_goto_parent (&cursor)); + treesit_assume_true (ts_tree_cursor_goto_first_child (&cursor)); + } + max_depth = max (max_depth, current_depth); + + /* Go to next sibling. If there is no next sibling, go to + parent's next sibling, and so on. If there is no more + parent, we've traversed the whole subtree, stop. */ + while (!ts_tree_cursor_goto_next_sibling (&cursor)) + { + if (ts_tree_cursor_goto_parent (&cursor)) + current_depth--; + else + { + ts_tree_cursor_delete (&cursor); + return list3 (make_fixnum (max_depth), + make_fixnum (max_width), + make_fixnum (count)); + } + } + } +} + #endif /* HAVE_TREE_SITTER */ DEFUN ("treesit-available-p", Ftreesit_available_p, @@ -3511,6 +3573,7 @@ syms_of_treesit (void) defsubr (&Streesit_search_subtree); defsubr (&Streesit_search_forward); defsubr (&Streesit_induce_sparse_tree); + defsubr (&Streesit_subtree_stat); #endif /* HAVE_TREE_SITTER */ defsubr (&Streesit_available_p); } commit a3003492ace0571e5179500b42bbe44cb9763dbb Author: Yuan Fu Date: Sat Jan 28 17:08:53 2023 -0800 Move c-ts-mode--statement-offset to c-ts-common.el Now it can be used by other C-like languages. * lisp/progmodes/c-ts-common.el (c-ts-common-indent-offset): (c-ts-common-indent-block-type-regexp): (c-ts-common-indent-bracketless-type-regexp): New variables. (c-ts-common-statement-offset): (c-ts-mode--fix-bracketless-indent): (c-ts-mode--close-bracket-offset): New functions. * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Change c-ts-mode--statement-offset to c-ts-common-statement-offset. The (parent-is "if_statement") rules are now handled by (node-is "compound_statement"). (c-ts-mode--statement-offset-post-processr): (c-ts-mode--statement-offset): (c-ts-mode--fix-bracketless-indent): Move to c-ts-common.el. (c-ts-base-mode): Setup c-ts-common stuff. * test/lisp/progmodes/c-ts-mode-resources/indent.erts: Make the test more challenging. diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 6671d4be5b6..2d4a0d41c2a 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2023 Free Software Foundation, Inc. -;; Author : 付禹安 (Yuan Fu) +;; Maintainer : 付禹安 (Yuan Fu) ;; Keywords : c c++ java javascript rust languages tree-sitter ;; This file is part of GNU Emacs. @@ -22,7 +22,10 @@ ;;; Commentary: ;; -;; For C-like language major modes: +;; This file contains functions that can be shared by C-like language +;; major modes, like indenting and filling "/* */" block comments. +;; +;; For indenting and filling comments: ;; ;; - Use `c-ts-common-comment-setup' to setup comment variables and ;; filling. @@ -30,6 +33,14 @@ ;; - Use simple-indent matcher `c-ts-common-looking-at-star' and ;; anchor `c-ts-common-comment-start-after-first-star' for indenting ;; block comments. See `c-ts-mode--indent-styles' for example. +;; +;; For indenting statements: +;; +;; - Set `c-ts-common-indent-offset', +;; `c-ts-common-indent-block-type-regexp', and +;; `c-ts-common-indent-bracketless-type-regexp', then use simple-indent +;; offset `c-ts-common-statement-offset' in +;; `treesit-simple-indent-rules'. ;;; Code: @@ -40,6 +51,8 @@ (declare-function treesit-node-end "treesit.c") (declare-function treesit-node-type "treesit.c") +;;; Comment indentation and filling + (defun c-ts-common-looking-at-star (_n _p bol &rest _) "A tree-sitter simple indent matcher. Matches if there is a \"*\" after BOL." @@ -242,6 +255,107 @@ c-ts-common-comment-setup (setq-local paragraph-separate paragraph-start) (setq-local fill-paragraph-function #'c-ts-common--fill-paragraph)) +;;; Statement indent + +(defvar c-ts-common-indent-offset nil + "Indent offset used by `c-ts-common' indent functions. + +This should be the symbol of the indent offset variable for the +particular major mode. This cannot be nil for `c-ts-common' +statement indent functions to work.") + +(defvar c-ts-common-indent-block-type-regexp nil + "Regexp matching types of block nodes (i.e., {} blocks). + +This cannot be nil for `c-ts-common' statement indent functions +to work.") + +(defvar c-ts-common-indent-bracketless-type-regexp nil + "A regexp matching types of bracketless constructs. + +These constructs include if, while, do-while, for statements. In +these statements, the body can omit the bracket, which requires +special handling from our bracket-counting indent algorithm. + +This can be nil, meaning such special handling is not needed.") + +(defun c-ts-common-statement-offset (node parent &rest _) + "This anchor is used for children of a statement inside a block. + +This function basically counts the number of block nodes (i.e., +brackets) (defined by `c-ts-mode--indent-block-type-regexp') +between NODE and the root node (not counting NODE itself), and +multiply that by `c-ts-common-indent-offset'. + +To support GNU style, on each block level, this function also +checks whether the opening bracket { is on its own line, if so, +it adds an extra level, except for the top-level. + +PARENT is NODE's parent." + (let ((level 0)) + ;; If point is on an empty line, NODE would be nil, but we pretend + ;; there is a statement node. + (when (null node) + (setq node t)) + ;; If NODE is a opening bracket on its own line, take off one + ;; level because the code below assumes NODE is a statement + ;; _inside_ a {} block. + (when (string-match-p c-ts-common-indent-block-type-regexp + (treesit-node-type node)) + (cl-decf level)) + ;; Go up the tree and compute indent level. + (while (if (eq node t) + (setq node parent) + node) + (when (string-match-p c-ts-common-indent-block-type-regexp + (treesit-node-type node)) + (cl-incf level) + (save-excursion + (goto-char (treesit-node-start node)) + ;; Add an extra level if the opening bracket is on its own + ;; line, except (1) it's at top-level, or (2) it's immediate + ;; parent is another block. + (cond ((bolp) nil) ; Case (1). + ((let ((parent-type (treesit-node-type + (treesit-node-parent node)))) + ;; Case (2). + (and parent-type + (or (string-match-p + c-ts-common-indent-block-type-regexp + parent-type)))) + nil) + ;; Add a level. + ((looking-back (rx bol (* whitespace)) + (line-beginning-position)) + (cl-incf level))))) + (setq level (c-ts-mode--fix-bracketless-indent level node)) + ;; Go up the tree. + (setq node (treesit-node-parent node))) + (* level (symbol-value c-ts-common-indent-offset)))) + +(defun c-ts-mode--fix-bracketless-indent (level node) + "Takes LEVEL and NODE and return adjusted LEVEL. +This fixes indentation for cases shown in bug#61026. Basically +in C-like syntax, statements like if, for, while sometimes omit +the bracket in the body." + (let ((block-re c-ts-common-indent-block-type-regexp) + (statement-re + c-ts-common-indent-bracketless-type-regexp) + (node-type (treesit-node-type node)) + (parent-type (treesit-node-type (treesit-node-parent node)))) + (if (and block-re statement-re node-type parent-type + (not (string-match-p block-re node-type)) + (string-match-p statement-re parent-type)) + (1+ level) + level))) + +(defun c-ts-mode--close-bracket-offset (node parent &rest _) + "Offset for the closing bracket, NODE. +It's basically one level less that the statements in the block. +PARENT is NODE's parent." + (- (c-ts-common-statement-offset node parent) + (symbol-value c-ts-common-indent-offset))) + (provide 'c-ts-common) ;;; c-ts-common.el ends here diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 353c4c45479..b2f92b93193 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -63,11 +63,6 @@ ;; will set up Emacs to use the C/C++ modes defined here for other ;; files, provided that you have the corresponding parser grammar ;; libraries installed. -;; -;; - Use variable `c-ts-mode-indent-block-type-regexp' with indent -;; offset c-ts-mode--statement-offset for indenting statements. -;; Again, see `c-ts-mode--indent-styles' for example. -;; ;;; Code: @@ -228,7 +223,7 @@ c-ts-mode--indent-styles ;; Labels. ((node-is "labeled_statement") parent-bol 0) ((parent-is "labeled_statement") - point-min c-ts-mode--statement-offset) + point-min c-ts-common-statement-offset) ((match "preproc_ifdef" "compound_statement") point-min 0) ((match "#endif" "preproc_ifdef") point-min 0) @@ -237,15 +232,6 @@ c-ts-mode--indent-styles ((match "preproc_function_def" "compound_statement") point-min 0) ((match "preproc_call" "compound_statement") point-min 0) - ;; {} blocks. - ((node-is "}") point-min c-ts-mode--close-bracket-offset) - ((parent-is "compound_statement") - point-min c-ts-mode--statement-offset) - ((parent-is "enumerator_list") - point-min c-ts-mode--statement-offset) - ((parent-is "field_declaration_list") - point-min c-ts-mode--statement-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) @@ -266,13 +252,16 @@ c-ts-mode--indent-styles ;; Indent the body of namespace definitions. ((parent-is "declaration_list") parent-bol c-ts-mode-indent-offset))) + ;; int[5] a = { 0, 0, 0, 0 }; ((parent-is "initializer_list") parent-bol c-ts-mode-indent-offset) - ((parent-is "if_statement") parent-bol c-ts-mode-indent-offset) - ((parent-is "for_statement") parent-bol c-ts-mode-indent-offset) - ((parent-is "while_statement") parent-bol c-ts-mode-indent-offset) - ((parent-is "switch_statement") parent-bol c-ts-mode-indent-offset) - ((parent-is "case_statement") parent-bol c-ts-mode-indent-offset) - ((parent-is "do_statement") parent-bol c-ts-mode-indent-offset) + ((parent-is "enumerator_list") point-min c-ts-common-statement-offset) + ((parent-is "field_declaration_list") point-min c-ts-common-statement-offset) + + ;; {} blocks. + ((node-is "}") point-min c-ts-mode--close-bracket-offset) + ((parent-is "compound_statement") point-min c-ts-common-statement-offset) + ((node-is "compound_statement") point-min c-ts-common-statement-offset) + ,@(when (eq mode 'cpp) `(((node-is "field_initializer_list") parent-bol ,(* c-ts-mode-indent-offset 2))))))) `((gnu @@ -311,90 +300,6 @@ c-ts-mode--top-level-label-matcher "labeled_statement") (not (treesit-node-top-level func "compound_statement"))))) -(defvar c-ts-mode-indent-block-type-regexp - (rx (or "compound_statement" - "field_declaration_list" - "enumerator_list")) - "Regexp matching types of block nodes (i.e., {} blocks).") - -(defvar c-ts-mode--statement-offset-post-processr nil - "A functions that makes adjustments to `c-ts-mode--statement-offset'. - -This is a function that takes two arguments, the current indent -level and the current node, and returns a new level. - -When `c-ts-mode--statement-offset' runs and go up the parse tree, -it increments the indent level when some condition are met in -each level. At each level, after (possibly) incrementing the -offset, it calls this function, passing it the current indent -level and the current node, and use the return value as the new -indent level.") - -(defun c-ts-mode--statement-offset (node parent &rest _) - "This anchor is used for children of a statement inside a block. - -This function basically counts the number of block nodes (defined -by `c-ts-mode--indent-block-type-regexp') between NODE and the -root node (not counting NODE itself), and multiply that by -`c-ts-mode-indent-offset'. - -To support GNU style, on each block level, this function also -checks whether the opening bracket { is on its own line, if so, -it adds an extra level, except for the top-level. - -PARENT is NODE's parent." - (let ((level 0)) - ;; If point is on an empty line, NODE would be nil, but we pretend - ;; there is a statement node. - (when (null node) - (setq node t)) - (while (if (eq node t) - (setq node parent) - (setq node (treesit-node-parent node))) - (when (string-match-p c-ts-mode-indent-block-type-regexp - (treesit-node-type node)) - (cl-incf level) - (save-excursion - (goto-char (treesit-node-start node)) - ;; Add an extra level if the opening bracket is on its own - ;; line, except (1) it's at top-level, or (2) it's immediate - ;; parent is another block. - (cond ((bolp) nil) ; Case (1). - ((let ((parent-type (treesit-node-type - (treesit-node-parent node)))) - ;; Case (2). - (and parent-type - (string-match-p c-ts-mode-indent-block-type-regexp - parent-type))) - nil) - ;; Add a level. - ((looking-back (rx bol (* whitespace)) - (line-beginning-position)) - (cl-incf level))))) - (when c-ts-mode--statement-offset-post-processr - (setq level (funcall c-ts-mode--statement-offset-post-processr - level node)))) - (* level c-ts-mode-indent-offset))) - -(defun c-ts-mode--fix-bracketless-indent (level node) - "Takes LEVEL and NODE and returns adjusted LEVEL. -This fixes indentation for cases shown in bug#61026. Basically -in C/C++, constructs like if, for, while sometimes don't have -bracket." - (if (and (not (equal (treesit-node-type node) "compound_statement")) - (member (treesit-node-type (treesit-node-parent node)) - '("if_statement" "while_statement" "do_statement" - "for_statement"))) - (1+ level) - level)) - -(defun c-ts-mode--close-bracket-offset (node parent &rest _) - "Offset for the closing bracket, NODE. -It's basically one level less that the statements in the block. -PARENT is NODE's parent." - (- (c-ts-mode--statement-offset node parent) - c-ts-mode-indent-offset)) - ;;; Font-lock (defvar c-ts-mode--preproc-keywords @@ -824,8 +729,14 @@ c-ts-base-mode ;; Indent. (when (eq c-ts-mode-indent-style 'linux) (setq-local indent-tabs-mode t)) - (setq-local c-ts-mode--statement-offset-post-processr - #'c-ts-mode--fix-bracketless-indent) + (setq-local c-ts-common-indent-offset 'c-ts-mode-indent-offset) + (setq-local c-ts-common-indent-block-type-regexp + (rx (or "compound_statement" + "field_declaration_list" + "enumerator_list"))) + (setq-local c-ts-common-indent-bracketless-type-regexp + (rx (or "if_statement" "do_statement" + "for_statement" "while_statement"))) ;; Comment (c-ts-common-comment-setup) diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index 67654404a77..0ecbf922b15 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -114,7 +114,9 @@ int main() { { puts ("Hello"); } - for (int i=0; i<5; i++) + for (int i=0; + i<5; + i++) if (true) { puts ("Hello"); @@ -141,7 +143,9 @@ int main() { if (true) { puts ("Hello"); } - for (int i=0; i<5; i++) + for (int i=0; + i<5; + i++) if (true) { puts ("Hello"); } commit 4b1714571c8c6cf7ae2ee2602c66b7c903c45a4a Author: Yuan Fu Date: Sat Jan 28 16:25:23 2023 -0800 ; Fix byte-compile warnings in c-ts-mode.el * lisp/progmodes/c-ts-mode.el: (c-ts-mode--get-indent-style): Move down. (c-ts-mode-set-style): Add docstring. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 26ad61c975d..353c4c45479 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -114,15 +114,6 @@ c-ts-mode--indent-style-setter (loop (append res (list buffer)) (cdr buffers)) (loop res (cdr buffers)))))))) -(defun c-ts-mode--get-indent-style (mode) - "Helper function to set indentation style. -MODE is either `c' or `cpp'." - (let ((style - (if (functionp c-ts-mode-indent-style) - (funcall c-ts-mode-indent-style) - (alist-get c-ts-mode-indent-style (c-ts-mode--indent-styles mode))))) - `((,mode ,@style)))) - (defcustom c-ts-mode-indent-style 'gnu "Style used for indentation. @@ -139,13 +130,28 @@ c-ts-mode-indent-style :set #'c-ts-mode--indent-style-setter :group 'c) +(defun c-ts-mode--get-indent-style (mode) + "Helper function to set indentation style. +MODE is either `c' or `cpp'." + (let ((style + (if (functionp c-ts-mode-indent-style) + (funcall c-ts-mode-indent-style) + (alist-get c-ts-mode-indent-style (c-ts-mode--indent-styles mode))))) + `((,mode ,@style)))) + (defun c-ts-mode-set-style () + "Set the indent style of C/C++ modes globally. + +This changes the current indent style of every C/C++ buffer and +the default C/C++ indent style in this Emacs session." (interactive) + ;; FIXME: Should we use `derived-mode-p' here? (or (eq major-mode 'c-ts-mode) (eq major-mode 'c++-ts-mode) (error "Buffer %s is not a c-ts-mode (c-ts-mode-set-style)" (buffer-name))) (c-ts-mode--indent-style-setter 'c-ts-mode-indent-style + ;; NOTE: We can probably use the interactive form for this. (intern (completing-read "Select style: " commit f50cb7d7c4b37cd8e4bb1ffa5d3f9273c7e19e10 Author: Yuan Fu Date: Sat Jan 28 16:20:29 2023 -0800 ; Improve docstring of c-ts-mode--indent-style-setter * lisp/progmodes/c-ts-mode.el: (c-ts-mode--indent-style-setter): Improve docstring. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index c6eb1afecec..26ad61c975d 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -93,7 +93,9 @@ c-ts-mode-indent-offset :group 'c) (defun c-ts-mode--indent-style-setter (sym val) - "Custom setter for `c-ts-mode-set-style'." + "Custom setter for `c-ts-mode-set-style'. +Apart from setting the default value of SYM to VAL, also change +the value of SYM in `c-ts-mode' and `c++-ts-mode' buffers to VAL." (set-default sym val) (named-let loop ((res nil) (buffers (buffer-list))) @@ -107,6 +109,7 @@ c-ts-mode--indent-style-setter res) (let ((buffer (car buffers))) (with-current-buffer buffer + ;; FIXME: Should we use `derived-mode-p' here? (if (or (eq major-mode 'c-ts-mode) (eq major-mode 'c++-ts-mode)) (loop (append res (list buffer)) (cdr buffers)) (loop res (cdr buffers)))))))) commit 1c3ca3bb649b7e812a84b4a559463462d4357080 Author: Yuan Fu Date: Thu Jan 26 17:49:45 2023 -0800 Fix <> syntax in rust-ts-mode Similar to bug#60351, the angle brackets in rust-ts-mode are not recognized as pairs when they should be. This change copies the function used by c++-ts-mode and adapts it to rust-ts-mode. * lisp/progmodes/rust-ts-mode.el: (rust-ts-mode--syntax-propertize): New function. (rust-ts-mode): Set up syntax-propertize-function. diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 3a6cb61b719..2812e39c101 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -275,6 +275,28 @@ rust-ts-mode--defun-name (treesit-node-text (treesit-node-child-by-field-name node "name") t)))) +(defun rust-ts-mode--syntax-propertize (beg end) + "Apply syntax text property to template delimiters between BEG and END. + +< and > are usually punctuation, e.g., as greater/less-than. But +when used for types, 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)))) + ("type_arguments" + (put-text-property (match-beginning 0) + (match-end 0) + 'syntax-table + (pcase (char-before) + (?< '(4 . ?>)) + (?> '(5 . ?<)))))))) + ;;;###autoload (define-derived-mode rust-ts-mode prog-mode "Rust" "Major mode for editing Rust, powered by tree-sitter." @@ -284,6 +306,10 @@ rust-ts-mode (when (treesit-ready-p 'rust) (treesit-parser-create 'rust) + ;; Syntax. + (setq-local syntax-propertize-function + #'rust-ts-mode--syntax-propertize) + ;; Comments. (c-ts-common-comment-setup) commit 56e8607dc99b90c43f82001cbf073e58a4698298 Author: Eli Zaretskii Date: Sun Jan 29 09:44:53 2023 +0200 Fix spurious errors on Windows when deleting temporary *.eln files * lisp/emacs-lisp/comp.el (comp--native-compile): On MS-Windows, ignore errors when deleting a temporary .eln file. (Bug#60996) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 49e3cdb8de7..7ba8e956fb2 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4112,13 +4112,16 @@ comp--native-compile (native-elisp-load data))) ;; We may have created a temporary file when we're being ;; called with something other than a file as the argument. - ;; Delete it. + ;; Delete it if we can. (when (and (not (stringp function-or-file)) (not output) comp-ctxt (comp-ctxt-output comp-ctxt) (file-exists-p (comp-ctxt-output comp-ctxt))) - (delete-file (comp-ctxt-output comp-ctxt)))))))) + (cond ((eq 'windows-nt system-type) + ;; We may still be using the temporary .eln file. + (ignore-errors (delete-file (comp-ctxt-output comp-ctxt)))) + (t (delete-file (comp-ctxt-output comp-ctxt)))))))))) (defun native-compile-async-skip-p (file load selector) "Return non-nil if FILE's compilation should be skipped. commit 840f8bfdc93b0efde6fd204db27c9fb6ff1ee152 Author: Eli Zaretskii Date: Sun Jan 29 09:28:31 2023 +0200 * src/comp.c (F_RELOC_MAX_SIZE): Bump to 1600 (bug#60996). diff --git a/src/comp.c b/src/comp.c index bd7ecfffc23..6ff1915ef5b 100644 --- a/src/comp.c +++ b/src/comp.c @@ -531,7 +531,7 @@ #define DECL_BLOCK(name, func) \ #define SETJMP_NAME SETJMP /* Max number function importable by native compiled code. */ -#define F_RELOC_MAX_SIZE 1500 +#define F_RELOC_MAX_SIZE 1600 typedef struct { void *link_table[F_RELOC_MAX_SIZE]; commit 2bd0b9475384adfb4dd2cc794bbe1d8621546717 Author: Theodor Thornhill Date: Sat Jan 28 19:51:08 2023 +0100 Fix java class member without access modifier (bug#61115) This ``` public class T { @Autowired String a; } ``` Should be indented as: ``` public class T { @Autowired String a; } ```` * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): Add new rule to match edge case of field_declaration indentation. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 8737472e514..fc264f448af 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -89,6 +89,7 @@ java-ts-mode--indent-rules ((query "(method_declaration (block (_) @indent))") parent-bol java-ts-mode-indent-offset) ((parent-is "local_variable_declaration") parent-bol java-ts-mode-indent-offset) ((parent-is "expression_statement") parent-bol java-ts-mode-indent-offset) + ((match "type_identifier" "field_declaration") parent-bol 0) ((parent-is "field_declaration") parent-bol java-ts-mode-indent-offset) ((parent-is "return_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "variable_declarator") parent-bol java-ts-mode-indent-offset) commit 1de6ebf2878485a0ef6b778df7d6a14d5b22a01c Author: Theodor Thornhill Date: Sat Jan 28 13:57:01 2023 +0100 Make treesit-font-lock-level a defcustom * lisp/treesit.el (treesit--font-lock-level-setter): Setter for the new defcustom. (treesit-font-lock-level): Turn it into a defcustom. diff --git a/lisp/treesit.el b/lisp/treesit.el index 4c9bdfc0bd4..363692eabdf 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -554,7 +554,25 @@ 'treesit-font-lock-error "Generic tree-sitter font-lock error" 'treesit-error) -(defvar-local treesit-font-lock-level 3 +(defun treesit--font-lock-level-setter (sym val) + "Custom setter for `treesit-font-lock-level'." + (set-default sym val) + (named-let loop ((res nil) + (buffers (buffer-list))) + (if (null buffers) + (mapc (lambda (b) + (with-current-buffer b + (setq-local treesit-font-lock-level val) + (treesit-font-lock-recompute-features) + (treesit-font-lock-fontify-region (point-min) (point-max)))) + res) + (let ((buffer (car buffers))) + (with-current-buffer buffer + (if (treesit-parser-list) + (loop (append res (list buffer)) (cdr buffers)) + (loop res (cdr buffers)))))))) + +(defcustom treesit-font-lock-level 3 "Decoration level to be used by tree-sitter fontifications. Major modes categorize their fontification features into levels, @@ -571,7 +589,10 @@ treesit-font-lock-level In addition to the decoration level, individual features can be turned on/off by calling `treesit-font-lock-recompute-features'. Changing the decoration level requires calling -`treesit-font-lock-recompute-features' to have an effect.") +`treesit-font-lock-recompute-features' to have an effect." + :type 'integer + :set #'treesit--font-lock-level-setter + :version "29.1") (defvar-local treesit--font-lock-query-expand-range (cons 0 0) "The amount to expand the start and end of the region when fontifying. commit 6e50ee8bbb50ef86707cefed8ebb20f027156843 Author: Theodor Thornhill Date: Wed Jan 25 21:04:00 2023 +0100 Add c-ts-mode-set-style and :set for c-ts-mode-indent-style * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-style-setter): New setter for the indent style defcustom. (c-ts-mode-indent-style): Don't quote the values and refer to the setter. (c-ts-mode-set-style): New command to interactively set the indent style. (c-ts-mode--get-indent-style): New function renamed from 'c-ts-mode--set-indent-style'. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index eb2be9b792b..c6eb1afecec 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -92,6 +92,34 @@ c-ts-mode-indent-offset :safe 'integerp :group 'c) +(defun c-ts-mode--indent-style-setter (sym val) + "Custom setter for `c-ts-mode-set-style'." + (set-default sym val) + (named-let loop ((res nil) + (buffers (buffer-list))) + (if (null buffers) + (mapc (lambda (b) + (with-current-buffer b + (setq-local treesit-simple-indent-rules + (treesit--indent-rules-optimize + (c-ts-mode--get-indent-style + (if (eq major-mode 'c-ts-mode) 'c 'cpp)))))) + res) + (let ((buffer (car buffers))) + (with-current-buffer buffer + (if (or (eq major-mode 'c-ts-mode) (eq major-mode 'c++-ts-mode)) + (loop (append res (list buffer)) (cdr buffers)) + (loop res (cdr buffers)))))))) + +(defun c-ts-mode--get-indent-style (mode) + "Helper function to set indentation style. +MODE is either `c' or `cpp'." + (let ((style + (if (functionp c-ts-mode-indent-style) + (funcall c-ts-mode-indent-style) + (alist-get c-ts-mode-indent-style (c-ts-mode--indent-styles mode))))) + `((,mode ,@style)))) + (defcustom c-ts-mode-indent-style 'gnu "Style used for indentation. @@ -100,13 +128,27 @@ c-ts-mode-indent-style set instead. This function is expected return a list that follows the form of `treesit-simple-indent-rules'." :version "29.1" - :type '(choice (symbol :tag "Gnu" 'gnu) - (symbol :tag "K&R" 'k&r) - (symbol :tag "Linux" 'linux) - (symbol :tag "BSD" 'bsd) + :type '(choice (symbol :tag "Gnu" gnu) + (symbol :tag "K&R" k&r) + (symbol :tag "Linux" linux) + (symbol :tag "BSD" bsd) (function :tag "A function for user customized style" ignore)) + :set #'c-ts-mode--indent-style-setter :group 'c) +(defun c-ts-mode-set-style () + (interactive) + (or (eq major-mode 'c-ts-mode) (eq major-mode 'c++-ts-mode) + (error "Buffer %s is not a c-ts-mode (c-ts-mode-set-style)" + (buffer-name))) + (c-ts-mode--indent-style-setter + 'c-ts-mode-indent-style + (intern + (completing-read + "Select style: " + (mapcar #'car (c-ts-mode--indent-styles (if (eq major-mode 'c-ts-mode) 'c 'cpp))) + nil t nil nil "gnu")))) + ;;; Syntax table (defvar c-ts-mode--syntax-table @@ -249,19 +291,6 @@ c-ts-mode--indent-styles ((parent-is "do_statement") parent-bol 0) ,@common)))) -(defun c-ts-mode--set-indent-style (mode) - "Helper function to set indentation style. -MODE is either `c' or `cpp'." - (let ((style - (if (functionp c-ts-mode-indent-style) - (funcall c-ts-mode-indent-style) - (pcase c-ts-mode-indent-style - ('gnu (alist-get 'gnu (c-ts-mode--indent-styles mode))) - ('k&r (alist-get 'k&r (c-ts-mode--indent-styles mode))) - ('bsd (alist-get 'bsd (c-ts-mode--indent-styles mode))) - ('linux (alist-get 'linux (c-ts-mode--indent-styles mode))))))) - `((,mode ,@style)))) - (defun c-ts-mode--top-level-label-matcher (node &rest _) "A matcher that matches a top-level label. NODE should be a labeled_statement." @@ -840,7 +869,7 @@ c-ts-mode (setq-local comment-end " */") ;; Indent. (setq-local treesit-simple-indent-rules - (c-ts-mode--set-indent-style 'c)) + (c-ts-mode--get-indent-style 'c)) ;; Font-lock. (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c)) (treesit-major-mode-setup))) @@ -870,7 +899,7 @@ c++-ts-mode #'c-ts-mode--syntax-propertize) ;; Indent. (setq-local treesit-simple-indent-rules - (c-ts-mode--set-indent-style 'cpp)) + (c-ts-mode--get-indent-style 'cpp)) ;; Font-lock. (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'cpp)) (treesit-major-mode-setup))) commit 450db0587a91ff13403488fbabc744567be7f6fa Author: Juri Linkov Date: Sat Jan 28 19:59:22 2023 +0200 Minor documentation improvements for outline-minor-mode (bug#61062) * doc/emacs/text.texi (Outline Minor Mode, Outline Minor Mode): Add pxrefs to "Icons" and "Outline Visibility". * etc/NEWS: Mention outline-minor-mode for two modes. diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index 83d5869ee64..3cc5f10582a 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1017,14 +1017,16 @@ Outline Minor Mode the buffer text, so @key{RET} on the button will also toggle display of the section, like a mouse click does. If the value is @code{in-margins}, Outline minor mode will use the window margins to -indicate that a section is hidden. +indicate that a section is hidden. The buttons are customizable as icons +(@pxref{Icons}). @vindex outline-minor-mode-cycle If the @code{outline-minor-mode-cycle} user option is -non-@code{nil}, the @kbd{TAB} and @kbd{S-@key{TAB}} keys are enabled on the -outline heading lines. @kbd{TAB} cycles hiding, showing the -sub-heading, and showing all for the current section. @kbd{S-@key{TAB}} -does the same for the entire buffer. +non-@code{nil}, the @kbd{TAB} and @kbd{S-@key{TAB}} keys that cycle +the visibility are enabled on the outline heading lines +(@pxref{Outline Visibility, outline-cycle}). @kbd{TAB} cycles hiding, +showing the sub-heading, and showing all for the current section. +@kbd{S-@key{TAB}} does the same for the entire buffer. @node Outline Format @subsection Format of Outlines diff --git a/etc/NEWS b/etc/NEWS index 4d199676848..fb211f9b7d0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1018,6 +1018,8 @@ quotes removed. --- *** 'M-x apropos-variable' output now includes values of variables. +Such apropos buffer is more easily viewed with outlining after +enabling 'outline-minor-mode' in 'apropos-mode'. +++ *** New docstring syntax to indicate that symbols shouldn't be links. @@ -2480,6 +2482,10 @@ matches. --- *** New function 'xref-show-xrefs'. +*** 'outline-minor-mode' is supported in Xref buffers. +You can enable outlining by adding 'outline-minor-mode' to +'xref-after-update-hook'. + ** File Notifications +++ commit 835d2b6acbe42b0bdef8f6e5f00fb0adbd1e3bcb Author: Michael Heerdegen Date: Wed Jan 11 16:47:01 2023 +0100 ; * lisp/emacs-lisp/range.el: Fix some typos In some places, range elements are still called "article" (as in the original Gnus code). Replace these occurrences with the word "number" as used in the rest of the file. diff --git a/lisp/emacs-lisp/range.el b/lisp/emacs-lisp/range.el index 1165fcbbd7d..f441c240a27 100644 --- a/lisp/emacs-lisp/range.el +++ b/lisp/emacs-lisp/range.el @@ -194,7 +194,7 @@ range-uncompress (nreverse result))))) (defun range-add-list (ranges list) - "Return a list of ranges that has all articles from both RANGES and LIST. + "Return a list of ranges that has all numbers from both RANGES and LIST. Note: LIST has to be sorted over `<'." (if (not ranges) (range-compress-list list) @@ -249,9 +249,9 @@ range-add-list out))) (defun range-remove (range1 range2) - "Return a range that has all articles from RANGE2 removed from RANGE1. + "Return a range that has all numbers from RANGE2 removed from RANGE1. The returned range is always a list. RANGE2 can also be a unsorted -list of articles. RANGE1 is modified by side effects, RANGE2 is not +list of numbers. RANGE1 is modified by side effects, RANGE2 is not modified." (if (or (null range1) (null range2)) range1 @@ -345,7 +345,7 @@ range-member-p (defun range-list-intersection (list ranges) "Return a list of numbers in LIST that are members of RANGES. -oLIST is a sorted list." +LIST is a sorted list." (setq ranges (range-normalize ranges)) (let (number result) (while (setq number (pop list)) commit 578e89267131d6c313740edbb70c0724c3d2cd15 Author: Eli Zaretskii Date: Sat Jan 28 16:59:17 2023 +0200 ; * doc/lispref/variables.texi (File Local Variables): Improve indexing. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 39d0906f6c4..5584cbce9a6 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2023,6 +2023,7 @@ File Local Variables @end defvar @cindex safe local variable +@cindex @code{safe-local-variable}, property of variable You can specify safe values for a variable with a @code{safe-local-variable} property. The property has to be a function of one argument; any value is safe if the function returns commit bc5ee2b7bf04d378e94b5c5b01d77e2a8c1d71fe Author: Eli Zaretskii Date: Sat Jan 28 16:52:44 2023 +0200 ; * src/comp.c: Remove Local Variables section to avoid warnings. diff --git a/src/comp.c b/src/comp.c index bd7ecfffc23..10cf7962ba1 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5912,6 +5912,3 @@ syms_of_comp (void) defsubr (&Snative_comp_available_p); } -/* Local Variables: */ -/* c-file-offsets: ((arglist-intro . +)) */ -/* End: */ commit 4de1171d143f0fa75c777f1a9050ae537d7732e5 Author: Eli Zaretskii Date: Sat Jan 28 15:42:57 2023 +0200 ; * lisp/progmodes/go-ts-mode.el (treesit-node-end): Avoid warning. diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 93a3bcc594b..7dafe9b2e3d 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -35,6 +35,7 @@ (declare-function treesit-node-child "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") (declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-end "treesit.c") (declare-function treesit-node-type "treesit.c") (declare-function treesit-search-subtree "treesit.c") commit 362678d90e10d0e60642cb42594f9e15e39a3a0b Author: Brian Leung Date: Thu Jan 26 17:36:42 2023 -0800 python.el: Use correct regexp when enabling python-ts-mode * lisp/progmodes/python.el: Use "python[0-9.]*" regexp for 'interpreter-mode-alist', and not 'auto-mode-alist'. (Bug#61090) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index a869cdc5fdb..df0d1c96965 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -6715,8 +6715,8 @@ python-ts-mode (when python-indent-guess-indent-offset (python-indent-guess-indent-offset)) - (add-to-list 'auto-mode-alist - '("\\.py[iw]?\\'\\|python[0-9.]*" . python-ts-mode)))) + (add-to-list 'auto-mode-alist '("\\.py[iw]?\\'" . python-ts-mode)) + (add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode)))) ;;; Completion predicates for M-x ;; Commands that only make sense when editing Python code commit 0820a81ec7a1dcd421b3eec345a38d8405ee00a0 Author: Michael Albinus Date: Sat Jan 28 10:26:44 2023 +0100 Tramp cleanup from recent test campaign * lisp/net/tramp.el (tramp-barf-if-file-missing): Fix docstring. (tramp-handle-file-directory-p): Don't suppress errors. (tramp-handle-shell-command): * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): Make insertion of a stderr file more robust. * lisp/net/tramp-archive.el (tramp-archive-handle-directory-files): Use `tramp-barf-if-file-missing'. * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-name-all-completions): Protect against errors from `file-directory-p'. * lisp/net/tramp.el (tramp-wrong-passwd-regexp): * lisp/net/tramp-adb.el (tramp-adb-prompt): * lisp/net/tramp-sh.el (tramp-sh-inotifywait-process-filter): * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): Unify regexps. * test/lisp/net/tramp-tests.el (tramp-test48-auto-load) (tramp-test48-delay-load): Unify regexps. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 10f33e5f929..38fd8a4e258 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -55,7 +55,7 @@ tramp-adb-connect-if-not-connected (defconst tramp-adb-method "adb" "When this method name is used, forward all calls to Android Debug Bridge.") -(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\n\r"))) (any "#$") blank) +(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\r\n"))) (any "#$") blank) "Regexp used as prompt in almquist shell." :type 'regexp :version "28.1" @@ -1005,17 +1005,19 @@ tramp-adb-handle-make-process ;; file will exist until the process is ;; deleted. (when (bufferp stderr) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit)) + (ignore-errors + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit))) ;; Delete tmpstderr file. (add-function :after (process-sentinel p) (lambda (_proc _msg) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit nil nil 'replace)) - (delete-file remote-tmpstderr)))) + (ignore-errors + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit nil nil 'replace)) + (delete-file remote-tmpstderr))))) ;; Return process. p)))) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 7c1f578d085..97adb36c4af 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -611,23 +611,22 @@ tramp-archive-handle-directory-file-name (defun tramp-archive-handle-directory-files (directory &optional full match nosort count) "Like `directory-files' for Tramp files." - (unless (file-exists-p directory) - (tramp-error (tramp-dissect-file-name directory) 'file-missing directory)) - (when (file-directory-p directory) - (setq directory (file-name-as-directory (expand-file-name directory))) - (let ((temp (nreverse (file-name-all-completions "" directory))) - result item) - - (while temp - (setq item (directory-file-name (pop temp))) - (when (or (null match) (string-match-p match item)) - (push (if full (concat directory item) item) - result))) - (unless nosort - (setq result (sort result #'string<))) - (when (and (natnump count) (> count 0)) - (setq result (tramp-compat-ntake count result))) - result))) + (tramp-barf-if-file-missing (tramp-dissect-file-name directory) directory + (when (file-directory-p directory) + (setq directory (file-name-as-directory (expand-file-name directory))) + (let ((temp (nreverse (file-name-all-completions "" directory))) + result item) + + (while temp + (setq item (directory-file-name (pop temp))) + (when (or (null match) (string-match-p match item)) + (push (if full (concat directory item) item) + result))) + (unless nosort + (setq result (sort result #'string<))) + (when (and (natnump count) (> count 0)) + (setq result (tramp-compat-ntake count result))) + result)))) (defun tramp-archive-handle-dired-uncache (dir) "Like `dired-uncache' for file archives." diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 25bc59eb4ff..48d91bd733e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3877,7 +3877,7 @@ tramp-sh-inotifywait-process-filter "Read output from \"inotifywait\" and add corresponding `file-notify' events." (let ((events (process-get proc 'events))) (tramp-message proc 6 "%S\n%s" proc string) - (dolist (line (split-string string "[\n\r]+" 'omit)) + (dolist (line (split-string string (rx (+ (any "\r\n"))) 'omit)) ;; Check, whether there is a problem. (unless (string-match (rx bol (+ (not blank)) (+ blank) (group (+ (not blank))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index a9cec17f536..b2272f804e0 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1878,7 +1878,7 @@ tramp-smb-maybe-open-connection (setq tramp-smb-version (shell-command-to-string command)) (tramp-message vec 6 command) (tramp-message vec 6 "\n%s" tramp-smb-version) - (if (string-match (rx (+ (any " \t\n\r")) eos) tramp-smb-version) + (if (string-match (rx (+ (any " \t\r\n")) eos) tramp-smb-version) (setq tramp-smb-version (replace-match "" nil nil tramp-smb-version)))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 486a22a60e1..1f646253579 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -477,7 +477,7 @@ tramp-sudoedit-handle-file-name-all-completions "" (file-name-unquote localname))) (mapcar (lambda (f) - (if (file-directory-p (expand-file-name f directory)) + (if (ignore-errors (file-directory-p (expand-file-name f directory))) (file-name-as-directory f) f)) (delq diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f38e570700e..50e1e2479d5 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -82,6 +82,7 @@ tramp (progn (defvar tramp--startup-hook nil "Forms to be executed at the end of tramp.el.") + (put 'tramp--startup-hook 'tramp-suppress-trace t) (defmacro tramp--with-startup (&rest body) @@ -657,14 +658,13 @@ tramp-password-prompt-regexp (defcustom tramp-wrong-passwd-regexp (rx bol (* nonl) (| "Permission denied" - (: "Login " (| "Incorrect" "incorrect")) - "Connection refused" - "Connection closed" "Timeout, server not responding." "Sorry, try again." "Name or service not known" "Host key verification failed." "No supported authentication methods left to try!" + (: "Login " (| "Incorrect" "incorrect")) + (: "Connection " (| "refused" "closed")) (: "Received signal " (+ digit))) (* nonl)) "Regexp matching a `login failed' message. @@ -787,6 +787,7 @@ tramp-temp-buffer-name (defvar tramp-temp-buffer-file-name nil "File name of a persistent local temporary file. Useful for \"rsync\" like methods.") + (make-variable-buffer-local 'tramp-temp-buffer-file-name) (put 'tramp-temp-buffer-file-name 'permanent-local t) @@ -1404,6 +1405,7 @@ tramp-password-save-function "Password save function. Will be called once the password has been verified by successful authentication.") + (put 'tramp-password-save-function 'tramp-suppress-trace t) (defvar tramp-password-prompt-not-unique nil @@ -2299,12 +2301,12 @@ tramp-with-demoted-errors (progn ,@body) (error (tramp-message ,vec-or-proc 3 ,format ,err) nil)))) -;; This macro shall optimize the cases where an `file-exists-p' call -;; is invoked first. Often, the file exists, so the remote command is +;; This macro shall optimize the cases where a `file-exists-p' call is +;; invoked first. Often, the file exists, so the remote command is ;; superfluous. (defmacro tramp-barf-if-file-missing (vec filename &rest body) "Execute BODY and return the result. -In case if an error, raise a `file-missing' error if FILENAME +In case of an error, raise a `file-missing' error if FILENAME does not exist, otherwise propagate the error." (declare (indent 2) (debug (symbolp form body))) (let ((err (make-symbol "err"))) @@ -3935,9 +3937,10 @@ tramp-handle-file-accessible-directory-p (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." ;; `file-truename' could raise an error, for example due to a cyclic - ;; symlink. - (ignore-errors - (eq (file-attribute-type (file-attributes (file-truename filename))) t))) + ;; symlink. We don't protect this despite it, because other errors + ;; might be worth to be visible, for example impossibility to mount + ;; in tramp-gvfs.el. + (eq (file-attribute-type (file-attributes (file-truename filename))) t)) (defun tramp-handle-file-equal-p (filename1 filename2) "Like `file-equalp-p' for Tramp files." @@ -5152,17 +5155,19 @@ tramp-handle-shell-command (add-function :after (process-sentinel p) (lambda (_proc _string) - (with-current-buffer error-buffer - (insert-file-contents-literally - error-file nil nil nil 'replace)) - (delete-file error-file)))) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally + error-file nil nil nil 'replace)) + (delete-file error-file))))) (display-buffer output-buffer '(nil (allow-no-window . t))))) ;; Insert error messages if they were separated. (when (and error-file (not (process-live-p p))) - (with-current-buffer error-buffer - (insert-file-contents-literally error-file)) - (delete-file error-file)))) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally error-file)) + (delete-file error-file))))) ;; Synchronous case. (prog1 @@ -5170,9 +5175,10 @@ tramp-handle-shell-command (process-file-shell-command command nil buffer) ;; Insert error messages if they were separated. (when error-file - (with-current-buffer error-buffer - (insert-file-contents-literally error-file)) - (delete-file error-file)) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally error-file)) + (delete-file error-file))) (if current-buffer-p ;; This is like exchange-point-and-mark, but doesn't ;; activate the mark. It is cleaner to avoid activation, diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 59e160c9d71..338482d2b61 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -7488,7 +7488,7 @@ tramp-test48-auto-load ert-remote-temporary-file-directory))) (should (string-match-p - (rx "Tramp loaded: t" (+ (any "\n\r"))) + (rx "Tramp loaded: t" (+ (any "\r\n"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7516,9 +7516,9 @@ tramp-test48-delay-load (should (string-match-p (rx - "Tramp loaded: nil" (+ (any "\n\r")) - "Tramp loaded: nil" (+ (any "\n\r")) - "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r"))) + "Tramp loaded: nil" (+ (any "\r\n")) + "Tramp loaded: nil" (+ (any "\r\n")) + "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\r\n"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" commit 76bb46db9df660f753b4ca4e34da77ab60d2000a Author: Eli Zaretskii Date: Sat Jan 28 09:49:53 2023 +0200 ; * doc/emacs/frames.texi (Mouse References): Improve indexing. diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index 3ee6eb59dbb..ce631561be7 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -334,6 +334,7 @@ Mouse References activating it. Dragging the mouse over or onto a button has its usual behavior of setting the region, and does not activate the button. +@vindex mouse-1-click-follows-link You can change how @kbd{mouse-1} applies to buttons by customizing the variable @code{mouse-1-click-follows-link}. If the value is a positive integer, that determines how long you need to hold the mouse commit cd42244fca8785fb57c25c731afcf3227c2ad14b Merge: 5642bf0b972 128a999bfe7 Author: Stefan Kangas Date: Sat Jan 28 06:30:25 2023 +0100 Merge from origin/emacs-29 128a999bfe7 Make project-current not error out inside non-existent dirs 194bc97879d Improve documentation of 'shell-command-dont-erase-buffer' 00629c03964 Fix errors in fontification of JavaScript import-statemen... fd145499bbd Fix fontification TypeScript of import-statements (bug#61... 752c526585f ; Fix typos commit 5642bf0b9726ea299a670e7393695148f31c619b Author: Jim Porter Date: Thu Jan 26 13:11:15 2023 -0800 Make 'eshell-number-regexp' into a regular defvar This isn't a very useful thing to customize, since it needs to detect numbers that can successfully be parsed by 'string-to-number'. Changes to this variable would therefore likely requiring adjusting 'eshell-convert-to-number' as well. * lisp/eshell/esh-util.el (eshell-number-regexp): Make into a defvar and improve the regexp to support more numbers (including infinity and NaN). * test/lisp/eshell/esh-util-tests.el (esh-util-test/eshell-convert-to-number/floating-point) (esh-util-test/eshell-convert-to-number/floating-point-exponent) (esh-util-test/eshell-convert-to-number/non-numeric) (esh-util-test/eshell-convert-to-number/no-convert): New tests. diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 8b522449762..9549e7f1a10 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -94,13 +94,6 @@ eshell-convert-numeric-arguments argument matches `eshell-number-regexp'." :type 'boolean) -(defcustom eshell-number-regexp "-?\\([0-9]*\\.\\)?[0-9]+\\(e[-0-9.]+\\)?" - "Regular expression used to match numeric arguments. -If `eshell-convert-numeric-arguments' is non-nil, and an argument -matches this regexp, it will be converted to a Lisp number, using the -function `string-to-number'." - :type 'regexp) - (defcustom eshell-ange-ls-uids nil "List of user/host/id strings, used to determine remote ownership." :type '(repeat (cons :tag "Host for User/UID map" @@ -111,6 +104,19 @@ eshell-ange-ls-uids ;;; Internal Variables: +(defvar eshell-number-regexp + (rx (? "-") + (or (seq (+ digit) (? "." (* digit))) + (seq (* digit) "." (+ digit))) + ;; Optional exponent + (? (or "e" "E") + (or "+INF" "+NaN" + (seq (? (or "+" "-")) (+ digit))))) + "Regular expression used to match numeric arguments. +If `eshell-convert-numeric-arguments' is non-nil, and an argument +matches this regexp, it will be converted to a Lisp number, using the +function `string-to-number'.") + (defvar eshell-integer-regexp (rx (? "-") (+ digit)) "Regular expression used to match integer arguments.") diff --git a/test/lisp/eshell/esh-util-tests.el b/test/lisp/eshell/esh-util-tests.el index afaf1b77f2b..ed841e96c7e 100644 --- a/test/lisp/eshell/esh-util-tests.el +++ b/test/lisp/eshell/esh-util-tests.el @@ -54,4 +54,69 @@ esh-util-test/eshell-stringify/complex "Test that `eshell-stringify' correctly stringifies complex objects." (should (equal (eshell-stringify (list 'quote 'hello)) "'hello"))) +(ert-deftest esh-util-test/eshell-convert-to-number/integer () + "Test that `eshell-convert-to-number' correctly converts integers." + (should (equal (eshell-convert-to-number "123") 123)) + (should (equal (eshell-convert-to-number "-123") -123)) + ;; These are technially integers, since Emacs Lisp requires at least + ;; one digit after the "." to be a float: + (should (equal (eshell-convert-to-number "123.") 123)) + (should (equal (eshell-convert-to-number "-123.") -123))) + +(ert-deftest esh-util-test/eshell-convert-to-number/floating-point () + "Test that `eshell-convert-to-number' correctly converts floats." + (should (equal (eshell-convert-to-number "1.23") 1.23)) + (should (equal (eshell-convert-to-number "-1.23") -1.23)) + (should (equal (eshell-convert-to-number ".1") 0.1)) + (should (equal (eshell-convert-to-number "-.1") -0.1))) + +(ert-deftest esh-util-test/eshell-convert-to-number/floating-point-exponent () + "Test that `eshell-convert-to-number' correctly converts exponent notation." + ;; Positive exponent: + (dolist (exp '("e2" "e+2" "E2" "E+2")) + (should (equal (eshell-convert-to-number (concat "123" exp)) 12300.0)) + (should (equal (eshell-convert-to-number (concat "-123" exp)) -12300.0)) + (should (equal (eshell-convert-to-number (concat "1.23" exp)) 123.0)) + (should (equal (eshell-convert-to-number (concat "-1.23" exp)) -123.0)) + (should (equal (eshell-convert-to-number (concat "1." exp)) 100.0)) + (should (equal (eshell-convert-to-number (concat "-1." exp)) -100.0)) + (should (equal (eshell-convert-to-number (concat ".1" exp)) 10.0)) + (should (equal (eshell-convert-to-number (concat "-.1" exp)) -10.0))) + ;; Negative exponent: + (dolist (exp '("e-2" "E-2")) + (should (equal (eshell-convert-to-number (concat "123" exp)) 1.23)) + (should (equal (eshell-convert-to-number (concat "-123" exp)) -1.23)) + (should (equal (eshell-convert-to-number (concat "1.23" exp)) 0.0123)) + (should (equal (eshell-convert-to-number (concat "-1.23" exp)) -0.0123)) + (should (equal (eshell-convert-to-number (concat "1." exp)) 0.01)) + (should (equal (eshell-convert-to-number (concat "-1." exp)) -0.01)) + (should (equal (eshell-convert-to-number (concat ".1" exp)) 0.001)) + (should (equal (eshell-convert-to-number (concat "-.1" exp)) -0.001)))) + +(ert-deftest esh-util-test/eshell-convert-to-number/floating-point/infinite () + "Test that `eshell-convert-to-number' correctly converts infinite floats." + (should (equal (eshell-convert-to-number "1.0e+INF") 1.0e+INF)) + (should (equal (eshell-convert-to-number "2.e+INF") 1.0e+INF)) + (should (equal (eshell-convert-to-number "-1.0e+INF") -1.0e+INF)) + (should (equal (eshell-convert-to-number "-2.e+INF") -1.0e+INF))) + +(ert-deftest esh-util-test/eshell-convert-to-number/floating-point/nan () + "Test that `eshell-convert-to-number' correctly converts NaNs." + (should (equal (eshell-convert-to-number "1.0e+NaN") 1.0e+NaN)) + (should (equal (eshell-convert-to-number "2.e+NaN") 2.0e+NaN)) + (should (equal (eshell-convert-to-number "-1.0e+NaN") -1.0e+NaN)) + (should (equal (eshell-convert-to-number "-2.e+NaN") -2.0e+NaN))) + +(ert-deftest esh-util-test/eshell-convert-to-number/non-numeric () + "Test that `eshell-convert-to-number' does nothing to non-numeric values." + (should (equal (eshell-convert-to-number "foo") "foo")) + (should (equal (eshell-convert-to-number "") "")) + (should (equal (eshell-convert-to-number "123foo") "123foo"))) + +(ert-deftest esh-util-test/eshell-convert-to-number/no-convert () + "Test that `eshell-convert-to-number' does nothing when disabled." + (let ((eshell-convert-numeric-arguments nil)) + (should (equal (eshell-convert-to-number "123") "123")) + (should (equal (eshell-convert-to-number "1.23") "1.23")))) + ;;; esh-util-tests.el ends here commit dabe0b7d40778496ecb308f54999248ea286d89b Author: Jim Porter Date: Fri Jan 20 13:54:20 2023 -0800 Add support for negative indices and index ranges in Eshell * lisp/eshell/esh-util.el (eshell-integer-regexp): New defvar. * lisp/eshell/esh-var.el (eshell-parse-indices): Expand docstring. (eshell-parse-index): New function. (eshell-apply-indices): Use 'eshell-parse-index' to determine whether to treat the first index as a regexp. Simplify the implementation a bit. (eshell-index-range): New pcase macro... (eshell-index-value): ... use it, and restructure the implementation. * test/lisp/eshell/esh-var-tests.el (esh-var-test/interp-var-indices): New function... (esh-var-test/interp-var-indices/list) (esh-var-test/interp-var-indices/vector) (esh-var-test/interp-var-indices/ring) (esh-var-test/interp-var-indices/split): ... use it. (esh-var-test/interp-var-string-split-indices) (esh-var-test/interp-var-regexp-split-indices) (esh-var-test/interp-var-assoc): Expand tests to cover things that look like numbers or ranges, but aren't. * doc/misc/eshell.texi (Variables): Describe how to get all arguments of the last command. (Dollars Expansion): Explain negative indices and index ranges. (Bugs and ideas): Remove now-implemented ideas. * etc/NEWS: Announce this change. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 57a2020fdca..e51e2cf799b 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1059,7 +1059,9 @@ Variables This refers to the last argument of the last command. With a subscript, you can access any argument of the last command. For example, @samp{$_[1]} refers to the second argument of the last -command (excluding the command name itself). +command (excluding the command name itself). To get all arguments of +the last command, you can use an index range like @samp{$_[..]} +(@pxref{Dollars Expansion}). @vindex $$ @item $$ @@ -1370,11 +1372,24 @@ Dollars Expansion @item a sequence Expands to the element at the (zero-based) index @var{i} of the sequence (@pxref{Sequences Arrays Vectors, Sequences, , elisp, The -Emacs Lisp Reference Manual}). +Emacs Lisp Reference Manual}). If @var{i} is negative, @var{i} counts +from the end, so -1 refers to the last element of the sequence. + +If @var{i} is a range like @code{@var{start}..@var{end}}, this expands +to a subsequence from the indices @var{start} to @var{end}, where +@var{end} is excluded@footnote{This behavior is different from ranges +in Bash (where both the start and end are included in the range), but +matches the behavior of similar Emacs Lisp functions, like +@code{substring} (@pxref{Creating Strings, , , elisp, The Emacs Lisp +Reference Manual}).}. @var{start} and/or @var{end} can also be +omitted, which is equivalent to the start and/or end of the entire +list. For example, @samp{$@var{expr}[-2..]} expands to the last two +values of @var{expr}. @item a string Split the string at whitespace, and then expand to the @var{i}th -element of the resulting sequence. +element of the resulting sequence. As above, @var{i} can be a range +like @code{@var{start}..@var{end}}. @item an alist If @var{i} is a non-numeric value, expand to the value associated with @@ -2442,13 +2457,6 @@ Bugs and ideas This way, the user could change it to use rc syntax: @samp{>[2=1]}. -@item Allow @samp{$_[-1]}, which would indicate the last element of the array - -@item Make @samp{$x[*]} equal to listing out the full contents of @samp{x} - -Return them as a list, so that @samp{$_[*]} is all the arguments of the -last command. - @item Copy ANSI code handling from @file{term.el} into @file{em-term.el} Make it possible for the user to send char-by-char to the underlying diff --git a/etc/NEWS b/etc/NEWS index 5b8ab06086c..e0175bacfdf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -149,6 +149,13 @@ of arguments into a command, such as when defining aliases. For more information, see the "(eshell) Dollars Expansion" node in the Eshell manual. ++++ +*** Eshell now supports negative numbers and ranges for indices. +Now, you can retrieve the last element of a list with '$my-list[-1]' +or get a sublist of elements 2 through 4 with '$my-list[2..5]'. For +more information, see the "(eshell) Dollars Expansion" node in the +Eshell manual. + --- *** Eshell now uses 'field' properties in its output. In particular, this means that pressing the '' key moves the diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 544a8a74039..8b522449762 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -111,6 +111,9 @@ eshell-ange-ls-uids ;;; Internal Variables: +(defvar eshell-integer-regexp (rx (? "-") (+ digit)) + "Regular expression used to match integer arguments.") + (defvar eshell-group-names nil "A cache to hold the names of groups.") diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 83dd5cb50f5..60aab92b33e 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -587,6 +587,9 @@ eshell-glob-function (defun eshell-parse-indices () "Parse and return a list of index-lists. +This produces a series of Lisp forms to be processed by +`eshell-prepare-indices' and ultimately evaluated by +`eshell-do-eval'. For example, \"[0 1][2]\" becomes: ((\"0\" \"1\") (\"2\"))." @@ -605,6 +608,36 @@ eshell-parse-indices (goto-char (1+ end))))) (nreverse indices))) +(defun eshell-parse-index (index) + "Parse a single INDEX in string form. +If INDEX looks like a number, return that number. + +If INDEX looks like \"[BEGIN]..[END]\", where BEGIN and END look +like integers, return a cons cell of BEGIN and END as numbers; +BEGIN and/or END can be omitted here, in which case their value +in the cons is nil. + +Otherwise (including if INDEX is not a string), return +the original value of INDEX." + (save-match-data + (cond + ((and (stringp index) (get-text-property 0 'number index)) + (string-to-number index)) + ((and (stringp index) + (not (text-property-any 0 (length index) 'escaped t index)) + (string-match (rx string-start + (group-n 1 (? (regexp eshell-integer-regexp))) + ".." + (group-n 2 (? (regexp eshell-integer-regexp))) + string-end) + index)) + (let ((begin (match-string 1 index)) + (end (match-string 2 index))) + (cons (unless (string-empty-p begin) (string-to-number begin)) + (unless (string-empty-p end) (string-to-number end))))) + (t + index)))) + (defun eshell-eval-indices (indices) "Evaluate INDICES, a list of index-lists generated by `eshell-parse-indices'." (declare (obsolete eshell-prepare-indices "30.1")) @@ -716,56 +749,65 @@ eshell-apply-indices '/etc/passwd', the variable reference would look like: ${grep johnw /etc/passwd}[: 2]" - (while indices - (let ((refs (car indices))) - (when (stringp value) - (let (separator (index (caar indices))) - (when (and (stringp index) - (not (get-text-property 0 'number index))) - (setq separator index - refs (cdr refs))) - (setq value (split-string value separator)) - (unless quoted - (setq value (mapcar #'eshell-convert-to-number value))))) - (cond - ((< (length refs) 0) - (error "Invalid array variable index: %s" - (eshell-stringify refs))) - ((= (length refs) 1) - (setq value (eshell-index-value value (car refs)))) - (t - (let ((new-value (list t))) - (while refs - (nconc new-value - (list (eshell-index-value value - (car refs)))) - (setq refs (cdr refs))) - (setq value (cdr new-value)))))) - (setq indices (cdr indices))) - value) + (dolist (refs indices value) + ;; For string values, check if the first index looks like a + ;; regexp, and if so, use that to split the string. + (when (stringp value) + (let (separator (first (car refs))) + (when (stringp (eshell-parse-index first)) + (setq separator first + refs (cdr refs))) + (setq value (split-string value separator)) + (unless quoted + (setq value (mapcar #'eshell-convert-to-number value))))) + (cond + ((< (length refs) 0) + (error "Invalid array variable index: %s" + (eshell-stringify refs))) + ((= (length refs) 1) + (setq value (eshell-index-value value (car refs)))) + (t + (let (new-value) + (dolist (ref refs) + (push (eshell-index-value value ref) new-value)) + (setq value (nreverse new-value))))))) + +(pcase-defmacro eshell-index-range (start end) + "A pattern that matches an Eshell index range. +EXPVAL should be a cons cell, with each slot containing either an +integer or nil. If this matches, bind the values of the sltos to +START and END." + (list '\` (cons (list '\, `(and (or (pred integerp) (pred null)) ,start)) + (list '\, `(and (or (pred integerp) (pred null)) ,end))))) (defun eshell-index-value (value index) "Reference VALUE using the given INDEX." - (when (and (stringp index) (get-text-property 0 'number index)) - (setq index (string-to-number index))) - (if (integerp index) - (cond - ((ring-p value) - (if (> index (ring-length value)) - (error "Index exceeds length of ring") - (ring-ref value index))) - ((listp value) - (if (> index (length value)) - (error "Index exceeds length of list") - (nth index value))) - ((vectorp value) - (if (> index (length value)) - (error "Index exceeds length of vector") - (aref value index))) - (t - (error "Invalid data type for indexing"))) - ;; INDEX is some non-integer value, so treat VALUE as an alist. - (cdr (assoc index value)))) + (let ((parsed-index (eshell-parse-index index))) + (if (ring-p value) + (pcase parsed-index + ((pred integerp) + (ring-ref value parsed-index)) + ((eshell-index-range start end) + (let* ((len (ring-length value)) + (real-start (mod (or start 0) len)) + (real-end (mod (or end len) len))) + (when (and (eq real-end 0) + (not (eq end 0))) + (setq real-end len)) + (ring-convert-sequence-to-ring + (seq-subseq (ring-elements value) real-start real-end)))) + (_ + (error "Invalid index for ring: %s" index))) + (pcase parsed-index + ((pred integerp) + (when (< parsed-index 0) + (setq parsed-index (+ parsed-index (length value)))) + (seq-elt value parsed-index)) + ((eshell-index-range start end) + (seq-subseq value (or start 0) end)) + (_ + ;; INDEX is some non-integer value, so treat VALUE as an alist. + (cdr (assoc parsed-index value))))))) ;;;_* Variable name completion diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 12412d13640..6767d9289f9 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -72,52 +72,89 @@ esh-var-test/interp-list-var-concat (eshell-command-result-equal "echo a$'eshell-test-value'z" '("a1" 2 "3z")))) -(ert-deftest esh-var-test/interp-var-indices () - "Interpolate list variable with indices" - (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) +(defun esh-var-test/interp-var-indices (function &optional range-function) + "Test interpolation of an indexable value with indices. +FUNCTION is a function that takes a list of elements and returns +the object to test. + +RANGE-FUNCTION is a function that takes a list of elements and +returns the expected result of an index range for the object; if +nil, use FUNCTION instead." + (let ((eshell-test-value + (funcall function '("zero" "one" "two" "three" "four"))) + (range-function (or range-function function))) + ;; Positive indices (eshell-command-result-equal "echo $eshell-test-value[0]" "zero") (eshell-command-result-equal "echo $eshell-test-value[0 2]" '("zero" "two")) (eshell-command-result-equal "echo $eshell-test-value[0 2 4]" - '("zero" "two" "four")))) - -(ert-deftest esh-var-test/interp-var-indices-subcommand () - "Interpolate list variable with subcommand expansion for indices." - (skip-unless (executable-find "echo")) - (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) + '("zero" "two" "four")) + ;; Negative indices + (eshell-command-result-equal "echo $eshell-test-value[-1]" + "four") + (eshell-command-result-equal "echo $eshell-test-value[-1 -3]" + '("four" "two")) + ;; Index ranges (eshell-command-result-equal - "echo $eshell-test-value[${*echo 0}]" - "zero") + "echo $eshell-test-value[1..4]" + (funcall range-function '("one" "two" "three"))) (eshell-command-result-equal - "echo $eshell-test-value[${*echo 0} ${*echo 2}]" - '("zero" "two")))) + "echo $eshell-test-value[..2]" + (funcall range-function '("zero" "one"))) + (eshell-command-result-equal + "echo $eshell-test-value[-2..]" + (funcall range-function '("three" "four"))) + (eshell-command-result-equal + "echo $eshell-test-value[..]" + (funcall range-function '("zero" "one" "two" "three" "four"))) + (eshell-command-result-equal + "echo $eshell-test-value[1..4 -2..]" + (list (funcall range-function '("one" "two" "three")) + (funcall range-function '("three" "four")))))) + +(ert-deftest esh-var-test/interp-var-indices/list () + "Interpolate list variable with indices." + (esh-var-test/interp-var-indices #'identity)) + +(ert-deftest esh-var-test/interp-var-indices/vector () + "Interpolate vector variable with indices." + (esh-var-test/interp-var-indices #'vconcat)) -(ert-deftest esh-var-test/interp-var-split-indices () +(ert-deftest esh-var-test/interp-var-indices/ring () + "Interpolate ring variable with indices." + (esh-var-test/interp-var-indices #'ring-convert-sequence-to-ring)) + +(ert-deftest esh-var-test/interp-var-indices/split () "Interpolate string variable with indices." - (let ((eshell-test-value "zero one two three four")) - (eshell-command-result-equal "echo $eshell-test-value[0]" - "zero") - (eshell-command-result-equal "echo $eshell-test-value[0 2]" - '("zero" "two")) - (eshell-command-result-equal "echo $eshell-test-value[0 2 4]" - '("zero" "two" "four")))) + (esh-var-test/interp-var-indices + (lambda (values) (string-join values " ")) + #'identity)) (ert-deftest esh-var-test/interp-var-string-split-indices () "Interpolate string variable with string splitter and indices." + ;; Test using punctuation as a delimiter. (let ((eshell-test-value "zero:one:two:three:four")) (eshell-command-result-equal "echo $eshell-test-value[: 0]" "zero") (eshell-command-result-equal "echo $eshell-test-value[: 0 2]" '("zero" "two"))) + ;; Test using a letter as a delimiter. (let ((eshell-test-value "zeroXoneXtwoXthreeXfour")) (eshell-command-result-equal "echo $eshell-test-value[X 0]" "zero") (eshell-command-result-equal "echo $eshell-test-value[X 0 2]" + '("zero" "two"))) + ;; Test using a number as a delimiter. + (let ((eshell-test-value "zero0one0two0three0four")) + (eshell-command-result-equal "echo $eshell-test-value[\"0\" 0]" + "zero") + (eshell-command-result-equal "echo $eshell-test-value[\"0\" 0 2]" '("zero" "two")))) (ert-deftest esh-var-test/interp-var-regexp-split-indices () "Interpolate string variable with regexp splitter and indices." + ;; Test using a regexp as a delimiter. (let ((eshell-test-value "zero:one!two:three!four")) (eshell-command-result-equal "echo $eshell-test-value['[:!]' 0]" "zero") @@ -126,15 +163,34 @@ esh-var-test/interp-var-regexp-split-indices (eshell-command-result-equal "echo $eshell-test-value[\"[:!]\" 0]" "zero") (eshell-command-result-equal "echo $eshell-test-value[\"[:!]\" 0 2]" + '("zero" "two"))) + ;; Test using a regexp that looks like range syntax as a delimiter. + (let ((eshell-test-value "zero0..0one0..0two0..0three0..0four")) + (eshell-command-result-equal "echo $eshell-test-value[\"0..0\" 0]" + "zero") + (eshell-command-result-equal "echo $eshell-test-value[\"0..0\" 0 2]" '("zero" "two")))) (ert-deftest esh-var-test/interp-var-assoc () "Interpolate alist variable with index." - (let ((eshell-test-value '(("foo" . 1) (bar . 2)))) + (let ((eshell-test-value '(("foo" . 1) (bar . 2) ("3" . "three")))) (eshell-command-result-equal "echo $eshell-test-value[foo]" 1) (eshell-command-result-equal "echo $eshell-test-value[#'bar]" - 2))) + 2) + (eshell-command-result-equal "echo $eshell-test-value[\"3\"]" + "three"))) + +(ert-deftest esh-var-test/interp-var-indices-subcommand () + "Interpolate list variable with subcommand expansion for indices." + (skip-unless (executable-find "echo")) + (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) + (eshell-command-result-equal + "echo $eshell-test-value[${*echo 0}]" + "zero") + (eshell-command-result-equal + "echo $eshell-test-value[${*echo 0} ${*echo 2}]" + '("zero" "two")))) (ert-deftest esh-var-test/interp-var-length-list () "Interpolate length of list variable." commit 128a999bfe7ebafd78e2b463586156fc6972181d Author: Dmitry Gutov Date: Sat Jan 28 03:17:39 2023 +0200 Make project-current not error out inside non-existent dirs * lisp/progmodes/project.el (project-try-vc): Use condition-case to catch 'file-missing' (bug#61107). * test/lisp/progmodes/project-tests.el (project-vc-nonexistent-directory-no-error): New test. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 59270070484..2343adf4698 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,7 +1,7 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2023 Free Software Foundation, Inc. -;; Version: 0.9.5 +;; Version: 0.9.6 ;; Package-Requires: ((emacs "26.1") (xref "1.4.0")) ;; This is a GNU ELPA :core package. Avoid using functionality that @@ -530,7 +530,10 @@ project-try-vc dir (lambda (d) ;; Maybe limit count to 100 when we can drop Emacs < 28. - (setq last-matches (directory-files d nil marker-re t))))) + (setq last-matches + (condition-case nil + (directory-files d nil marker-re t) + (file-missing nil)))))) (backend (cl-find-if (lambda (b) diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index aea0666629d..5a206b67db1 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -152,4 +152,14 @@ project-vc-supports-project-in-different-dir (should (equal '(".dir-locals.el" "foo") (mapcar #'file-name-nondirectory (project-files project)))))) +(ert-deftest project-vc-nonexistent-directory-no-error () + "Check that is doesn't error out when the current dir does not exist." + (skip-unless (eq (vc-responsible-backend default-directory) 'Git)) + (let* ((dir (expand-file-name "foo-456/bar/" (ert-resource-directory))) + (_ (vc-file-clearprops dir)) + (project-vc-extra-root-markers '(".dir-locals.el")) + (project (project-current nil dir))) + (should-not (null project)) + (should (string-match-p "/test/lisp/progmodes/project-resources/\\'" (project-root project))))) + ;;; project-tests.el ends here commit 194bc97879d2b57545eda17dbeb0b2e46b215617 Author: Eli Zaretskii Date: Fri Jan 27 19:01:49 2023 +0200 Improve documentation of 'shell-command-dont-erase-buffer' * doc/emacs/misc.texi (Single Shell): * lisp/simple.el (shell-command, shell-command-on-region): Document that non-nil value of 'shell-command-dont-erase-buffer' affects what is displayed in the echo area after the command. (Bug#61100) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index e2764c34482..80a1b3f55ed 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -751,6 +751,8 @@ Single Shell output is long). The variables @code{resize-mini-windows} and @code{max-mini-window-height} (@pxref{Minibuffer Edit}) control when Emacs should consider the output to be too long for the echo area. +Note that customizing @code{shell-command-dont-erase-buffer}, +described below, can affect what is displayed in the echo area. For instance, one way to decompress a file named @file{foo.gz} is to type @kbd{M-! gunzip foo.gz @key{RET}}. That shell command normally @@ -867,6 +869,10 @@ Single Shell shell-command output. @end table +Note that if this option is non-@code{nil}, the output shown in the +echo area could be from more than just the last command, since the +echo area just displays a portion of the output buffer. + In case the output buffer is not the current buffer, shell command output is appended at the end of this buffer. diff --git a/lisp/simple.el b/lisp/simple.el index aaad3217982..861fe193fb8 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4547,6 +4547,9 @@ shell-command \(determined by the variable `max-mini-window-height' if `resize-mini-windows' is non-nil), it is shown there. Otherwise, the buffer containing the output is displayed. +Note that if `shell-command-dont-erase-buffer' is non-nil, +the echo area could display more than just the output of the +last command. If there is output and an error, and you did not specify \"insert it in the current buffer\", a message about the error goes at the end @@ -4829,6 +4832,9 @@ shell-command-on-region `resize-mini-windows' is non-nil), it is shown there. Otherwise it is displayed in the buffer named by `shell-command-buffer-name'. The output is available in that buffer in both cases. +Note that if `shell-command-dont-erase-buffer' is non-nil, +the echo area could display more than just the output of the +last command. If there is output and an error, a message about the error appears at the end of the output. commit 4287d56bad5201cf0946526bb0e27c17426bd969 Author: Mattias Engdegård Date: Fri Jan 27 17:21:28 2023 +0100 Repair hideif regexp problems * lisp/progmodes/hideif.el (hif-white-regexp, hif-tokenize): Avoid superlinear backtracking behaviour by rewriting regexps to avoid nested repetitions and make positive progress each time. Use lazy matching of the innards of /*...*/ comments to avoid matching too much. diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 4405ce0fe04..836db83c2f3 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -555,8 +555,8 @@ hif-macro-expr-prefix-regexp (defconst hif-line-concat "\\\\[ \t]*[\n\r]") ;; If `hif-white-regexp' is modified, `hif-tokenize' might need to be modified ;; accordingly. -(defconst hif-white-regexp (concat "\\(?:\\(?:[ \t]\\|/\\*.*\\*/\\)*" - "\\(?:" hif-line-concat "\\)?\\)*")) +(defconst hif-white-regexp (concat "\\(?:[ \t]\\|/\\*.*?\\*/" + "\\|\\(?:" hif-line-concat "\\)\\)*")) (defconst hif-define-regexp (concat hif-cpp-prefix "\\(define\\|undef\\)")) (defconst hif-id-regexp (concat "[[:alpha:]_][[:alnum:]_]*")) (defconst hif-etc-regexp "\\.\\.\\.") @@ -946,8 +946,8 @@ hif-tokenize (let ((token-list nil) ;; Similar to `hif-white-regexp' but keep the spaces if there are (white-regexp (concat "\\(?:" - "\\(?:\\([ \t]+\\)\\|\\(?:/\\*.*\\*/\\)?\\)*" - "\\(?:" hif-line-concat "\\)?" + "\\([ \t]+\\)\\|/\\*.*?\\*/" + "\\|\\(?:" hif-line-concat "\\)" "\\)*")) token) (setq hif-simple-token-only t) commit 627ac228b2ecdf179f36ea41fd0254c091744e4b Author: Mattias Engdegård Date: Tue Jan 17 17:57:25 2023 +0100 Don't inhibit LAP-level DCE when switch ops are present * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Allow removal of unreachable basic blocks in the LAP peephole optimiser even when switch ops are present. The origins of this apparently unnecessary condition are unclear. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 039cebedb44..b1a46d520e6 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -2227,18 +2227,12 @@ byte-optimize-lapcode ;; ;; goto ... --> goto ;; return ... --> return - ;; (unless a jump-table is being used, where deleting may affect - ;; other valid case bodies) ;; ((and (memq (car lap0) '(byte-goto byte-return)) - (not (memq (car lap1) '(TAG nil))) - ;; FIXME: Instead of deferring simply when jump-tables are - ;; being used, keep a list of tags used for switch tags and - ;; use them instead (see `byte-compile-inline-lapcode'). - (not byte-compile-jump-tables)) + (not (memq (car lap1) '(TAG nil)))) (setq tmp rest) (let ((i 0) - (opt-p (memq byte-optimize-log '(t lap))) + (opt-p (memq byte-optimize-log '(t byte))) str deleted) (while (and (setq tmp (cdr tmp)) (not (eq 'TAG (car (car tmp))))) commit 00629c039643a0471143205c70e8a078fc3a9d86 Author: Jostein Kjønigsen Date: Thu Jan 26 20:32:18 2023 +0100 Fix errors in fontification of JavaScript import-statements (bug#61083) Currently js-ts-mode handles imports with aliases incorrectly. To be consistent with how we otherwise do things, we should only highlight the variable which is new and/or introduced, in this case "someAlias". Attached is a patch which fontifies import-declarations somewhat more correctly. The following cases have been tested and all fontify properly: import gnu from "fsf"; // highlights gnu import { gnu2 } from "fsf2"; // highlights gnu2 import { gnu as gnu3 } from "fsf3"; // highlights gnu3 import * as gnu4 from "fsf4"; // highlights gnu4 * lisp/progmodes/js.el (js--treesit-font-lock-settings): Add new import_clause rules that adhere to the comment above. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index b5c912b8b0d..05d69c314bb 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3546,9 +3546,18 @@ js--treesit-font-lock-settings (identifier) @font-lock-function-name-face) value: (array (number) (function))) + ;; full module imports (import_clause (identifier) @font-lock-variable-name-face) - (import_clause (named_imports (import_specifier (identifier)) - @font-lock-variable-name-face))) + ;; named imports with aliasing + (import_clause (named_imports (import_specifier + alias: (identifier) @font-lock-variable-name-face))) + ;; named imports without aliasing + (import_clause (named_imports (import_specifier + !alias + name: (identifier) @font-lock-variable-name-face))) + + ;; full namespace import (* as alias) + (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) :language 'javascript :feature 'property commit fd145499bbd7650d915c6e5e1ac95fd89738a6b9 Author: Jostein Kjønigsen Date: Thu Jan 26 19:54:27 2023 +0100 Fix fontification TypeScript of import-statements (bug#61081) Currently typescript-ts-mode and tsx-ts-mode handles imports with aliases incorrectly. Consider the following case: import { someFunc as someAlias } from "module"; In this case the entire import ("someFunc as someAlias") will be highlighted as a variable name. "as" is also highlighted as a variable, rather than a reserved keyword. To be consistent with how we otherwise do things, we should only highlight the variable which is new and/or introduced, in this case "someAlias". Attached is a patch which fontifies import-declarations somewhat more correctly. The following cases have been tested and all fontify properly: import gnu from "fsf"; // highlights gnu import { gnu2 } from "fsf2"; // highlights gnu2 import { gnu as gnu3 } from "fsf3"; // highlights gnu3 import * as gnu4 from "fsf4"; // highlights gnu4 * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode--font-lock-settings): Tweak import_clause rules to adhere to the comment above. diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 25cc327d05f..561b90deedd 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -196,8 +196,18 @@ typescript-ts-mode--font-lock-settings (catch_clause parameter: (identifier) @font-lock-variable-name-face) + ;; full module imports (import_clause (identifier) @font-lock-variable-name-face) - (import_clause (named_imports (import_specifier (identifier)) @font-lock-variable-name-face))) + ;; named imports with aliasing + (import_clause (named_imports (import_specifier + alias: (identifier) @font-lock-variable-name-face))) + ;; named imports without aliasing + (import_clause (named_imports (import_specifier + !alias + name: (identifier) @font-lock-variable-name-face))) + + ;; full namespace import (* as alias) + (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) :language language :feature 'identifier commit 752c526585fe3f10e064b9ddaca6ae6cdeaa0004 Author: Stefan Kangas Date: Mon Jan 23 02:27:15 2023 +0100 ; Fix typos diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 04b683a8a24..1916d50af03 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4873,7 +4873,7 @@ tramp-handle-make-process :command (append `(,login-program) login-args command) :coding coding :noquery noquery :connection-type connection-type :sentinel sentinel :stderr stderr)) - ;; Set filter. Prior Emacs 29.1, it doesn't work reliable + ;; Set filter. Prior Emacs 29.1, it doesn't work reliably ;; to provide it as `make-process' argument when filter is ;; t. See Bug#51177. (when filter diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1 index eb126df6334..a4eae350d98 100644 --- a/lisp/org/ChangeLog.1 +++ b/lisp/org/ChangeLog.1 @@ -30500,7 +30500,7 @@ * org.el (org-make-tags-matcher): Never use IDO for completing the tags matcher match string. - (org-completing-read): Also remove the special biding for "?". + (org-completing-read): Also remove the special binding for "?". * org-attach.el (org-attach-allow-inheritance): New option. (org-attach-inherited): New variable. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 788c911f86b..eb2be9b792b 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -319,7 +319,7 @@ c-ts-mode--statement-offset (save-excursion (goto-char (treesit-node-start node)) ;; Add an extra level if the opening bracket is on its own - ;; line, except (1) it's at top-level, or (2) it's immedate + ;; line, except (1) it's at top-level, or (2) it's immediate ;; parent is another block. (cond ((bolp) nil) ; Case (1). ((let ((parent-type (treesit-node-type commit 18fbcce9757165689df109db8f7b528a57335ae2 Merge: 23fe6c4f68e 5859413df23 Author: Stefan Kangas Date: Fri Jan 27 11:30:38 2023 +0100 Merge from origin/emacs-29 5859413df23 ; * lisp/progmodes/cc-engine.el: Delete trailing whitespace. f72a394716f Work around package.el transitive dependency bug commit 23fe6c4f68e855bea6a32061c7094e9004d1b30f Merge: 12e419ad115 3766a666b55 Author: Stefan Kangas Date: Fri Jan 27 11:30:38 2023 +0100 ; Merge from origin/emacs-29 The following commit was skipped: 3766a666b55 ; Fix issues with processing out-of-order IRC messages commit 12e419ad1157973ceae8b610e3ddf2e76cbeb488 Merge: e8db522e437 f8c95d1a768 Author: Stefan Kangas Date: Fri Jan 27 11:30:38 2023 +0100 Merge from origin/emacs-29 f8c95d1a768 Fix xt-mouse on terminals that report UTF-8 encoded coord... 4bf7cb71edc Fix go-ts-mode indentation and set indent offset to 8 (Bu... ff9498624fc ; * src/insdel.c (insert_from_buffer): Fix assertions. 41f497c8bee Fix doc strings of window-splitting commands cdf74254ffa Fix indentation for c-ts-mode (bug#61026) 4bd06ce2a9f Fix call to treesit_record_change in insdel.c 00675aa724a Add support for building tree-sitter modules with MinGW af28191b04f * lisp/net/tramp.el (tramp-wrong-passwd-regexp): Fix regexp. 42e02480c2b * doc/emacs/text.texi (Outline Minor Mode): New node spli... 37c1c924666 ; * etc/NEWS: Minor reordering. cfb180329b5 ruby-ts-mode: Don't reindent when "class" or "def" is und... abb3becb9fb treesit-install-language-grammar: Provide default repo url c6613403e5c Fix Dired face for directory symlinks 37454de0c8f Pacify --without-x unused function warning 9a21cb10751 ; * etc/NEWS: Fix typos. f30a4f51fef Announce outline.el keymaps 8198803f660 ; Don't mention in the Gnus manual user options that were... 8a1498c01f7 Fix fontification of function-valued variables (bug#61053) cfe26f31893 Add new java indent rules 987e53f3e2d ; * doc/misc/erc.texi: Improve Local Modules section. 3846e79c93b ; Fix filename mismatches in prop lines of ERC tests ecf500b5e34 Handle relative file names in vc-resynch-window and vc-re... 695e9f71c3f Use named keymaps for outline buttons e31a5623965 * lisp/vc/vc-bzr.el (vc-bzr--pushpull): Return buffer's p... deee3a92623 ; Fix last change in etc/NEWS bc78285e686 ; * etc/NEWS: Fix typos. c15c0f7f018 CC Mode: Change the default value of objc-font-lock-extra... 7f438ff543b Don't try to make a pipe process for remote processes in ... cb9628373a8 * lisp/startup.el (command-line): Fix warning message. (... e6c5f32e77d * lisp/find-dired.el (find-dired): Fix bug where M-p skip... # Conflicts: # etc/NEWS commit e8db522e43701740fecc37a3f6fa7d6fb9f25ee8 Author: Stefan Kangas Date: Fri Jan 27 11:29:47 2023 +0100 ; * lisp/progmodes/cc-engine.el: Delete trailing whitespace. This was holding up the automatic merges due to commit hooks. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 2ec83240360..f1e93c1c23c 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -7357,7 +7357,7 @@ c-ml-string-opener-around-point (cons (match-beginning 1) (cons (match-end 1) (match-beginning 2)))) (goto-char here)))) - + (defun c-ml-string-opener-intersects-region (&optional start finish) ;; If any part of the region [START FINISH] is inside an ml-string opener, ;; return a dotted list of the start, end and double-quote position of that @@ -9232,7 +9232,7 @@ c-forward-type ;; known type match only is a prefix of another name. (setq id-end (match-end 1)) - + (when (and c-record-type-identifiers (or c-promote-possible-types (eq res t))) (c-record-type-id (cons (match-beginning 1) (match-end 1)))) @@ -9375,7 +9375,7 @@ c-forward-type (c-forward-syntactic-ws) (setq subres (c-forward-type nil t)) (setq pos (point)))) - + (progn ;; If either operand certainly is a type then both are, but we ;; don't let the existence of the operator itself promote two commit 5859413df235e87a89257e991cc6c6fd220b2b9c Author: Stefan Kangas Date: Fri Jan 27 11:25:08 2023 +0100 ; * lisp/progmodes/cc-engine.el: Delete trailing whitespace. This was holding up the automatic merges due to commit hooks. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index ebcb20f0f8c..2631c24f8db 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -7357,7 +7357,7 @@ c-ml-string-opener-around-point (cons (match-beginning 1) (cons (match-end 1) (match-beginning 2)))) (goto-char here)))) - + (defun c-ml-string-opener-intersects-region (&optional start finish) ;; If any part of the region [START FINISH] is inside an ml-string opener, ;; return a dotted list of the start, end and double-quote position of that commit 854a2901f7c895b59f005fd1042c6bb7b19ac19a Author: Andrea Corallo Date: Fri Jan 27 10:36:47 2023 +0100 * lisp/emacs-lisp/comp.el (comp-trampoline-compile): Improve readability diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index acabc31fc33..4c423be06c4 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3805,22 +3805,22 @@ comp-trampoline-compile form nil ;; If we've disabled nativecomp, don't write the trampolines to ;; the eln cache (but create them). - (and (not inhibit-automatic-native-compilation) - (cl-loop - for dir in (if native-compile-target-directory - (list (expand-file-name comp-native-version-dir - native-compile-target-directory)) - (comp-eln-load-path-eff)) - for f = (expand-file-name - (comp-trampoline-filename subr-name) - dir) - unless (file-exists-p dir) - do (ignore-errors - (make-directory dir t) - (cl-return f)) - when (file-writable-p f) - do (cl-return f) - finally (error "Cannot find suitable directory for output in \ + (unless inhibit-automatic-native-compilation + (cl-loop + for dir in (if native-compile-target-directory + (list (expand-file-name comp-native-version-dir + native-compile-target-directory)) + (comp-eln-load-path-eff)) + for f = (expand-file-name + (comp-trampoline-filename subr-name) + dir) + unless (file-exists-p dir) + do (ignore-errors + (make-directory dir t) + (cl-return f)) + when (file-writable-p f) + do (cl-return f) + finally (error "Cannot find suitable directory for output in \ `native-comp-eln-load-path'")))))) commit f72a394716f4373dbbdc79ad0816da90bdb032a1 Author: Basil L. Contovounesios Date: Fri Jan 27 00:27:26 2023 +0000 Work around package.el transitive dependency bug Eglot already depends transitively on Xref 1.4.0 via Project, but package.el doesn't pick up on this in Emacs 28 (which has Xref 1.3.0). * lisp/progmodes/eglot.el (Version): Bump to 1.11. (Package-Requires): Explicitly require Xref 1.4.0, which is the version already required by Project, for the benefit of Emacs 28 (bug#61048). diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index dc73152f5ab..3fc1d68422a 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,12 +2,12 @@ ;; Copyright (C) 2018-2023 Free Software Foundation, Inc. -;; Version: 1.10 +;; Version: 1.11 ;; Author: João Távora ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.16") (flymake "1.2.1") (project "0.9.3") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23") (external-completion "0.1")) +;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.16") (flymake "1.2.1") (project "0.9.3") (xref "1.4.0") (eldoc "1.11.0") (seq "2.23") (external-completion "0.1")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any commit 3766a666b5592e26f35d9ae3f5d60a5c49285e7c Author: Philip Kaludercic Date: Thu Jan 26 19:39:16 2023 +0100 ; Fix issues with processing out-of-order IRC messages * lisp/net/rcirc.el (rcirc-print): Always move to the beginning of the line, before setting any markers. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 77a9d70ac9e..97a314eb8ab 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2062,12 +2062,11 @@ rcirc-print (next-single-property-change (point) 'hard) (forward-char 1) (throw 'exit nil)))) + (goto-char (line-beginning-position)) (set-marker-insertion-type rcirc-prompt-start-marker t) (set-marker-insertion-type rcirc-prompt-end-marker t) ;; run markup functions - (unless (bolp) - (newline)) (save-excursion (save-restriction (narrow-to-region (point) (point)) commit d865e18096856af4014df69790120bf30dd17545 Author: Philip Kaludercic Date: Thu Jan 26 19:39:16 2023 +0100 ; Fix issues with processing out-of-order IRC messages * lisp/net/rcirc.el (rcirc-print): Always move to the beginning of the line, before setting any markers. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index da7c20b5e0a..5e4aa5e1198 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2062,12 +2062,11 @@ rcirc-print (next-single-property-change (point) 'hard) (forward-char 1) (throw 'exit nil)))) + (goto-char (line-beginning-position)) (set-marker-insertion-type rcirc-prompt-start-marker t) (set-marker-insertion-type rcirc-prompt-end-marker t) ;; run markup functions - (unless (bolp) - (newline)) (save-excursion (save-restriction (narrow-to-region (point) (point)) commit dfdc0f5fb7b10e737c3c8e2bdb1eb873a1e91bd7 Author: Mattias Engdegård Date: Thu Jan 26 12:36:20 2023 +0100 Fix xref-clear-marker-stack refactoring mistake * lisp/progmodes/xref.el (xref-clear-marker-stack): Clear the history correctly. Changing a lexical variable has no effect. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 916d83d407b..4db0df6c3b8 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -568,7 +568,8 @@ xref-clear-marker-stack (dolist (l (list (car history) (cdr history))) (dolist (m l) (set-marker m nil nil))) - (setq history (cons nil nil))) + (setcar history nil) + (setcdr history nil)) nil) ;;;###autoload commit f8c95d1a7681e861fc22d2a040cda0ddfe23eff4 Author: Eli Zaretskii Date: Thu Jan 26 10:54:43 2023 +0200 Fix xt-mouse on terminals that report UTF-8 encoded coordinates * lisp/xt-mouse.el (xterm-mouse--read-coordinate): Fix conversion of mouse coordinates in rxvt-unicode. Patches by Vladimir Panteleev and Jared Finder . (Bug#61022) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index adfa480bc0f..4ccd35d5277 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -151,16 +151,22 @@ xterm-mouse--read-coordinate `turn-on-xterm-mouse-tracking-on-terminal' was called, reads the coordinate as an UTF-8 code unit sequence; otherwise, reads a single byte." - (let ((previous-keyboard-coding-system (keyboard-coding-system))) + (let ((previous-keyboard-coding-system (keyboard-coding-system)) + (utf-8-p (terminal-parameter nil 'xterm-mouse-utf-8)) + ;; Prevent conversions inside 'read-char' due to input method, + ;; when we call 'read-char' below with 2nd argument non-nil. + (input-method-function nil)) (unwind-protect (progn - (set-keyboard-coding-system - (if (terminal-parameter nil 'xterm-mouse-utf-8) - 'utf-8-unix - 'no-conversion)) - ;; Wait only a little; we assume that the entire escape sequence - ;; has already been sent when this function is called. - (read-char nil nil 0.1)) + (set-keyboard-coding-system (if utf-8-p 'utf-8-unix 'no-conversion)) + (read-char nil + ;; Force 'read-char' to decode UTF-8 sequences if + ;; 'xterm-mouse-utf-8' is non-nil. + utf-8-p + ;; Wait only a little; we assume that the entire + ;; escape sequence has already been sent when + ;; this function is called. + 0.1)) (set-keyboard-coding-system previous-keyboard-coding-system)))) ;; In default mode, each numeric parameter of XTerm's mouse report is commit 4bf7cb71edc2694c9939ae27594e9a1e3b79e1c6 Author: Randy Taylor Date: Tue Jan 24 21:20:48 2023 -0500 Fix go-ts-mode indentation and set indent offset to 8 (Bug#61006) * lisp/progmodes/go-ts-mode.el (go-ts-mode-indent-offset): Change default value to 8. (go-ts-mode--indent-rules): Add indentation for parameters and interfaces. diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index d552e1360e0..5f3e1ea3e68 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -38,7 +38,7 @@ (declare-function treesit-node-type "treesit.c") (declare-function treesit-search-subtree "treesit.c") -(defcustom go-ts-mode-indent-offset 4 +(defcustom go-ts-mode-indent-offset 8 "Number of spaces for each indentation step in `go-ts-mode'." :version "29.1" :type 'integer @@ -78,8 +78,10 @@ go-ts-mode--indent-rules ((parent-is "expression_switch_statement") parent-bol 0) ((parent-is "field_declaration_list") parent-bol go-ts-mode-indent-offset) ((parent-is "import_spec_list") parent-bol go-ts-mode-indent-offset) + ((parent-is "interface_type") parent-bol go-ts-mode-indent-offset) ((parent-is "labeled_statement") parent-bol go-ts-mode-indent-offset) ((parent-is "literal_value") parent-bol go-ts-mode-indent-offset) + ((parent-is "parameter_list") parent-bol go-ts-mode-indent-offset) ((parent-is "type_spec") parent-bol go-ts-mode-indent-offset) ((parent-is "var_declaration") parent-bol go-ts-mode-indent-offset) (no-node parent-bol 0))) commit ff9498624fcd15e2ab6264d259d089aa5f989ae6 Author: Eli Zaretskii Date: Thu Jan 26 10:23:58 2023 +0200 ; * src/insdel.c (insert_from_buffer): Fix assertions. diff --git a/src/insdel.c b/src/insdel.c index 33dea569b24..0e1e98664b3 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -1184,7 +1184,8 @@ insert_from_buffer (struct buffer *buf, update_compositions (opoint, PT, CHECK_BORDER); #ifdef HAVE_TREE_SITTER - eassert (PT_BYTE >= 0); + eassert (PT_BYTE >= BEG_BYTE); + eassert (obyte >= BEG_BYTE); eassert (PT_BYTE >= obyte); treesit_record_change (obyte, obyte, PT_BYTE); #endif commit 41f497c8bee6e36a621a6d9088636069159387a9 Author: Eli Zaretskii Date: Thu Jan 26 09:59:58 2023 +0200 Fix doc strings of window-splitting commands * lisp/window.el (split-window-below, split-window-right): Doc fixes. (Bug#60886) diff --git a/lisp/window.el b/lisp/window.el index 84f5c5c3f5a..0cd30822ff6 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5670,9 +5670,11 @@ split-window-keep-point (defun split-window-below (&optional size window-to-split) "Split WINDOW-TO-SPLIT into two windows, one above the other. -WINDOW-TO-SPLIT defaults to the selected window and and will be above -the other window after splitting. The newly split-off window is -below and displays the same buffer. Return the new window. +WINDOW-TO-SPLIT defaults to the selected window if omitted or nil. +The newly created window will be below WINDOW-TO-SPLIT and will show +the same buffer as WINDOW-TO-SPLIT, if it is a live window, else the +buffer shown in the WINDOW-TO-SPLIT's frame's selected window. +Return the new window. If optional argument SIZE is omitted or nil, both windows get the same height, or close to it. If SIZE is positive, the upper @@ -5735,9 +5737,11 @@ split-root-window-below (defun split-window-right (&optional size window-to-split) "Split WINDOW-TO-SPLIT into two side-by-side windows. -WINDOW-TO-SPLIT defaults to the selected window and and will be on the -left after splitting. The newly split-off window is on the right and -displays the same buffer. Return the new window. +WINDOW-TO-SPLIT defaults to the selected window if omitted or nil. +The newly created window will be to the right of WINDOW-TO-SPLIT and +will show the same buffer as WINDOW-TO-SPLIT, if it is a live window, +else the buffer shown in the WINDOW-TO-SPLIT's frame's selected window. +Return the new window. If optional argument SIZE is omitted or nil, both windows get the same width, or close to it. If SIZE is positive, the left-hand commit cdf74254ffa2c53612f6d985e3774b51233fbd49 Author: Yuan Fu Date: Wed Jan 25 23:47:27 2023 -0800 Fix indentation for c-ts-mode (bug#61026) Fix indentation for things like while (true) if (true) { puts ("Hello"); } Note that the outer while loop omits brackets. * lisp/progmodes/c-ts-mode.el: (c-ts-mode--statement-offset-post-processr): New variable. (c-ts-mode--statement-offset): Use the new function. (c-ts-mode--fix-bracketless-indent): New function. (c-ts-base-mode): Use the new function. * test/lisp/progmodes/c-ts-mode-resources/indent.erts: New tests. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 95f9001e0d7..788c911f86b 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -279,6 +279,19 @@ c-ts-mode-indent-block-type-regexp "enumerator_list")) "Regexp matching types of block nodes (i.e., {} blocks).") +(defvar c-ts-mode--statement-offset-post-processr nil + "A functions that makes adjustments to `c-ts-mode--statement-offset'. + +This is a function that takes two arguments, the current indent +level and the current node, and returns a new level. + +When `c-ts-mode--statement-offset' runs and go up the parse tree, +it increments the indent level when some condition are met in +each level. At each level, after (possibly) incrementing the +offset, it calls this function, passing it the current indent +level and the current node, and use the return value as the new +indent level.") + (defun c-ts-mode--statement-offset (node parent &rest _) "This anchor is used for children of a statement inside a block. @@ -319,9 +332,24 @@ c-ts-mode--statement-offset ;; Add a level. ((looking-back (rx bol (* whitespace)) (line-beginning-position)) - (cl-incf level)))))) + (cl-incf level))))) + (when c-ts-mode--statement-offset-post-processr + (setq level (funcall c-ts-mode--statement-offset-post-processr + level node)))) (* level c-ts-mode-indent-offset))) +(defun c-ts-mode--fix-bracketless-indent (level node) + "Takes LEVEL and NODE and returns adjusted LEVEL. +This fixes indentation for cases shown in bug#61026. Basically +in C/C++, constructs like if, for, while sometimes don't have +bracket." + (if (and (not (equal (treesit-node-type node) "compound_statement")) + (member (treesit-node-type (treesit-node-parent node)) + '("if_statement" "while_statement" "do_statement" + "for_statement"))) + (1+ level) + level)) + (defun c-ts-mode--close-bracket-offset (node parent &rest _) "Offset for the closing bracket, NODE. It's basically one level less that the statements in the block. @@ -758,6 +786,8 @@ c-ts-base-mode ;; Indent. (when (eq c-ts-mode-indent-style 'linux) (setq-local indent-tabs-mode t)) + (setq-local c-ts-mode--statement-offset-post-processr + #'c-ts-mode--fix-bracketless-indent) ;; Comment (c-ts-common-comment-setup) diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index b8524432d02..67654404a77 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -105,6 +105,58 @@ main (int argc, } =-=-= +Name: Bracket-less Block-Statement (GNU Style) (bug#61026) + +=-= +int main() { + while (true) + if (true) + { + puts ("Hello"); + } + for (int i=0; i<5; i++) + if (true) + { + puts ("Hello"); + } + do + if (true) + { + puts ("Hello"); + } + while (true); + if (true) + if (true) + { + puts ("Hello"); + } +} +=-=-= + +Name: Bracket-less Block-Statement (Linux Style) (bug#61026) + +=-=-= +int main() { + while (true) + if (true) { + puts ("Hello"); + } + for (int i=0; i<5; i++) + if (true) { + puts ("Hello"); + } + do + if (true) { + puts ("Hello"); + } + while (true); + if (true) + if (true) { + puts ("Hello"); + } +} +=-=-= + Name: Multiline Parameter List (bug#60398) =-= commit 4bd06ce2a9fa1601aff5a5fcab7411e5fce20d28 Author: Yuan Fu Date: Wed Jan 25 23:12:41 2023 -0800 Fix call to treesit_record_change in insdel.c The start position of the change shouldn't be PT_BYTE, IIUC PT_BYTE is actually the end position. * src/insdel.c (insert_from_buffer): Move to here. (insert_from_buffer_1): Remove call to treesit_record_change. diff --git a/src/insdel.c b/src/insdel.c index b51767bf527..33dea569b24 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -1175,9 +1175,19 @@ insert_from_buffer (struct buffer *buf, { ptrdiff_t opoint = PT; +#ifdef HAVE_TREE_SITTER + ptrdiff_t obyte = PT_BYTE; +#endif + insert_from_buffer_1 (buf, charpos, nchars, inherit); signal_after_change (opoint, 0, PT - opoint); update_compositions (opoint, PT, CHECK_BORDER); + +#ifdef HAVE_TREE_SITTER + eassert (PT_BYTE >= 0); + eassert (PT_BYTE >= obyte); + treesit_record_change (obyte, obyte, PT_BYTE); +#endif } static void @@ -1305,12 +1315,6 @@ insert_from_buffer_1 (struct buffer *buf, /* Insert those intervals. */ graft_intervals_into_buffer (intervals, PT, nchars, current_buffer, inherit); -#ifdef HAVE_TREE_SITTER - eassert (outgoing_nbytes >= 0); - eassert (PT_BYTE >= 0); - treesit_record_change (PT_BYTE, PT_BYTE, PT_BYTE + outgoing_nbytes); -#endif - adjust_point (nchars, outgoing_nbytes); } commit 00675aa724a6e18d03c2ccc63269ef03c67086ec Author: Randy Taylor Date: Thu Jan 19 09:16:55 2023 -0500 Add support for building tree-sitter modules with MinGW * admin/notes/tree-sitter/build-module/build.sh: Add support for building tree-sitter modules with MinGW. diff --git a/admin/notes/tree-sitter/build-module/build.sh b/admin/notes/tree-sitter/build-module/build.sh index f0962940287..9dc674237ca 100755 --- a/admin/notes/tree-sitter/build-module/build.sh +++ b/admin/notes/tree-sitter/build-module/build.sh @@ -3,12 +3,17 @@ lang=$1 topdir="$PWD" -if [ $(uname) == "Darwin" ] -then - soext="dylib" -else - soext="so" -fi +case $(uname) in + "Darwin") + soext="dylib" + ;; + *"MINGW"*) + soext="dll" + ;; + *) + soext="so" + ;; +esac echo "Building ${lang}" commit fce07d461dec3128c2a3618adbbb4794a45b1fdb Author: Po Lu Date: Thu Jan 26 08:40:27 2023 +0800 Increase DUMPED_HEAP_SIZE * src/w32heap.c (DUMPED_HEAP_SIZE): Add 5 megabytes. diff --git a/src/w32heap.c b/src/w32heap.c index a1975d9a975..628fc28e3c5 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -121,9 +121,9 @@ # define DUMPED_HEAP_SIZE 10 #else # if defined _WIN64 || defined WIDE_EMACS_INT -# define DUMPED_HEAP_SIZE (23*1024*1024) +# define DUMPED_HEAP_SIZE (28*1024*1024) # else -# define DUMPED_HEAP_SIZE (13*1024*1024) +# define DUMPED_HEAP_SIZE (18*1024*1024) # endif #endif commit 3365e413bd9cb482849cf48e4f6c366a61326569 Author: Richard M. Stallman Date: Wed Jan 25 16:35:37 2023 -0500 When base64-decoding part of decrypted text, save the decoding permanently if we save the decryption permanently. (rmail-epa-decode): Take arguments BEG and BACK-FROM-END to designate region. (rmail-epa-decrypt-1): Call rmail-epa-decode from here, when decrypting one encrypted passage. (rmail-epa-decrypt): Not from here. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 659649b5d42..c56f4ce62dc 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4580,6 +4580,9 @@ rmail-epa-decrypt-1 (current-buffer)))) (error nil)) + ;; Decode any base64-encoded material in what we just decrypted. + (rmail-epa-decode armor-start after-end) + (list armor-start (- (point-max) after-end) mime armor-end-regexp (buffer-substring armor-start (- (point-max) after-end))))) @@ -4622,9 +4625,6 @@ rmail-epa-decrypt "> ") (push (rmail-epa-decrypt-1 mime) decrypts)))) - ;; Decode any base64-encoded mime sections. - (rmail-epa-decode) - (when (and decrypts (rmail-buffers-swapped-p)) (when (y-or-n-p "Replace the original message? ") (when (eq major-mode 'rmail-mode) @@ -4689,12 +4689,14 @@ rmail-epa-decrypt (unless decrypts (error "Nothing to decrypt"))))) -;; Decode all base64-encoded mime sections, so that this change -;; is made in the Rmail file, not just in the viewing buffer. -(defun rmail-epa-decode () +;; Decode all base64-encoded mime sections from BEG to (Z - BACK-FROM-END), +;; so that we save the decoding permanently in the Rmail buffer +;; if we permanently save the decryption. +(defun rmail-epa-decode (beg back-from-end) (save-excursion - (goto-char (point-min)) - (while (re-search-forward "--------------[0-9a-zA-Z]+\n" nil t) + (goto-char beg) + (while (re-search-forward "--------------[0-9a-zA-Z]+\n" + (- (point-max) back-from-end) t) ;; The ending delimiter is a start delimiter if another section follows. ;; Otherwise it is an end delimiter, with -- affixed. (let ((delim (concat (substring (match-string 0) 0 -1) "\\(\\|--\\)\n"))) commit af28191b04fa3e70caeea83c1c8a6c16a57adece Author: Michael Albinus Date: Wed Jan 25 20:14:12 2023 +0100 * lisp/net/tramp.el (tramp-wrong-passwd-regexp): Fix regexp. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 123d01c747d..04b683a8a24 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -659,7 +659,7 @@ tramp-password-prompt-regexp (defcustom tramp-wrong-passwd-regexp (rx bol (* nonl) (| "Permission denied" - "Login [Ii]ncorrect" + (: "Login " (| "Incorrect" "incorrect")) "Connection refused" "Connection closed" "Timeout, server not responding." commit 42e02480c2b70b4a7065690a528d2f3fda017b3b Author: Juri Linkov Date: Wed Jan 25 20:19:44 2023 +0200 * doc/emacs/text.texi (Outline Minor Mode): New node split from "Outline Mode" (Outline Mode): Move all outline-minor-mode related information to the new node "Outline Minor Mode" (bug#61062). diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index 8fbf731a4f7..83d5869ee64 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -958,8 +958,6 @@ Outline Mode @cindex invisible lines @findex outline-mode -@findex outline-minor-mode -@vindex outline-minor-mode-prefix @vindex outline-mode-hook Outline mode is a major mode derived from Text mode, which is specialized for editing outlines. It provides commands to navigate @@ -982,6 +980,19 @@ Outline Mode line really kills all the following invisible text associated with the ellipsis. +@menu +* Outline Minor Mode:: Outline mode to use with other major modes. +* Outline Format:: What the text of an outline looks like. +* Outline Motion:: Special commands for moving through outlines. +* Outline Visibility:: Commands to control what is visible. +* Outline Views:: Outlines and multiple views. +* Foldout:: Folding means zooming in on outlines. +@end menu + +@node Outline Minor Mode +@subsection Outline Minor Mode + +@findex outline-minor-mode Outline minor mode is a buffer-local minor mode which provides the same commands as the major mode, Outline mode, but can be used in conjunction with other major modes. You can type @kbd{M-x @@ -990,6 +1001,7 @@ Outline Mode specific file (@pxref{File Variables}). @kindex C-c @@ @r{(Outline minor mode)} +@vindex outline-minor-mode-prefix The major mode, Outline mode, provides special key bindings on the @kbd{C-c} prefix. Outline minor mode provides similar bindings with @kbd{C-c @@} as the prefix; this is to reduce the conflicts with the @@ -1014,14 +1026,6 @@ Outline Mode sub-heading, and showing all for the current section. @kbd{S-@key{TAB}} does the same for the entire buffer. -@menu -* Outline Format:: What the text of an outline looks like. -* Outline Motion:: Special commands for moving through outlines. -* Outline Visibility:: Commands to control what is visible. -* Outline Views:: Outlines and multiple views. -* Foldout:: Folding means zooming in on outlines. -@end menu - @node Outline Format @subsection Format of Outlines commit 37c1c924666c991f893b5b1959783ba9d961a3c8 Author: Juri Linkov Date: Wed Jan 25 19:38:01 2023 +0200 ; * etc/NEWS: Minor reordering. Move Exif section closer to Image changes, define-keymap/defvar-keymap and lookup-key closer to Keymaps section. diff --git a/etc/NEWS b/etc/NEWS index 133cdb1e718..4d199676848 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2730,6 +2730,13 @@ some commands and user options are no longer needed and are now obsolete: 'image-dired-display-window-width-correction', 'image-dired-temp-image-file'. +** Exif + +--- +*** New function 'exif-field'. +This is a convenience function to extract the field data from +'exif-parse-file' and 'exif-parse-buffer'. + ** Bookmarks --- @@ -2751,13 +2758,6 @@ It is bound to the new command 'bookmark-edit-annotation-cancel'. This option controls the bitmap used to indicate bookmarks in the fringe (or nil to disable showing this marker). -** Exif - ---- -*** New function 'exif-field'. -This is a convenience function to extract the field data from -'exif-parse-file' and 'exif-parse-buffer'. - ** Xwidget --- @@ -4275,6 +4275,24 @@ vectors and strings. The new 'key' type can be used for options that should be a valid key according to 'key-valid-p'. The type 'key-sequence' is now obsolete. ++++ +** New function 'define-keymap'. +This function allows defining a number of keystrokes with one form. + ++++ +** New macro 'defvar-keymap'. +This macro allows defining keymap variables more conveniently. + +** 'defvar-keymap' can specify 'repeat-mode' behavior for the keymap. +Use ':repeat t' to have all bindings be repeatable or for more +advanced usage: + + :repeat (:enter (commands ...) :exit (commands ...)) + +--- +** 'kbd' can now be used in built-in, preloaded libraries. +It no longer depends on edmacro.el and cl-lib.el. + +++ ** New substitution in docstrings and 'substitute-command-keys'. Use \\`KEYSEQ' to insert a literal key sequence "KEYSEQ" (for example @@ -4284,6 +4302,18 @@ be used only when a key sequence has no corresponding command, for example when it is read directly with 'read-key-sequence'. It must be a valid key sequence according to 'key-valid-p'. +--- +** 'lookup-key' is more permissive when searching for extended menu items. +In Emacs 28.1, the behavior of 'lookup-key' was changed: when looking +for a menu item '[menu-bar Foo-Bar]', first try to find an exact +match, then look for the lowercased '[menu-bar foo-bar]'. + +This has been extended, so that when looking for a menu item with a +symbol containing spaces, as in '[menu-bar Foo\ Bar]', first look for +an exact match, then the lowercased '[menu-bar foo\ bar]' and finally +'[menu-bar foo-bar]'. This further improves backwards-compatibility +when converting menus to use 'easy-menu-define'. + +++ ** New function 'file-name-split'. This returns a list of all the components of a file name. @@ -4483,24 +4513,6 @@ permanent local variables. ** Third 'mapconcat' argument SEPARATOR is now optional. An explicit nil always meant the empty string, now it can be left out. -+++ -** New function 'define-keymap'. -This function allows defining a number of keystrokes with one form. - -+++ -** New macro 'defvar-keymap'. -This macro allows defining keymap variables more conveniently. - -** 'defvar-keymap' can specify 'repeat-mode' behavior for the keymap. -Use ':repeat t' to have all bindings be repeatable or for more -advanced usage: - - :repeat (:enter (commands ...) :exit (commands ...)) - ---- -** 'kbd' can now be used in built-in, preloaded libraries. -It no longer depends on edmacro.el and cl-lib.el. - +++ ** New function 'image-at-point-p'. This function returns t if point is on a valid image, and nil @@ -4524,18 +4536,6 @@ separate glyphs. This takes into account combining characters and grapheme clusters, by treating each sequence of characters composed on display as a single unit. ---- -** 'lookup-key' is more permissive when searching for extended menu items. -In Emacs 28.1, the behavior of 'lookup-key' was changed: when looking -for a menu item '[menu-bar Foo-Bar]', first try to find an exact -match, then look for the lowercased '[menu-bar foo-bar]'. - -This has been extended, so that when looking for a menu item with a -symbol containing spaces, as in '[menu-bar Foo\ Bar]', first look for -an exact match, then the lowercased '[menu-bar foo\ bar]' and finally -'[menu-bar foo-bar]'. This further improves backwards-compatibility -when converting menus to use 'easy-menu-define'. - ** Xwidget +++ commit cfb180329b567d907c11fc9f2bd24728729ec689 Author: Dmitry Gutov Date: Wed Jan 25 17:21:49 2023 +0200 ruby-ts-mode: Don't reindent when "class" or "def" is under "ERROR" * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules): Don't reindent when "class" or "def" is under "ERROR" (bug#61017). diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index eff846f8585..60215978176 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -566,6 +566,12 @@ ruby-ts--indent-rules ((n-p-gp nil nil "regex") no-indent 0) ((parent-is "regex") no-indent 0) + ;; Incomplete buffer state, better not reindent (bug#61017). + ((and (parent-is "ERROR") + (or (node-is ,ruby-ts--class-or-module-regex) + (node-is "\\`def\\'"))) + no-indent 0) + ;; if then else elseif notes: ;; ;; 1. The "then" starts at the end of the line that ends commit abb3becb9fb925a4fc3c13da677cc55823423cb3 Author: Dmitry Gutov Date: Wed Jan 25 17:01:28 2023 +0200 treesit-install-language-grammar: Provide default repo url * lisp/treesit.el (treesit--check-repo-url): New function. (treesit--install-language-grammar-build-recipe): Use it (bug#61051). diff --git a/lisp/treesit.el b/lisp/treesit.el index 660039cc7cc..4c9bdfc0bd4 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2707,8 +2707,10 @@ treesit--install-language-grammar-build-recipe (if (equal string "") nil string))) (list lang - (read-string - "Enter the URL of the Git repository of the language grammar: ") + (let ((repo-default (format "https://github.com/tree-sitter/tree-sitter-%s" lang))) + (read-string + "Enter the URL of the Git repository of the language grammar: " + (and (treesit--check-repo-url repo-default) repo-default))) (empty-string-to-nil (read-string "Enter the tag or branch (default: default branch): ")) @@ -2722,6 +2724,16 @@ treesit--install-language-grammar-build-recipe (read-string "Enter the C++ compiler to use (default: auto-detect): ")))))) +(defun treesit--check-repo-url (url) + (defvar url-request-method) + (let ((url-request-method "HEAD")) + (let ((buffer (condition-case nil (url-retrieve-synchronously url t t) + (file-error nil)))) + (and buffer + (eql + (buffer-local-value 'url-http-response-status buffer) + 200))))) + ;;;###autoload (defun treesit-install-language-grammar (lang) "Build and install the tree-sitter language grammar library for LANG. commit c6613403e5cb5e2f0043d16530be046922d23f43 Author: Basil L. Contovounesios Date: Wed Jan 25 14:24:39 2023 +0000 Fix Dired face for directory symlinks * lisp/dired.el (dired-font-lock-keywords): Fontify directory symlinks with the value of dired-directory-face rather than its name as a (nonexistent) face (bug#60977). diff --git a/lisp/dired.el b/lisp/dired.el index 42d15f27a54..2bcb28a0e00 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -789,7 +789,7 @@ dired-font-lock-keywords '(dired-move-to-filename) nil '(1 dired-symlink-face) - '(2 '(face dired-directory-face dired-symlink-filename t)))) + '(2 `(face ,dired-directory-face dired-symlink-filename t)))) ;; ;; Symbolic link to a non-directory. (list dired-re-sym commit 37454de0c8f07584a1604d54acc97e4bc1c9ddfc Author: Basil L. Contovounesios Date: Wed Jan 25 01:02:30 2023 +0000 Pacify --without-x unused function warning * src/xfaces.c (font_maybe_unset_attribute): Move definition... [HAVE_WINDOW_SYSTEM] (font_maybe_unset_attribute): ...to here, since the function is used only when we HAVE_WINDOW_SYSTEM (bug#61049). diff --git a/src/xfaces.c b/src/xfaces.c index 68f7cc493cc..35b79154805 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6012,7 +6012,6 @@ realize_non_ascii_face (struct frame *f, Lisp_Object font_object, return face; } -#endif /* HAVE_WINDOW_SYSTEM */ /* Remove the attribute at INDEX from the font object if SYMBOL appears in `font-fallback-ignored-attributes'. */ @@ -6031,6 +6030,7 @@ font_maybe_unset_attribute (Lisp_Object font_object, ASET (font_object, index, Qnil); } } +#endif /* HAVE_WINDOW_SYSTEM */ /* Realize the fully-specified face with attributes ATTRS in face cache CACHE for ASCII characters. Do it for GUI frame CACHE->f. commit 9a21cb107516d45a5b1ca43e4204f2c93cbf12fd Author: Michael Albinus Date: Wed Jan 25 15:31:33 2023 +0100 ; * etc/NEWS: Fix typos. diff --git a/etc/NEWS b/etc/NEWS index 10dddf8c84b..133cdb1e718 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1127,7 +1127,7 @@ the value is 'in-margins', Outline Minor Mode uses the window margins for buttons that hide/show outlines. +++ -*** buttons and headings now have their own keymap. +*** Buttons and headings now have their own keymaps. 'outline-button-icon-map', 'outline-overlay-button-map', and 'outline-inserted-button-map' are now available as defined keymaps instead of being anonymous keymaps. commit f30a4f51fefa7251386d7393920a082f3830bcac Author: Robert Pluim Date: Wed Jan 25 14:23:44 2023 +0100 Announce outline.el keymaps * etc/NEWS: Announce new keymaps. diff --git a/etc/NEWS b/etc/NEWS index b034dab7e61..10dddf8c84b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1126,6 +1126,12 @@ buffer, and you can use 'RET' to cycle outline visibility. When the value is 'in-margins', Outline Minor Mode uses the window margins for buttons that hide/show outlines. ++++ +*** buttons and headings now have their own keymap. +'outline-button-icon-map', 'outline-overlay-button-map', and +'outline-inserted-button-map' are now available as defined keymaps +instead of being anonymous keymaps. + ** Windows +++ commit 8198803f66098686d817d06a5ebdc5b81bab3566 Author: Arash Esbati Date: Wed Jan 25 11:02:24 2023 +0100 ; Don't mention in the Gnus manual user options that were removed * doc/misc/gnus.texi (HTML): Delete entries for custom variables removed in commit 2c8b2fc8d5. (Bug#61054) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 3289d66f017..1769b70c9bc 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -12106,17 +12106,6 @@ HTML Also @pxref{Misc Article} for @code{gnus-inhibit-images}. -@item gnus-html-cache-directory -@vindex gnus-html-cache-directory -Gnus will download and cache images according to how -@code{gnus-blocked-images} is set. These images will be stored in -this directory. - -@item gnus-html-cache-size -@vindex gnus-html-cache-size -When @code{gnus-html-cache-size} bytes have been used in that -directory, the oldest files will be deleted. The default is 500MB. - @item gnus-html-frame-width @vindex gnus-html-frame-width The width to use when rendering HTML@. The default is 70. commit 8a1498c01f76391f61c8bd9861a31fec42e1073a Author: Jostein Kjønigsen Date: Wed Jan 25 10:38:09 2023 +0100 Fix fontification of function-valued variables (bug#61053) * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode--font-lock-settings): Remove overrides and reorder the variable_declarator rule. diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 34030968806..25cc327d05f 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -132,26 +132,21 @@ typescript-ts-mode--font-lock-settings Argument LANGUAGE is either `typescript' or `tsx'." (treesit-font-lock-rules :language language - :override t :feature 'comment `((comment) @font-lock-comment-face) :language language - :override t :feature 'constant `(((identifier) @font-lock-constant-face (:match "^[A-Z_][A-Z_\\d]*$" @font-lock-constant-face)) - [(true) (false) (null)] @font-lock-constant-face) :language language - :override t :feature 'keyword `([,@typescript-ts-mode--keywords] @font-lock-keyword-face [(this) (super)] @font-lock-keyword-face) :language language - :override t :feature 'string `((regex pattern: (regex_pattern)) @font-lock-regexp-face (string) @font-lock-string-face @@ -159,7 +154,7 @@ typescript-ts-mode--font-lock-settings (template_substitution ["${" "}"] @font-lock-misc-punctuation-face)) :language language - :override t + :override t ;; for functions assigned to variables :feature 'declaration `((function name: (identifier) @font-lock-function-name-face) @@ -174,6 +169,10 @@ typescript-ts-mode--font-lock-settings (required_parameter (identifier) @font-lock-variable-name-face) (optional_parameter (identifier) @font-lock-variable-name-face) + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(function) (arrow_function)]) + (variable_declarator name: (identifier) @font-lock-variable-name-face) @@ -188,10 +187,6 @@ typescript-ts-mode--font-lock-settings (arrow_function parameter: (identifier) @font-lock-variable-name-face) - (variable_declarator - name: (identifier) @font-lock-function-name-face - value: [(function) (arrow_function)]) - (variable_declarator name: (array_pattern (identifier) @@ -205,7 +200,6 @@ typescript-ts-mode--font-lock-settings (import_clause (named_imports (import_specifier (identifier)) @font-lock-variable-name-face))) :language language - :override t :feature 'identifier `((nested_type_identifier module: (identifier) @font-lock-type-face) @@ -234,7 +228,6 @@ typescript-ts-mode--font-lock-settings (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) :language language - :override t :feature 'property `((property_signature name: (property_identifier) @font-lock-property-face) @@ -249,7 +242,6 @@ typescript-ts-mode--font-lock-settings @font-lock-property-face)) :language language - :override t :feature 'expression '((assignment_expression left: [(identifier) @font-lock-function-name-face @@ -266,7 +258,6 @@ typescript-ts-mode--font-lock-settings property: (property_identifier) @font-lock-function-name-face)])) :language language - :override t :feature 'pattern `((pair_pattern key: (property_identifier) @font-lock-property-face) @@ -274,7 +265,6 @@ typescript-ts-mode--font-lock-settings (array_pattern (identifier) @font-lock-variable-name-face)) :language language - :override t :feature 'jsx `((jsx_opening_element [(nested_identifier (identifier)) (identifier)] commit cfe26f31893681fcba36a635546d62ab512524ab Author: Theodor Thornhill Date: Wed Jan 25 13:00:33 2023 +0100 Add new java indent rules * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): Check for enum_body_declarations and switch_label. diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index af2b0c1fa8d..8737472e514 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -81,6 +81,7 @@ java-ts-mode--indent-rules ((parent-is "annotation_type_body") parent-bol java-ts-mode-indent-offset) ((parent-is "interface_body") parent-bol java-ts-mode-indent-offset) ((parent-is "constructor_body") parent-bol java-ts-mode-indent-offset) + ((parent-is "enum_body_declarations") parent-bol 0) ((parent-is "enum_body") parent-bol java-ts-mode-indent-offset) ((parent-is "switch_block") parent-bol java-ts-mode-indent-offset) ((parent-is "record_declaration_body") parent-bol java-ts-mode-indent-offset) @@ -93,6 +94,7 @@ java-ts-mode--indent-rules ((parent-is "variable_declarator") parent-bol java-ts-mode-indent-offset) ((parent-is "method_invocation") parent-bol java-ts-mode-indent-offset) ((parent-is "switch_rule") parent-bol java-ts-mode-indent-offset) + ((parent-is "switch_label") parent-bol java-ts-mode-indent-offset) ((parent-is "ternary_expression") parent-bol java-ts-mode-indent-offset) ((parent-is "lambda_expression") parent-bol java-ts-mode-indent-offset) ((parent-is "element_value_array_initializer") parent-bol java-ts-mode-indent-offset) commit 987e53f3e2d72d15c2d043beb2b9ed4ada118fe0 Author: F. Jason Park Date: Tue Jan 24 19:49:02 2023 -0800 ; * doc/misc/erc.texi: Improve Local Modules section. diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 23cdcbff575..8030dfa4bb7 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -539,36 +539,55 @@ Modules At present, the only such module is @code{networks}, whose library ERC always loads anyway. +@anchor{Local Modules} @subheading Local Modules @cindex local modules All modules operate as minor modes under the hood, and some newer ones may be defined as buffer-local. These so-called ``local modules'' are a work in progress and their behavior and interface are subject to -change. As of ERC 5.5, the only practical differences are +change. As of ERC 5.5, the only practical differences are as follows: @enumerate @item -``Control variables,'' like @code{erc-sasl-mode}, are stateful across -IRC sessions and override @code{erc-module} membership when influencing -module activation in new sessions. +``Control variables,'' like @code{erc-sasl-mode}, retain their values +across IRC sessions and override @code{erc-module} membership when +influencing module activation. @item Removing a local module from @code{erc-modules} via Customize not only disables its mode but also kills its control variable in all ERC buffers. @item -``Mode toggles,'' like @code{erc-sasl-mode} and -@code{erc-sasl-enable}, behave differently relative to each other and -to their global counterparts. (More on this just below.) +``Mode toggles,'' like @code{erc-sasl-mode} and the complementary +@code{erc-sasl-enable}/@code{erc-sasl-disable} pairing, behave +differently than their global counterparts. @end enumerate -By default, all local-mode toggles, like @code{erc-sasl-mode}, only -affect the current buffer, but their ``non-mode'' variants, such as -@code{erc-sasl-enable}, operate on all buffers belonging to a -connection when called interactively. Keep in mind that whether -enabled or not, a module may effectively be ``inert'' in certain types -of buffers, such as queries and channels. Whatever the case, a local -toggle never mutates @code{erc-modules}. +In target buffers, a local module's activation state survives +``reassociation'' by default, but modules themselves always have the +final say. For example, a module may reset all instances of itself in +its network context upon reconnecting. Moreover, the value of a mode +variable may be meaningless in buffers that its module has no interest +in. For example, the value of @code{erc-sasl-mode} doesn't matter in +target buffers and may even remain non-@code{nil} after SASL has been +disabled for the current connection (and vice versa). + +When it comes to server buffers, a module's activation state only +persists for sessions revived via the automatic reconnection mechanism +or a manual @samp{/reconnect} issued at the prompt. In other words, +this doesn't apply to sessions revived by an entry-point command, such +as @code{erc-tls}, because such commands always ensure a clean slate +by looking only to @code{erc-modules}. Although a session revived in +this manner may indeed harvest other information from a previous +server buffer, it simply doesn't care which modules might have been +active during that connection. + +Lastly, a local mode's toggle command, like @code{erc-sasl-mode}, only +affects the current buffer, but its ``non-mode'' cousins, like +@code{erc-sasl-enable} and @code{erc-sasl-disable}, operate on all +buffers belonging to their connection (when called interactively). +And unlike global toggles, none of these ever mutates +@code{erc-modules}. @c PRE5_4: Document every option of every module in its own subnode commit 3846e79c93bc018b28d1d24ad5f1e038e50f39be Author: F. Jason Park Date: Tue Jan 24 02:34:29 2023 -0800 ; Fix filename mismatches in prop lines of ERC tests * test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el: Fix file name in prop line and footer. * test/lisp/erc/erc-scenarios-base-local-modules.el: Fix file name in prop line and footer. * test/lisp/erc/erc-scenarios-base-netid-samenet.el: Fix file name in prop line and footer. * test/lisp/erc/erc-scenarios-base-upstream-recon-soju.el: Fix file name in prop line and footer. * test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el: Fix file name in prop line and footer. diff --git a/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el b/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el index 74d4444ccd2..9275aba2875 100644 --- a/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el +++ b/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el @@ -1,4 +1,4 @@ -;;; erc-scenarios-compat-rename-bouncer.el --- compat-rename scenarios -*- lexical-binding: t -*- +;;; erc-scenarios-base-compat-rename-bouncer.el --- Compat-rename scenarios -*- lexical-binding: t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. @@ -169,4 +169,4 @@ erc-scenarios-base-compat-no-rename-bouncer--reconnect (erc-scenarios-common--base-compat-no-rename-bouncer dialogs 'auto after))))) -;;; erc-scenarios-compat-rename-bouncer.el ends here +;;; erc-scenarios-base-compat-rename-bouncer.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el index 916d105779a..1318207a3bf 100644 --- a/test/lisp/erc/erc-scenarios-base-local-modules.el +++ b/test/lisp/erc/erc-scenarios-base-local-modules.el @@ -1,4 +1,4 @@ -;;; erc-scenarios-local-modules.el --- Local modules tests for ERC -*- lexical-binding: t -*- +;;; erc-scenarios-base-local-modules.el --- Local-module tests for ERC -*- lexical-binding: t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. @@ -22,14 +22,15 @@ ;; A local module doubles as a minor mode whose mode variable and ;; associated local data can withstand service disruptions. ;; Unfortunately, the current implementation is too unwieldy to be -;; made public because it doesn't perform any of the boiler plate -;; needed to save and restore buffer-local and "network-local" copies -;; of user options. Ultimately, a user-friendly framework must fill -;; this void if third-party local modules are ever to become +;; promoted publicly because it doesn't perform any of the boiler +;; plate needed to save and restore buffer-local and "network-local" +;; copies of user options. Ultimately, a user-friendly framework must +;; fill this void if third-party local modules are ever to become ;; practical. ;; ;; The following tests all use `sasl' because, as of ERC 5.5, it's the -;; only local module. +;; only connection-oriented local module. A fictitious +;; target-oriented module is defined below for testing purposes. ;;; Code: @@ -325,4 +326,4 @@ erc-scenarios-base-local-modules--var-persistence (funcall expect 10 "User modes for tester") (should (eql erc-scenarios-base-local-modules--local-var 1)))))) -;;; erc-scenarios-local-modules.el ends here +;;; erc-scenarios-base-local-modules.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-netid-samenet.el b/test/lisp/erc/erc-scenarios-base-netid-samenet.el index 7304dead44c..997dab93735 100644 --- a/test/lisp/erc/erc-scenarios-base-netid-samenet.el +++ b/test/lisp/erc/erc-scenarios-base-netid-samenet.el @@ -1,4 +1,4 @@ -;;; erc-scenarios-base-network-id-samenet.el --- netid-id samenet scenarios -*- lexical-binding: t -*- +;;; erc-scenarios-base-netid-samenet.el --- One-network net-ID scenarios -*- lexical-binding: t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. @@ -148,4 +148,4 @@ erc-scenarios-base-network-id-same-network--no-ids :server "foonet/chester" :chan "#chan@foonet/chester"))) -;;; erc-scenarios-base-network-id-samenet.el ends here +;;; erc-scenarios-base-netid-samenet.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-upstream-recon-soju.el b/test/lisp/erc/erc-scenarios-base-upstream-recon-soju.el index 28b0db77be6..fc8be982f65 100644 --- a/test/lisp/erc/erc-scenarios-base-upstream-recon-soju.el +++ b/test/lisp/erc/erc-scenarios-base-upstream-recon-soju.el @@ -1,4 +1,4 @@ -;;; erc-scenarios-upstream-recon-soju.el --- Upstream soju -*- lexical-binding: t -*- +;;; erc-scenarios-base-upstream-recon-soju.el --- Bouncer recon scenario -*- lexical-binding: t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. @@ -19,7 +19,8 @@ ;; Commentary: -;; These concern the loss and recovery of a proxy's IRC-side connection. +;; These concern the loss and recovery of a proxy's IRC-side +;; connection (hence "upstream"). ;;; Code: @@ -41,4 +42,4 @@ erc-scenarios-upstream-recon--soju 'soju-foonet 'soju-barnet)) -;;; erc-scenarios-upstream-recon-soju.el ends here +;;; erc-scenarios-base-upstream-recon-soju.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el index 79e1349bd95..461dac27b21 100644 --- a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el +++ b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el @@ -1,4 +1,4 @@ -;;; erc-scenarios-upstream-recon-znc.el --- Upstream znc -*- lexical-binding: t -*- +;;; erc-scenarios-base-upstream-recon-znc.el --- Bouncer recon scenario -*- lexical-binding: t -*- ;; Copyright (C) 2022-2023 Free Software Foundation, Inc. @@ -19,7 +19,8 @@ ;; Commentary: -;; These concern the loss and recovery of a proxy's IRC-side connection. +;; These concern the loss and recovery of a proxy's IRC-side +;; connection (hence "upstream"). ;;; Code: @@ -41,4 +42,4 @@ erc-scenarios-upstream-recon--znc 'znc-foonet 'znc-barnet)) -;;; erc-scenarios-upstream-recon-znc.el ends here +;;; erc-scenarios-base-upstream-recon-znc.el ends here commit 8b87d095acfb23b527f955873a59dd9c13ffc9b4 Author: Paul Eggert Date: Tue Jan 24 15:18:55 2023 -0800 Pacify Apple clang version 13.0.0 (clang-1300.0.29.30): * src/coding.c: When compiling with Apple clang, ignore -Wunused-but-set-variable only in Clang 14 and greater. Problem reported by Mattias Engdegård. diff --git a/src/coding.c b/src/coding.c index 79461addd1a..a2e0d7040f8 100644 --- a/src/coding.c +++ b/src/coding.c @@ -653,7 +653,7 @@ #define ONE_MORE_BYTE(c) \ /* Suppress clang warnings about consumed_chars never being used. Although correct, the warnings are too much trouble to code around. */ -#if 13 <= __clang_major__ +#if 13 <= __clang_major__ - defined __apple_build_version__ # pragma clang diagnostic ignored "-Wunused-but-set-variable" #endif commit ecf500b5e34f3767df6b41f110efcf307c74ebc9 Author: Juri Linkov Date: Tue Jan 24 20:48:20 2023 +0200 Handle relative file names in vc-resynch-window and vc-resynch-buffer * lisp/vc/vc-dispatcher.el (vc-resynch-window, vc-resynch-buffer): While comparing with `buffer-file-name' if `file' is not absolute use `expand-file-name' in `vc-root-dir'. This fixes the case of refreshing the buffers after typing `C-x v = C-x v u' (bug#60897). diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index e1a3eff448d..fd5f655a0f6 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -608,7 +608,10 @@ vc-resynch-window difference between the buffer and the file is due to modifications by the dispatcher client code, rather than user editing!" - (and (string= buffer-file-name file) + (and (string= buffer-file-name + (if (file-name-absolute-p file) + file + (expand-file-name file (vc-root-dir)))) (if keep (when (file-exists-p file) (when reset-vc-info @@ -643,7 +646,10 @@ vc-resynch-buffers-in-directory (defun vc-resynch-buffer (file &optional keep noquery reset-vc-info) "If FILE is currently visited, resynch its buffer." - (if (string= buffer-file-name file) + (if (string= buffer-file-name + (if (file-name-absolute-p file) + file + (expand-file-name file (vc-root-dir)))) (vc-resynch-window file keep noquery reset-vc-info) (if (file-directory-p file) (vc-resynch-buffers-in-directory file keep noquery reset-vc-info) commit 695e9f71c3f13c1338de5bb653d71462a6e436b8 Author: Robert Pluim Date: Tue Jan 24 20:37:56 2023 +0200 Use named keymaps for outline buttons https://lists.gnu.org/archive/html/emacs-devel/2023-01/msg00334.html * lisp/outline.el (outline-button-icon-map) (outline-overlay-button-map, outline-inserted-button-map): Keymaps refactored from outline--create-button-icons and outline--insert-button. (outline--create-button-icons, outline--insert-button): Move keymaps to separate variables. diff --git a/lisp/outline.el b/lisp/outline.el index 0bfda8388ed..a89985d1990 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -1776,6 +1776,20 @@ outline-cycle-buffer ;;; Button/margin indicators +(defvar-keymap outline-button-icon-map + "" #'outline-cycle + ;; Need to override the global binding + ;; `mouse-appearance-menu' with : + "S-" #'ignore + "S-" #'outline-cycle-buffer) + +(defvar-keymap outline-overlay-button-map + "RET" #'outline-cycle) + +(defvar-keymap outline-inserted-button-map + :parent (make-composed-keymap outline-button-icon-map + outline-overlay-button-map)) + (defun outline--create-button-icons () (pcase outline-minor-mode-use-buttons ('in-margins @@ -1808,12 +1822,7 @@ outline--create-button-icons (propertize (icon-string icon-name) 'mouse-face 'default 'follow-link 'mouse-face - 'keymap (define-keymap - "" #'outline-cycle - ;; Need to override the global binding - ;; `mouse-appearance-menu' with : - "S-" #'ignore - "S-" #'outline-cycle-buffer))) + 'keymap outline-button-icon-map)) (list 'outline-open (if outline--use-rtl 'outline-close-rtl 'outline-close)))))) @@ -1839,19 +1848,13 @@ outline--insert-button (overlay-put o 'face (plist-get icon 'face)) (overlay-put o 'follow-link 'mouse-face) (overlay-put o 'mouse-face 'highlight) - (overlay-put o 'keymap (define-keymap - "RET" #'outline-cycle - "" #'outline-cycle - ;; Need to override the global binding - ;; `mouse-appearance-menu' with : - "S-" #'ignore - "S-" #'outline-cycle-buffer))) + (overlay-put o 'keymap outline-inserted-button-map)) ('in-margins (overlay-put o 'before-string icon) - (overlay-put o 'keymap (define-keymap "RET" #'outline-cycle))) + (overlay-put o 'keymap outline-overlay-button-map)) (_ (overlay-put o 'before-string icon) - (overlay-put o 'keymap (define-keymap "RET" #'outline-cycle)))))))) + (overlay-put o 'keymap outline-overlay-button-map))))))) (defun outline--fix-up-all-buttons (&optional from to) (when outline-minor-mode-use-buttons commit e31a56239654a74b60e51f20799c8b09522082e4 Author: Juri Linkov Date: Tue Jan 24 20:24:15 2023 +0200 * lisp/vc/vc-bzr.el (vc-bzr--pushpull): Return buffer's process. * lisp/vc/vc-git.el (vc-git--pushpull): Add comment. * lisp/vc/vc.el (vc-pull-and-push): Expand docstring about prerequisites for backend to support this command (bug#60569). diff --git a/etc/NEWS b/etc/NEWS index 5da9a069736..b034dab7e61 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2080,7 +2080,7 @@ This is in addition to the old keybindings 'C-c C-n' and 'C-c C-p'. --- *** New command 'vc-pull-and-push'. This commands first does a "pull" command, and if that is successful, -does a "push" command afterwards. +does a "push" command afterwards. Currently supported in Git and Bzr. +++ *** 'C-x v b' prefix key is used now for branch commands. diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 6443f6d57aa..f66e37fffa4 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -381,7 +381,9 @@ vc-bzr--pushpull (setq-local compile-command (concat vc-bzr-program " " command " " (if args (mapconcat #'identity args " ") ""))))) - (vc-set-async-update buf)))) + (vc-set-async-update buf) + ;; Return the process for `vc-pull-and-push' + (get-buffer-process buf)))) (defun vc-bzr-pull (prompt) "Pull changes into the current Bzr branch. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 04aa37d6400..7ae763d2ee4 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1168,6 +1168,7 @@ vc-git--pushpull (lambda (_name-of-mode) buffer) nil)))) (vc-set-async-update buffer) + ;; Return the process for `vc-pull-and-push' proc)) (defun vc-git-pull (prompt) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index d4a3280f1bd..a181765eac3 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3064,7 +3064,8 @@ vc-pull-and-push operation on the current branch, prompting for the precise command if required. Optional prefix ARG non-nil forces a prompt for the VCS command to run. If this is successful, a \"push\" -operation will then be done. +operation will then be done. This is supported only in backends +where the pull operation returns a process. On a non-distributed version control system, this signals an error. It also signals an error in a Bazaar bound branch." commit deee3a92623ef6b2c879b99fd0dfa449ee4f420d Author: Michael Albinus Date: Tue Jan 24 18:27:57 2023 +0100 ; Fix last change in etc/NEWS diff --git a/etc/NEWS b/etc/NEWS index ec0c9650f76..5da9a069736 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1681,7 +1681,7 @@ command is installed. *** C++ Mode now supports most of the new features in the C++20 Standard. --- -*** In Objective C Mode, no extra types are recognized by default. +*** In Objective-C Mode, no extra types are recognized by default. The default value of 'objc-font-lock-extra-types' has been changed to nil, since too many identifiers were getting misfontified as types. This may cause some actual types not to get fontified. To get the old commit bc78285e6864f07212c21f70fe62ba06a647256b Author: Michael Albinus Date: Tue Jan 24 09:27:17 2023 +0100 ; * etc/NEWS: Fix typos. diff --git a/etc/NEWS b/etc/NEWS index dd026016382..ec0c9650f76 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1679,12 +1679,14 @@ command is installed. --- *** C++ Mode now supports most of the new features in the C++20 Standard. + --- -*** In objective-C Mode, the default value of -objc-font-lock-extra-types has been changed to nil, since too many -identifiers were getting misfontified as types. This may cause some -actual types not to get fontified. To get the old behavior back, -customize the variable to the value suggested in its doc string. +*** In Objective C Mode, no extra types are recognized by default. +The default value of 'objc-font-lock-extra-types' has been changed to +nil, since too many identifiers were getting misfontified as types. +This may cause some actual types not to get fontified. To get the old +behavior back, customize the user option to the value suggested in its +doc string. ** Cperl Mode commit c15c0f7f018f5beea02175603f45ff5edf6d3837 Author: Alan Mackenzie Date: Mon Jan 23 21:28:32 2023 +0000 CC Mode: Change the default value of objc-font-lock-extra-types to nil This fixes bug #59234, in which random identifiers in a .m file were getting fontified as types. * lisp/progmodes/cc-vars.el (objc-font-lock-extra-types): Change the default value to nil. * etc/NEWS: Mention the change in default value of objc-font-lock-extra-types, and how to get the old behavior back. diff --git a/etc/NEWS b/etc/NEWS index 64c26f93c50..dd026016382 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1679,6 +1679,12 @@ command is installed. --- *** C++ Mode now supports most of the new features in the C++20 Standard. +--- +*** In objective-C Mode, the default value of +objc-font-lock-extra-types has been changed to nil, since too many +identifiers were getting misfontified as types. This may cause some +actual types not to get fontified. To get the old behavior back, +customize the variable to the value suggested in its doc string. ** Cperl Mode diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 2206e0fcab6..60ed3521b8a 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1609,8 +1609,7 @@ c++-font-lock-extra-types :type 'c-extra-types-widget :group 'c) -(defcustom objc-font-lock-extra-types - (list (concat "[" c-upper "]\\sw*[" c-lower "]\\sw*")) +(defcustom objc-font-lock-extra-types nil (c-make-font-lock-extra-types-blurb "ObjC" "objc-mode" (concat "For example, a value of (\"[" c-upper "]\\\\sw*[" c-lower "]\\\\sw*\") means capitalized words are treated as type names (the requirement for a commit 29a8a1885d9f4825190d2575849f7605b3d6dffb Author: Alan Mackenzie Date: Mon Jan 23 20:25:53 2023 +0000 CC Mode: Don't do c-backward-syntactic-ws following a forward movement This was happening in, e.g., c-forward-type, which moves over whitespace at the end of the scanned type. This WS movement can exit a comment or a macro, such that a c-backward-syntactic-ws does not return to the desired point, but to before the entire comment/macro. * lisp/progmodes/cc-engine.el (c-forward-keyword-prefixed-id) (c-forward-id-comma-list, c-forward-noise-clause, c-forward-keyword-clause) (c-forward-name, c-forward-type): Add a new &optional parameter `stop-at-end' which when non-nil means "do not move over syntactic WS after performing the main job", and adapt the internals of these macros and functions accordingly. (c-forward-declarator, c-forward-decl-or-cast-1): In the calls to c-forward-type and c-forward-name, set the stop-at-end argument to t, and call c-forward-sytactic-ws later. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index ebcb20f0f8c..2ec83240360 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -8288,10 +8288,17 @@ c-record-ref-id (setq c-record-ref-identifiers (cons range c-record-ref-identifiers)))))) -(defmacro c-forward-keyword-prefixed-id (type) +(defmacro c-forward-keyword-prefixed-id (type &optional stop-at-end) ;; Used internally in `c-forward-keyword-clause' to move forward ;; over a type (if TYPE is 'type) or a name (otherwise) which ;; possibly is prefixed by keywords and their associated clauses. + ;; Point should be at the type/name or a preceding keyword at the start of + ;; the macro, and it is left at the first token following the type/name, + ;; or (when STOP-AT-END is non-nil) immediately after that type/name. + ;; + ;; Note that both parameters are evaluated at compile time, not run time, + ;; so they must be constants. + ;; ;; Try with a type/name first to not trip up on those that begin ;; with a keyword. Return t if a known or found type is moved ;; over. The point is clobbered if nil is returned. If range @@ -8300,51 +8307,84 @@ c-forward-keyword-prefixed-id ;; ;; This macro might do hidden buffer changes. (declare (debug t)) - `(let (res) + `(let (res pos) (setq c-last-identifier-range nil) (while (if (setq res ,(if (eq type 'type) - '(c-forward-type) - '(c-forward-name))) - nil - (cond ((looking-at c-keywords-regexp) - (c-forward-keyword-clause 1)) - ((and c-opt-cpp-prefix - (looking-at c-noise-macro-with-parens-name-re)) - (c-forward-noise-clause))))) + `(c-forward-type nil ,stop-at-end) + `(c-forward-name ,stop-at-end))) + (progn + (setq pos (point)) + nil) + (and + (cond ((looking-at c-keywords-regexp) + (c-forward-keyword-clause 1 t)) + ((and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) + (c-forward-noise-clause t))) + (progn + (setq pos (point)) + (c-forward-syntactic-ws) + t)))) (when (memq res '(t known found prefix maybe)) (when c-record-type-identifiers - ,(if (eq type 'type) - '(c-record-type-id c-last-identifier-range) - '(c-record-ref-id c-last-identifier-range))) + ,(if (eq type 'type) + '(c-record-type-id c-last-identifier-range) + '(c-record-ref-id c-last-identifier-range))) + (when pos + (goto-char pos) + ,(unless stop-at-end + `(c-forward-syntactic-ws))) t))) -(defmacro c-forward-id-comma-list (type update-safe-pos) +(defmacro c-forward-id-comma-list (type update-safe-pos &optional stop-at-end) ;; Used internally in `c-forward-keyword-clause' to move forward ;; over a comma separated list of types or names using - ;; `c-forward-keyword-prefixed-id'. + ;; `c-forward-keyword-prefixed-id'. Point should start at the first token + ;; after the already scanned type/name, or (if STOP-AT-END is non-nil) + ;; immediately after that type/name. Point is left either before or + ;; after the whitespace following the last type/name in the list, depending + ;; on whether STOP-AT-END is non-nil or nil. The return value is without + ;; significance. + ;; + ;; Note that all three parameters are evaluated at compile time, not run + ;; time, so they must be constants. ;; ;; This macro might do hidden buffer changes. (declare (debug t)) - `(while (and (progn - ,(when update-safe-pos - '(setq safe-pos (point))) - (eq (char-after) ?,)) - (progn - (forward-char) - (c-forward-syntactic-ws) - (c-forward-keyword-prefixed-id ,type))))) + `(let ((pos (point))) + (while (and (progn + ,(when update-safe-pos + `(setq safe-pos (point))) + (setq pos (point)) + (c-forward-syntactic-ws) + (eq (char-after) ?,)) + (progn + (forward-char) + (setq pos (point)) + (c-forward-syntactic-ws) + (c-forward-keyword-prefixed-id ,type t)))) + (goto-char pos) + ,(unless stop-at-end + `(c-forward-syntactic-ws)))) -(defun c-forward-noise-clause () +(defun c-forward-noise-clause (&optional stop-at-end) ;; Point is at a c-noise-macro-with-parens-names macro identifier. Go ;; forward over this name, any parenthesis expression which follows it, and - ;; any syntactic WS, ending up at the next token or EOB. If there is an + ;; any syntactic WS, ending up either at the next token or EOB or (when + ;; STOP-AT-END is non-nil) directly after the clause. If there is an ;; unbalanced paren expression, leave point at it. Always Return t. - (or (zerop (c-forward-token-2)) - (goto-char (point-max))) - (if (and (eq (char-after) ?\() - (c-go-list-forward)) + (let (pos) + (or (c-forward-over-token) + (goto-char (point-max))) + (setq pos (point)) + (c-forward-syntactic-ws) + (when (and (eq (char-after) ?\() + (c-go-list-forward)) + (setq pos (point))) + (goto-char pos) + (unless stop-at-end (c-forward-syntactic-ws)) - t) + t)) (defun c-forward-noise-clause-not-macro-decl (maybe-parens) ;; Point is at a noise macro identifier, which, when MAYBE-PARENS is @@ -8378,11 +8418,12 @@ c-forward-over-colon-type-list (goto-char here) nil))) -(defun c-forward-keyword-clause (match) +(defun c-forward-keyword-clause (match &optional stop-at-end) ;; Submatch MATCH in the current match data is assumed to surround a ;; token. If it's a keyword, move over it and any immediately - ;; following clauses associated with it, stopping at the start of - ;; the next token. t is returned in that case, otherwise the point + ;; following clauses associated with it, stopping either at the start + ;; of the next token, or (when STOP-AT-END is non-nil) at the end + ;; of the clause. t is returned in that case, otherwise the point ;; stays and nil is returned. The kind of clauses that are ;; recognized are those specified by `c-type-list-kwds', ;; `c-ref-list-kwds', `c-colon-type-list-kwds', @@ -8412,19 +8453,23 @@ c-forward-keyword-clause (when kwd-sym (goto-char (match-end match)) - (c-forward-syntactic-ws) (setq safe-pos (point)) + (c-forward-syntactic-ws) (cond ((and (c-keyword-member kwd-sym 'c-type-list-kwds) - (c-forward-keyword-prefixed-id type)) + (c-forward-keyword-prefixed-id type t)) ;; There's a type directly after a keyword in `c-type-list-kwds'. - (c-forward-id-comma-list type t)) + (setq safe-pos (point)) + (c-forward-syntactic-ws) + (c-forward-id-comma-list type t t)) ((and (c-keyword-member kwd-sym 'c-ref-list-kwds) - (c-forward-keyword-prefixed-id ref)) + (c-forward-keyword-prefixed-id ref t)) ;; There's a name directly after a keyword in `c-ref-list-kwds'. - (c-forward-id-comma-list ref t)) + (setq safe-pos (point)) + (c-forward-syntactic-ws) + (c-forward-id-comma-list ref t t)) ((and (c-keyword-member kwd-sym 'c-paren-any-kwds) (eq (char-after) ?\()) @@ -8444,20 +8489,20 @@ c-forward-keyword-clause (goto-char (match-end 0))))) (goto-char pos) - (c-forward-syntactic-ws) - (setq safe-pos (point)))) + (setq safe-pos (point))) + (c-forward-syntactic-ws)) ((and (c-keyword-member kwd-sym 'c-<>-sexp-kwds) (eq (char-after) ?<) (c-forward-<>-arglist (c-keyword-member kwd-sym 'c-<>-type-kwds))) - (c-forward-syntactic-ws) - (setq safe-pos (point))) + (setq safe-pos (point)) + (c-forward-syntactic-ws)) ((and (c-keyword-member kwd-sym 'c-nonsymbol-sexp-kwds) (not (looking-at c-symbol-start)) (c-safe (c-forward-sexp) t)) - (c-forward-syntactic-ws) - (setq safe-pos (point))) + (setq safe-pos (point)) + (c-forward-syntactic-ws)) ((and (c-keyword-member kwd-sym 'c-protection-kwds) (or (null c-post-protection-token) @@ -8467,8 +8512,8 @@ c-forward-keyword-clause (not (c-end-of-current-token)))))) (if c-post-protection-token (goto-char (match-end 0))) - (c-forward-syntactic-ws) - (setq safe-pos (point)))) + (setq safe-pos (point)) + (c-forward-syntactic-ws))) (when (c-keyword-member kwd-sym 'c-colon-type-list-kwds) (if (eq (char-after) ?:) @@ -8477,8 +8522,10 @@ c-forward-keyword-clause (progn (forward-char) (c-forward-syntactic-ws) - (when (c-forward-keyword-prefixed-id type) - (c-forward-id-comma-list type t))) + (when (c-forward-keyword-prefixed-id type t) + (setq safe-pos (point)) + (c-forward-syntactic-ws) + (c-forward-id-comma-list type t t))) ;; Not at the colon, so stop here. But the identifier ;; ranges in the type list later on should still be ;; recorded. @@ -8488,15 +8535,18 @@ c-forward-keyword-clause ;; this one, we move forward to the colon following the ;; clause matched above. (goto-char safe-pos) + (c-forward-syntactic-ws) (c-forward-over-colon-type-list)) (progn (c-forward-syntactic-ws) - (c-forward-keyword-prefixed-id type)) + (c-forward-keyword-prefixed-id type t)) ;; There's a type after the `c-colon-type-list-re' match ;; after a keyword in `c-colon-type-list-kwds'. (c-forward-id-comma-list type nil)))) (goto-char safe-pos) + (unless stop-at-end + (c-forward-syntactic-ws)) t))) ;; cc-mode requires cc-fonts. @@ -8827,11 +8877,12 @@ c-backward-<>-arglist (/= (point) start)))) -(defun c-forward-name () - ;; Move forward over a complete name if at the beginning of one, - ;; stopping at the next following token. A keyword, as such, - ;; doesn't count as a name. If the point is not at something that - ;; is recognized as a name then it stays put. +(defun c-forward-name (&optional stop-at-end) + ;; Move forward over a complete name if at the beginning of one, stopping + ;; either at the next following token or (when STOP-AT-END is non-nil) at + ;; the end of the name. A keyword, as such, doesn't count as a name. If + ;; the point is not at something that is recognized as a name then it stays + ;; put. ;; ;; A name could be something as simple as "foo" in C or something as ;; complex as "X::B, BIT_MAX >> b>, ::operator<> :: @@ -8853,7 +8904,7 @@ c-forward-name ;; ;; This function might do hidden buffer changes. - (let ((pos (point)) (start (point)) res id-start id-end + (let ((pos (point)) pos2 pos3 (start (point)) res id-start id-end ;; Turn off `c-promote-possible-types' here since we might ;; call `c-forward-<>-arglist' and we don't want it to promote ;; every suspect thing in the arglist to a type. We're @@ -8895,7 +8946,7 @@ c-forward-name (c-forward-syntactic-ws lim+) (cond ((eq (char-before id-end) ?e) ;; Got "... ::template". - (let ((subres (c-forward-name))) + (let ((subres (c-forward-name t))) (when subres (setq pos (point) res subres)))) @@ -8907,7 +8958,7 @@ c-forward-name (and (eq (c-forward-token-2) 0) (not (eq (char-after) ?\()))))) ;; Got a cast operator. - (when (c-forward-type) + (when (c-forward-type nil t) (setq pos (point) res 'operator) ;; Now we should match a sequence of either @@ -8931,8 +8982,8 @@ c-forward-name (forward-char) t))))) (while (progn - (c-forward-syntactic-ws lim+) (setq pos (point)) + (c-forward-syntactic-ws lim+) (and (<= (point) lim+) (looking-at c-opt-type-modifier-key))) @@ -8947,30 +8998,34 @@ c-forward-name ;; operator"" has an (?)optional tag after it. (progn (goto-char (match-end 0)) + (setq pos2 (point)) (c-forward-syntactic-ws lim+) (when (c-on-identifier) - (c-forward-token-2 1 nil lim+))) - (goto-char (match-end 0)) - (c-forward-syntactic-ws lim+)) - (setq pos (point) + (c-forward-over-token nil lim+))) + (goto-char (match-end 0)) + (setq pos2 (point)) + (c-forward-syntactic-ws lim+)) + (setq pos pos2 res 'operator))) nil) ;; `id-start' is equal to `id-end' if we've jumped over ;; an identifier that doesn't end with a symbol token. - ;; That can occur e.g. for Java import directives on the + ;; That can occur e.g. for Java import directives of the ;; form "foo.bar.*". (when (and id-start (/= id-start id-end)) (setq c-last-identifier-range (cons id-start id-end))) (goto-char id-end) + (setq pos (point)) (c-forward-syntactic-ws lim+) - (setq pos (point) - res t))) + (setq res t))) (progn (goto-char pos) + (c-forward-syntactic-ws lim+) + (setq pos3 (point)) (when (or c-opt-identifier-concat-key c-recognize-<>-arglists) @@ -8981,7 +9036,6 @@ c-forward-name ;; cases with tricky syntactic whitespace that aren't ;; covered in `c-identifier-key'. (goto-char (match-end 0)) - (c-forward-syntactic-ws lim+) t) ((and c-recognize-<>-arglists @@ -8993,11 +9047,12 @@ c-forward-name ;; `lim+'. (setq lim+ (c-determine-+ve-limit 500)) + (setq pos2 (point)) (c-forward-syntactic-ws lim+) (unless (eq (char-after) ?\() (setq c-last-identifier-range nil) - (c-add-type start (1+ pos))) - (setq pos (point)) + (c-add-type start (1+ pos3))) + (setq pos pos2) (if (and c-opt-identifier-concat-key (looking-at c-opt-identifier-concat-key)) @@ -9007,7 +9062,7 @@ c-forward-name (progn (when (and c-record-type-identifiers id-start) (c-record-ref-id (cons id-start id-end))) - (forward-char 2) + (goto-char (match-end 0)) (c-forward-syntactic-ws lim+) t) @@ -9019,11 +9074,14 @@ c-forward-name ))))) (goto-char pos) + (unless stop-at-end + (c-forward-syntactic-ws lim+)) res)) -(defun c-forward-type (&optional brace-block-too) +(defun c-forward-type (&optional brace-block-too stop-at-end) ;; Move forward over a type spec if at the beginning of one, - ;; stopping at the next following token. The keyword "typedef" + ;; stopping at the next following token (if STOP-AT-END is nil) or + ;; at the end of the type spec (otherwise). The keyword "typedef" ;; isn't part of a type spec here. ;; ;; BRACE-BLOCK-TOO, when non-nil, means move over the brace block in @@ -9072,6 +9130,7 @@ c-forward-type (when (looking-at c-no-type-key) (setq res 'no-id))) (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws) (or (eq res 'no-id) (setq res 'prefix)))) @@ -9080,32 +9139,41 @@ c-forward-type (cond ((looking-at c-typeof-key) ; e.g. C++'s "decltype". (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws) (setq res (and (eq (char-after) ?\() (c-safe (c-forward-sexp)) 'decltype)) (if res - (c-forward-syntactic-ws) + (progn + (setq pos (point)) + (c-forward-syntactic-ws)) (goto-char start))) ((looking-at c-type-prefix-key) ; e.g. "struct", "class", but NOT ; "typedef". (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws) (while (cond ((looking-at c-decl-hangon-key) - (c-forward-keyword-clause 1)) + (c-forward-keyword-clause 1 t) + (setq pos (point)) + (c-forward-syntactic-ws)) ((looking-at c-pack-key) (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws)) ((and c-opt-cpp-prefix (looking-at c-noise-macro-with-parens-name-re)) - (c-forward-noise-clause)))) + (c-forward-noise-clause t) + (setq pos (point)) + (c-forward-syntactic-ws)))) + (setq id-start (point)) + (setq name-res (c-forward-name t)) (setq pos (point)) - - (setq name-res (c-forward-name)) (setq res (not (null name-res))) (when (eq name-res t) ;; With some keywords the name can be used without the prefix, so we @@ -9113,21 +9181,21 @@ c-forward-type (when (save-excursion (goto-char post-prefix-pos) (looking-at c-self-contained-typename-key)) - (c-add-type pos (save-excursion - (c-backward-syntactic-ws) - (point)))) + (c-add-type id-start + (point))) (when (and c-record-type-identifiers c-last-identifier-range) (c-record-type-id c-last-identifier-range))) + (c-forward-syntactic-ws) (when (and brace-block-too (memq res '(t nil)) (eq (char-after) ?\{) (save-excursion (c-safe (progn (c-forward-sexp) - (c-forward-syntactic-ws) (setq pos (point)))))) (goto-char pos) + (c-forward-syntactic-ws) (setq res t)) (unless res (goto-char start))) ; invalid syntax @@ -9141,7 +9209,7 @@ c-forward-type (if (looking-at c-identifier-start) (save-excursion (setq id-start (point) - name-res (c-forward-name)) + name-res (c-forward-name t)) (when name-res (setq id-end (point) id-range c-last-identifier-range)))) @@ -9154,8 +9222,9 @@ c-forward-type (>= (save-excursion (save-match-data (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws) - (setq pos (point)))) + pos)) id-end) (setq res nil))))) ;; Looking at a primitive or known type identifier. We've @@ -9163,7 +9232,7 @@ c-forward-type ;; known type match only is a prefix of another name. (setq id-end (match-end 1)) - + (when (and c-record-type-identifiers (or c-promote-possible-types (eq res t))) (c-record-type-id (cons (match-beginning 1) (match-end 1)))) @@ -9173,35 +9242,41 @@ c-forward-type (looking-at c-opt-type-component-key))) ;; There might be more keywords for the type. (let (safe-pos) - (c-forward-keyword-clause 1) + (c-forward-keyword-clause 1 t) (while (progn (setq safe-pos (point)) + (c-forward-syntactic-ws) (looking-at c-opt-type-component-key)) (when (and c-record-type-identifiers (looking-at c-primitive-type-key)) (c-record-type-id (cons (match-beginning 1) (match-end 1)))) - (c-forward-keyword-clause 1)) + (c-forward-keyword-clause 1 t)) (if (looking-at c-primitive-type-key) (progn (when c-record-type-identifiers (c-record-type-id (cons (match-beginning 1) (match-end 1)))) - (c-forward-keyword-clause 1) + (c-forward-keyword-clause 1 t) (setq res t)) (goto-char safe-pos) - (setq res 'prefix))) - (unless (save-match-data (c-forward-keyword-clause 1)) + (setq res 'prefix)) + (setq pos (point))) + (if (save-match-data (c-forward-keyword-clause 1 t)) + (setq pos (point)) (if pos (goto-char pos) (goto-char (match-end 1)) - (c-forward-syntactic-ws))))) + (setq pos (point))))) + (c-forward-syntactic-ws)) ((and (eq name-res t) (eq res 'prefix) (c-major-mode-is 'c-mode) (save-excursion (goto-char id-end) + (setq pos (point)) + (c-forward-syntactic-ws) (and (not (looking-at c-symbol-start)) (not (looking-at c-type-decl-prefix-key))))) ;; A C specifier followed by an implicit int, e.g. @@ -9213,13 +9288,11 @@ c-forward-type (cond ((eq name-res t) ;; A normal identifier. (goto-char id-end) + (setq pos (point)) (if (or res c-promote-possible-types) (progn (when (not (eq c-promote-possible-types 'just-one)) - (c-add-type id-start (save-excursion - (goto-char id-end) - (c-backward-syntactic-ws) - (point)))) + (c-add-type id-start id-end)) (when (and c-record-type-identifiers id-range) (c-record-type-id id-range)) (unless res @@ -9233,6 +9306,7 @@ c-forward-type ((eq name-res 'template) ;; A template is sometimes a type. (goto-char id-end) + (setq pos (point)) (c-forward-syntactic-ws) (setq res (if (eq (char-after) ?\() @@ -9258,6 +9332,7 @@ c-forward-type (when c-opt-type-modifier-key (while (looking-at c-opt-type-modifier-key) ; e.g. "const", "volatile" (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws) (setq res t))) @@ -9268,11 +9343,13 @@ c-forward-type (when c-opt-type-suffix-key ; e.g. "..." (while (looking-at c-opt-type-suffix-key) (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws))) ;; Skip any "WS" identifiers (e.g. "final" or "override" in C++) (while (looking-at c-type-decl-suffix-ws-ids-key) (goto-char (match-end 1)) + (setq pos (point)) (c-forward-syntactic-ws) (setq res t)) @@ -9296,8 +9373,9 @@ c-forward-type (progn (goto-char (match-end 1)) (c-forward-syntactic-ws) - (setq subres (c-forward-type)))) - + (setq subres (c-forward-type nil t)) + (setq pos (point)))) + (progn ;; If either operand certainly is a type then both are, but we ;; don't let the existence of the operator itself promote two @@ -9332,9 +9410,11 @@ c-forward-type ;; `nconc' doesn't mind that the tail of ;; `c-record-found-types' is t. (nconc c-record-found-types - c-record-type-identifiers)))) + c-record-type-identifiers))))))) - (goto-char pos)))) + (goto-char pos) + (unless stop-at-end + (c-forward-syntactic-ws)) (when (and c-record-found-types (memq res '(known found)) id-range) (setq c-record-found-types @@ -9737,7 +9817,7 @@ c-forward-declarator ;; (e.g. "," or ";" or "}"). (let ((here (point)) id-start id-end brackets-after-id paren-depth decorated - got-init arglist double-double-quote) + got-init arglist double-double-quote pos) (or limit (setq limit (point-max))) (if (and (< (point) limit) @@ -9771,6 +9851,7 @@ c-forward-declarator (eq (char-after (1+ (point))) ?\")) (setq double-double-quote t)) (goto-char (match-end 0)) + (setq pos (point)) (c-forward-syntactic-ws limit) (setq got-identifier t) nil) @@ -9783,7 +9864,10 @@ c-forward-declarator ;; prefix only if it specifies a member pointer. (progn (setq id-start (point)) - (when (c-forward-name) + (when (c-forward-name t) + (setq pos (point)) + (c-forward-syntactic-ws limit) + (if (save-match-data (looking-at "\\(::\\)")) ;; We only check for a trailing "::" and @@ -9812,10 +9896,12 @@ c-forward-declarator (setq id-start (point))) (cond ((or got-identifier - (c-forward-name)) - (save-excursion - (c-backward-syntactic-ws) - (setq id-end (point)))) + (c-forward-name t)) + (setq id-end + (or pos + (point))) + (c-forward-syntactic-ws limit) + t) (accept-anon (setq id-start nil id-end nil) t) @@ -10569,11 +10655,11 @@ c-forward-decl-or-cast-1 (or got-identifier (and (looking-at c-identifier-start) (setq pos (point)) - (setq got-identifier (c-forward-name)) + (setq got-identifier (c-forward-name t)) (save-excursion - (c-backward-syntactic-ws) (c-simple-skip-symbol-backward) (setq identifier-start (point))) + (progn (c-forward-syntactic-ws) t) (setq name-start pos)) (when (looking-at "[0-9]") (setq got-number t)) ; We probably have an arithmetic expression. @@ -10796,8 +10882,7 @@ c-forward-decl-or-cast-1 type-start (progn (goto-char type-start) - (c-forward-type) - (c-backward-syntactic-ws) + (c-forward-type nil t) (point))))))))) ;; Got a declaration of the form "foo bar (gnu);" or "bar ;; (gnu);" where we've recognized "bar" as the type and "gnu" @@ -11121,8 +11206,7 @@ c-forward-decl-or-cast-1 (space-after-type (save-excursion (goto-char type-start) - (and (c-forward-type) - (progn (c-backward-syntactic-ws) t) + (and (c-forward-type nil t) (or (eolp) (memq (char-after) '(?\ ?\t))))))) (when (not (eq (not space-before-id) commit 7f438ff543b7bd83cee6c75be1d16abc1215d37f Author: Jim Porter Date: Sun Jan 22 22:54:53 2023 -0800 Don't try to make a pipe process for remote processes in Eshell Tramp currently isn't able to handle this, so the result will just produce an error (bug#61024). * lisp/eshell/esh-proc.el (eshell-gather-process-output): Check for a remote 'default-directory' before trying to make a pipe process. * test/lisp/eshell/esh-proc-tests.el (esh-var-test/output/remote-redirect): New test. diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index f1ec3a905b6..fcd59ab9f37 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -296,8 +296,13 @@ eshell-gather-process-output 'unix)))) (cond ((fboundp 'make-process) - (unless (equal (car (aref eshell-current-handles eshell-output-handle)) - (car (aref eshell-current-handles eshell-error-handle))) + (unless (or ;; FIXME: It's not currently possible to use a + ;; stderr process for remote files. + (file-remote-p default-directory) + (equal (car (aref eshell-current-handles + eshell-output-handle)) + (car (aref eshell-current-handles + eshell-error-handle)))) (eshell-protect-handles eshell-current-handles) (setq stderr-proc (make-pipe-process diff --git a/test/lisp/eshell/esh-proc-tests.el b/test/lisp/eshell/esh-proc-tests.el index ae7b1dddd69..8e02fbb5497 100644 --- a/test/lisp/eshell/esh-proc-tests.el +++ b/test/lisp/eshell/esh-proc-tests.el @@ -19,6 +19,7 @@ ;;; Code: +(require 'tramp) (require 'ert) (require 'esh-mode) (require 'eshell) @@ -85,6 +86,18 @@ esh-proc-test/output/stdout-and-stderr-to-buffer "\\`\\'")) (should (equal (buffer-string) "stdout\nstderr\n")))) +(ert-deftest esh-var-test/output/remote-redirect () + "Check that redirecting stdout for a remote process works." + (skip-unless (and (eshell-tests-remote-accessible-p) + (executable-find "echo"))) + (let ((default-directory ert-remote-temporary-file-directory)) + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "*echo hello > #<%s>" bufname) + "\\`\\'")) + (should (equal (buffer-string) "hello\n"))))) + ;; Exit status commit 3e62ddc0d87dfceb67af49c5f1caee4d03fc33b8 Author: Robert Pluim Date: Mon Jan 23 14:42:11 2023 +0100 ; * lisp/calendar/appt.el (appt-check): Fix byte-compile warning diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index a209623b65e..49597739446 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -409,7 +409,7 @@ appt-check 'face 'mode-line-emphasis) " "))) ;; Reset count to 0 in case we display another appt on the next cycle. - (setq appt-display-count (if (eq '(0) min-list) 0 + (setq appt-display-count (if (equal '(0) min-list) 0 (1+ prev-appt-display-count)))) ;; If we have changed the mode line string, redisplay all mode lines. (and appt-display-mode-line commit cb9628373a8dcb5ace0cb8fcc7b636dea39b5703 Author: Eli Zaretskii Date: Mon Jan 23 15:09:07 2023 +0200 * lisp/startup.el (command-line): Fix warning message. (Bug#61014) diff --git a/lisp/startup.el b/lisp/startup.el index cd1654f28cd..bb6250d3968 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1604,7 +1604,7 @@ command-line (display-warning 'initialization (format-message "\ Your `load-path' seems to contain\n\ -your `.emacs.d' directory: %s\n\ +your `user-emacs-directory': %s\n\ This is likely to cause problems...\n\ Consider using a subdirectory instead, e.g.: %s" dir (expand-file-name commit b88d47beb00da7b302aaf757be611f200ae803b3 Author: Theodor Thornhill Date: Sun Jan 22 19:17:41 2023 +0100 Swap tag and element in html-ts-mode (bug#60972) * lisp/textmodes/html-ts-mode.el: New values for 'treesit-sentence-type-regexp' and 'treesit-sexp-type-regexp'. diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index a2d85bff7d6..58dcc7d8cad 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el @@ -106,10 +106,10 @@ html-ts-mode (setq-local treesit-defun-name-function #'html-ts-mode--defun-name) - (setq-local treesit-sentence-type-regexp "element") + (setq-local treesit-sentence-type-regexp "tag") (setq-local treesit-sexp-type-regexp - (regexp-opt '("tag" + (regexp-opt '("element" "text" "attribute" "value"))) commit 860c3aada5dc4ab3c1a894c66b160202fda950d2 Author: Robert Pluim Date: Mon Jan 23 11:33:23 2023 +0100 ; * lisp/eshell/esh-arg.el (eshell-prepare-splice): Fix quoting. diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index c17a8fb8c4f..6c882471aee 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -554,8 +554,9 @@ eshell-prepare-splice ((list arg-1) (list arg-2) spliced-arg-3 ...) This allows callers of this function to build the final spliced -list by concatenating each element together, e.g. with (apply -#'append grouped-list). +list by concatenating each element together, e.g. with + + (apply #\\='append grouped-list) If no argument requested a splice, return nil." (let* ((splicep nil) commit 85e330433230d8a4a2be6b40b730530a86b61cf4 Author: Michael Albinus Date: Mon Jan 23 11:02:56 2023 +0100 Factor out some Tramp code * lisp/net/tramp-compat.el (tramp-file-name-handler): Don't declare. * lisp/net/tramp.el (tramp-skeleton-file-truename) (tramp-skeleton-handle-make-symbolic-link): New defmacros. (tramp-handle-file-truename): * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link) (tramp-sh-handle-file-truename): * lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-truename) (tramp-sudoedit-handle-make-symbolic-link): Use them. * lisp/net/tramp.el (tramp-call-process, tramp-call-process-region): Let-bind `temporary-file-directory'. * test/lisp/net/tramp-tests.el (tramp-action-yesno): Suppress run in tests. (tramp-test21-file-links, tramp-test29-start-file-process) (tramp-test30-make-process, tramp-test42-utf8): Adapt tests. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 95d22c4e144..01f1c38988c 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -37,7 +37,6 @@ (require 'subr-x) (declare-function tramp-error "tramp") -(declare-function tramp-file-name-handler "tramp") (declare-function tramp-tramp-file-p "tramp") (defvar tramp-temp-name-prefix) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 46b1f612101..25bc59eb4ff 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1132,119 +1132,55 @@ tramp-sh-file-name-handler-alist (defun tramp-sh-handle-make-symbolic-link (target linkname &optional ok-if-already-exists) - "Like `make-symbolic-link' for Tramp files. -If TARGET is a non-Tramp file, it is used verbatim as the target -of the symlink. If TARGET is a Tramp file, only the localname -component is used as the target of the symlink." - (with-parsed-tramp-file-name (expand-file-name linkname) nil - ;; If TARGET is a Tramp name, use just the localname component. - ;; Don't check for a proper method. - (let ((non-essential t)) - (when (and (tramp-tramp-file-p target) - (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target)))) - ;; There could be a cyclic link. - (tramp-flush-file-properties - v (expand-file-name target (tramp-file-local-name default-directory)))) - - ;; If TARGET is still remote, quote it. - (if (tramp-tramp-file-p target) - (make-symbolic-link - (file-name-quote target 'top) linkname ok-if-already-exists) - - (let ((ln (tramp-get-remote-ln v)) - (cwd (tramp-run-real-handler - #'file-name-directory (list localname)))) - (unless ln - (tramp-error - v 'file-error - (concat "Making a symbolic link. " - "ln(1) does not exist on the remote host."))) - - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not - (yes-or-no-p - (format - "File %s already exists; make it a link anyway?" - localname))))) - (tramp-error v 'file-already-exists localname) - (delete-file linkname))) - - (tramp-flush-file-properties v localname) - - ;; Right, they are on the same host, regardless of user, - ;; method, etc. We now make the link on the remote machine. - ;; This will occur as the user that TARGET belongs to. - (and (tramp-send-command-and-check - v (format "cd %s" (tramp-shell-quote-argument cwd))) - (tramp-send-command-and-check - v (format - "%s -sf %s %s" ln - (tramp-shell-quote-argument target) - ;; The command could exceed PATH_MAX, so we use - ;; relative file names. However, relative file names - ;; could start with "-". - ;; `tramp-shell-quote-argument' does not handle this, - ;; we must do it ourselves. - (tramp-shell-quote-argument - (concat "./" (file-name-nondirectory localname)))))))))) + "Like `make-symbolic-link' for Tramp files." + (let ((v (tramp-dissect-file-name (expand-file-name linkname)))) + (unless (tramp-get-remote-ln v) + (tramp-error + v 'file-error + (concat "Making a symbolic link. " + "ln(1) does not exist on the remote host.")))) + + (tramp-skeleton-handle-make-symbolic-link target linkname ok-if-already-exists + (and (tramp-send-command-and-check + v (format + "cd %s" + (tramp-shell-quote-argument (file-name-directory localname)))) + (tramp-send-command-and-check + v (format + "%s -sf %s %s" (tramp-get-remote-ln v) + (tramp-shell-quote-argument target) + ;; The command could exceed PATH_MAX, so we use relative + ;; file names. + (tramp-shell-quote-argument + (concat "./" (file-name-nondirectory localname)))))))) (defun tramp-sh-handle-file-truename (filename) "Like `file-truename' for Tramp files." - ;; Preserve trailing "/". - (funcall - (if (directory-name-p filename) #'file-name-as-directory #'identity) - ;; Quote properly. - (funcall - (if (file-name-quoted-p filename) #'file-name-quote #'identity) - (with-parsed-tramp-file-name - (file-name-unquote (expand-file-name filename)) nil - (tramp-make-tramp-file-name - v - (with-tramp-file-property v localname "file-truename" - (tramp-message v 4 "Finding true name for `%s'" filename) - (let ((result - (cond - ;; Use GNU readlink --canonicalize-missing where available. - ((tramp-get-remote-readlink v) - (tramp-send-command-and-check - v (format "%s --canonicalize-missing %s" - (tramp-get-remote-readlink v) - (tramp-shell-quote-argument localname))) - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (buffer-substring (point-min) (line-end-position)))) - - ;; Use Perl implementation. - ((and (tramp-get-remote-perl v) - (tramp-get-connection-property v "perl-file-spec") - (tramp-get-connection-property v "perl-cwd-realpath")) - (tramp-maybe-send-script - v tramp-perl-file-truename "tramp_perl_file_truename") - (tramp-send-command-and-read - v (format "tramp_perl_file_truename %s" - (tramp-shell-quote-argument localname)))) - - ;; Do it yourself. - (t (tramp-file-local-name - (tramp-handle-file-truename filename)))))) - - ;; Detect cycle. - (when (and (file-symlink-p filename) - (string-equal result localname)) - (tramp-error - v 'file-error - "Apparent cycle of symbolic links for %s" filename)) - ;; If the resulting localname looks remote, we must quote it - ;; for security reasons. - (when (file-remote-p result) - (setq result (file-name-quote result 'top))) - (tramp-message v 4 "True name of `%s' is `%s'" localname result) - result))))))) + (tramp-skeleton-file-truename filename + (cond + ;; Use GNU readlink --canonicalize-missing where available. + ((tramp-get-remote-readlink v) + (tramp-send-command-and-check + v (format "%s --canonicalize-missing %s" + (tramp-get-remote-readlink v) + (tramp-shell-quote-argument localname))) + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (buffer-substring (point-min) (line-end-position)))) + + ;; Use Perl implementation. + ((and (tramp-get-remote-perl v) + (tramp-get-connection-property v "perl-file-spec") + (tramp-get-connection-property v "perl-cwd-realpath")) + (tramp-maybe-send-script + v tramp-perl-file-truename "tramp_perl_file_truename") + (tramp-send-command-and-read + v (format "tramp_perl_file_truename %s" + (tramp-shell-quote-argument localname)))) + + ;; Do it yourself. + (t (tramp-file-local-name + (tramp-handle-file-truename filename)))))) ;; Basic functions. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 9d03490f1d5..a9cec17f536 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1175,51 +1175,21 @@ tramp-smb-handle-make-directory (tramp-error v 'file-error "Couldn't make directory %s" dir)))) (defun tramp-smb-handle-make-symbolic-link - (target linkname &optional ok-if-already-exists) - "Like `make-symbolic-link' for Tramp files. -If TARGET is a non-Tramp file, it is used verbatim as the target -of the symlink. If TARGET is a Tramp file, only the localname -component is used as the target of the symlink." - (with-parsed-tramp-file-name linkname nil - ;; If TARGET is a Tramp name, use just the localname component. - ;; Don't check for a proper method. - (let ((non-essential t)) - (when (and (tramp-tramp-file-p target) - (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target))))) - - ;; If TARGET is still remote, quote it. - (if (tramp-tramp-file-p target) - (make-symbolic-link - (file-name-quote target 'top) linkname ok-if-already-exists) + (target linkname &optional ok-if-already-exists) + "Like `make-symbolic-link' for Tramp files." + (let ((v (tramp-dissect-file-name (expand-file-name linkname)))) + (unless (tramp-smb-get-cifs-capabilities v) + (tramp-error v 'file-error "make-symbolic-link not supported"))) - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not (yes-or-no-p - (format - "File %s already exists; make it a link anyway?" - localname))))) - (tramp-error v 'file-already-exists localname) - (delete-file linkname))) - - (unless (tramp-smb-get-cifs-capabilities v) - (tramp-error v 'file-error "make-symbolic-link not supported")) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) - - (unless (tramp-smb-send-command - v (format "symlink %s %s" - (tramp-smb-shell-quote-argument target) - (tramp-smb-shell-quote-localname v))) - (tramp-error - v 'file-error - "error with make-symbolic-link, see buffer `%s' for details" - (tramp-get-connection-buffer v)))))) + (tramp-skeleton-handle-make-symbolic-link target linkname ok-if-already-exists + (unless (tramp-smb-send-command + v (format "symlink %s %s" + (tramp-smb-shell-quote-argument target) + (tramp-smb-shell-quote-localname v))) + (tramp-error + v 'file-error + "error with make-symbolic-link, see buffer `%s' for details" + (tramp-get-connection-buffer v))))) (defun tramp-smb-handle-process-file (program &optional infile destination display &rest args) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index db7ac842871..486a22a60e1 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -568,33 +568,9 @@ tramp-sudoedit-handle-set-file-times (defun tramp-sudoedit-handle-file-truename (filename) "Like `file-truename' for Tramp files." - ;; Preserve trailing "/". - (funcall - (if (directory-name-p filename) #'file-name-as-directory #'identity) - ;; Quote properly. - (funcall - (if (file-name-quoted-p filename) #'file-name-quote #'identity) - (with-parsed-tramp-file-name - (file-name-unquote (expand-file-name filename)) nil - (tramp-make-tramp-file-name - v - (with-tramp-file-property v localname "file-truename" - (let (result) - (tramp-message v 4 "Finding true name for `%s'" filename) - (setq result (tramp-sudoedit-send-command-string - v "readlink" "--canonicalize-missing" localname)) - ;; Detect cycle. - (when (and (file-symlink-p filename) - (string-equal result localname)) - (tramp-error - v 'file-error - "Apparent cycle of symbolic links for %s" filename)) - ;; If the resulting localname looks remote, we must quote it - ;; for security reasons. - (when (file-remote-p result) - (setq result (file-name-quote result 'top))) - (tramp-message v 4 "True name of `%s' is `%s'" localname result) - result))))))) + (tramp-skeleton-file-truename filename + (tramp-sudoedit-send-command-string + v "readlink" "--canonicalize-missing" localname))) (defun tramp-sudoedit-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." @@ -622,41 +598,12 @@ tramp-sudoedit-handle-make-directory (defun tramp-sudoedit-handle-make-symbolic-link (target linkname &optional ok-if-already-exists) - "Like `make-symbolic-link' for Tramp files. -If TARGET is a non-Tramp file, it is used verbatim as the target -of the symlink. If TARGET is a Tramp file, only the localname -component is used as the target of the symlink." - (with-parsed-tramp-file-name (expand-file-name linkname) nil - ;; If TARGET is a Tramp name, use just the localname component. - ;; Don't check for a proper method. - (let ((non-essential t)) - (when (and (tramp-tramp-file-p target) - (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target))))) - - ;; If TARGET is still remote, quote it. - (if (tramp-tramp-file-p target) - (make-symbolic-link - (file-name-quote target 'top) linkname ok-if-already-exists) - - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not - (yes-or-no-p - (format - "File %s already exists; make it a link anyway?" - localname))))) - (tramp-error v 'file-already-exists localname) - (delete-file linkname))) - - (tramp-flush-file-properties v localname) - (tramp-sudoedit-send-command - v "ln" "-sf" - (file-name-unquote target) - (file-name-unquote localname))))) + "Like `make-symbolic-link' for Tramp files." + (tramp-skeleton-handle-make-symbolic-link target linkname ok-if-already-exists + (tramp-sudoedit-send-command + v "ln" "-sf" + (file-name-unquote target) + (file-name-unquote localname)))) (defun tramp-sudoedit-handle-rename-file (filename newname &optional ok-if-already-exists) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 5e2428bb034..dcc6f05979f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3529,6 +3529,35 @@ tramp-skeleton-file-local-copy ;; Trigger the `file-missing' error. (signal 'error nil))))) +(defmacro tramp-skeleton-file-truename (filename &rest body) + "Skeleton for `tramp-*-handle-file-truename'. +BODY is the backend specific code." + (declare (indent 1) (debug (form body))) + ;; Preserve trailing "/". + `(funcall + (if (directory-name-p ,filename) #'file-name-as-directory #'identity) + ;; Quote properly. + (funcall + (if (file-name-quoted-p ,filename) #'file-name-quote #'identity) + (with-parsed-tramp-file-name + (file-name-unquote (expand-file-name ,filename)) nil + (tramp-make-tramp-file-name + v + (with-tramp-file-property v localname "file-truename" + (let (result) + (setq result (progn ,@body)) + ;; Detect cycle. + (when (and (file-symlink-p ,filename) + (string-equal result localname)) + (tramp-error + v 'file-error + "Apparent cycle of symbolic links for %s" ,filename)) + ;; If the resulting localname looks remote, we must quote + ;; it for security reasons. + (when (file-remote-p result) + (setq result (file-name-quote result 'top))) + result))))))) + (defmacro tramp-skeleton-make-directory (dir &optional parents &rest body) "Skeleton for `tramp-*-handle-make-directory'. BODY is the backend specific code." @@ -3550,6 +3579,49 @@ tramp-skeleton-make-directory ,@body nil)))) +(defmacro tramp-skeleton-handle-make-symbolic-link + (target linkname &optional ok-if-already-exists &rest body) + "Skeleton for `tramp-*-handle-make-symbolic-link'. +BODY is the backend specific code. +If TARGET is a non-Tramp file, it is used verbatim as the target +of the symlink. If TARGET is a Tramp file, only the localname +component is used as the target of the symlink if it is located +on the same host. Otherwise, TARGET is quoted." + (declare (indent 3) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,linkname) nil + ;; If TARGET is a Tramp name, use just the localname component. + ;; Don't check for a proper method. + (let ((non-essential t)) + (when (and (tramp-tramp-file-p ,target) + (tramp-file-name-equal-p v (tramp-dissect-file-name ,target))) + (setq ,target (tramp-file-local-name (expand-file-name ,target)))) + ;; There could be a cyclic link. + (tramp-flush-file-properties + v (expand-file-name ,target (tramp-file-local-name default-directory)))) + + ;; If TARGET is still remote, quote it. + (if (tramp-tramp-file-p ,target) + (make-symbolic-link + (file-name-quote ,target 'top) ,linkname ,ok-if-already-exists) + + ;; Do the 'confirm if exists' thing. + (when (file-exists-p ,linkname) + ;; What to do? + (if (or (null ,ok-if-already-exists) ; not allowed to exist + (and (numberp ,ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway?" + localname))))) + (tramp-error v 'file-already-exists localname) + (delete-file ,linkname))) + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v localname) + + ,@body))) + (defmacro tramp-skeleton-set-file-modes-times-uid-gid (filename &rest body) "Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'. @@ -4091,13 +4163,8 @@ tramp-handle-file-symlink-p (defun tramp-handle-file-truename (filename) "Like `file-truename' for Tramp files." - ;; Preserve trailing "/". - (funcall - (if (directory-name-p filename) #'file-name-as-directory #'identity) - ;; Quote properly. - (funcall - (if (file-name-quoted-p filename) #'file-name-quote #'identity) - (let ((result (file-name-unquote (expand-file-name filename))) + (tramp-skeleton-file-truename filename + (let ((result (directory-file-name localname)) (numchase 0) ;; Don't make the following value larger than necessary. ;; People expect an error message in a timely fashion when @@ -4107,31 +4174,21 @@ tramp-handle-file-truename ;; Unquoting could enable encryption. tramp-crypt-enabled symlink-target) - (with-parsed-tramp-file-name result v1 - ;; We cache only the localname. - (tramp-make-tramp-file-name - v1 - (with-tramp-file-property v1 v1-localname "file-truename" - (while (and (setq symlink-target (file-symlink-p result)) - (< numchase numchase-limit)) - (setq numchase (1+ numchase) - result - (with-parsed-tramp-file-name (expand-file-name result) v2 - (tramp-make-tramp-file-name - v2 - (if (stringp symlink-target) - (if (file-remote-p symlink-target) - (file-name-quote symlink-target 'top) - (tramp-drop-volume-letter - (expand-file-name - symlink-target - (file-name-directory v2-localname)))) - v2-localname)))) - (when (>= numchase numchase-limit) - (tramp-error - v1 'file-error - "Maximum number (%d) of symlinks exceeded" numchase-limit))) - (tramp-file-local-name (directory-file-name result))))))))) + (while (and (setq symlink-target + (file-symlink-p (tramp-make-tramp-file-name v result))) + (< numchase numchase-limit)) + (setq numchase (1+ numchase) + result + (if (file-remote-p symlink-target) + (file-name-quote symlink-target 'top) + (tramp-drop-volume-letter + (expand-file-name + symlink-target (file-name-directory result))))) + (when (>= numchase numchase-limit) + (tramp-error + v 'file-error + "Maximum number (%d) of symlinks exceeded" numchase-limit))) + (directory-file-name result)))) (defun tramp-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." @@ -6346,6 +6403,7 @@ tramp-call-process PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." (let ((default-directory tramp-compat-temporary-file-directory) + (temporary-file-directory tramp-compat-temporary-file-directory) (process-environment (default-toplevel-value 'process-environment)) (destination (if (eq destination t) (current-buffer) destination)) (vec (or vec (car tramp-current-connection))) @@ -6378,6 +6436,7 @@ tramp-call-process-region PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." (let ((default-directory tramp-compat-temporary-file-directory) + (temporary-file-directory tramp-compat-temporary-file-directory) (process-environment (default-toplevel-value 'process-environment)) (buffer (if (eq buffer t) (current-buffer) buffer)) result) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 60545e7270f..59e160c9d71 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -165,6 +165,9 @@ remote-file-name-inhibit-delete-by-moving-to-trash ;; Suppress nasty messages. (fset #'shell-command-sentinel #'ignore) ;; We do not want to be interrupted. + (fset #'tramp-action-yesno + (lambda (_proc vec) + (tramp-send-string vec (concat "yes" tramp-local-end-of-line)) t)) (eval-after-load 'tramp-gvfs '(fset 'tramp-gvfs-handler-askquestion (lambda (_message _choices) '(t nil 0))))) @@ -4173,6 +4176,10 @@ tramp-test21-file-links (should (file-symlink-p tmp-name1)) (should-not (file-regular-p tmp-name1)) (should-not (file-regular-p tmp-name2)) + (should + (string-equal + (file-truename tmp-name1) + (file-truename tmp-name2))) (if (tramp--test-smb-p) ;; The symlink command of "smbclient" detects the ;; cycle already. @@ -4180,10 +4187,15 @@ tramp-test21-file-links (make-symbolic-link tmp-name1 tmp-name2) :type 'file-error) (make-symbolic-link tmp-name1 tmp-name2) + (should (file-symlink-p tmp-name1)) (should (file-symlink-p tmp-name2)) + (should-not (file-regular-p tmp-name1)) (should-not (file-regular-p tmp-name2)) (should-error (file-truename tmp-name1) + :type 'file-error) + (should-error + (file-truename tmp-name2) :type 'file-error)))) ;; Cleanup. @@ -4920,13 +4932,10 @@ tramp-test29-start-file-process (while (accept-process-output proc 0 nil t)))) (should (string-match-p - (if (and (memq process-connection-type '(nil pipe)) - (not (tramp--test-macos-p))) - ;; On macOS, there is always newline conversion. - ;; "telnet" converts \r to if `crlf' - ;; flag is FALSE. See telnet(1) man page. - (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n") - (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n")) + ;; On macOS, there is always newline conversion. + ;; "telnet" converts \r to if `crlf' + ;; flag is FALSE. See telnet(1) man page. + (rx "66\n" "6F\n" "6F\n" (| "0D\n" "0A\n") (? "00\n") "0A\n") (buffer-string)))) ;; Cleanup. @@ -5210,14 +5219,10 @@ tramp-test30-make-process (while (accept-process-output proc 0 nil t)))) (should (string-match-p - (if (and (memq (or connection-type process-connection-type) - '(nil pipe)) - (not (tramp--test-macos-p))) - ;; On macOS, there is always newline conversion. - ;; "telnet" converts \r to if `crlf' - ;; flag is FALSE. See telnet(1) man page. - (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n") - (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n")) + ;; On macOS, there is always newline conversion. + ;; "telnet" converts \r to if `crlf' + ;; flag is FALSE. See telnet(1) man page. + (rx "66\n" "6F\n" "6F\n" (| "0D\n" "0A\n") (? "00\n") "0A\n") (buffer-string)))) ;; Cleanup. @@ -7063,6 +7068,9 @@ tramp-test42-utf8 ;; Use all available language specific snippets. (lambda (x) (and + ;; The "Oriya" and "Odia" languages use some problematic + ;; composition characters. + (not (member (car x) '("Oriya" "Odia"))) (stringp (setq x (eval (get-language-info (car x) 'sample-text) t))) ;; Filter out strings which use unencodable characters. (not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p)) commit 26ef5c09e0a0b13c02e34d858f32c09b42d26dff Author: Robert Pluim Date: Tue Jan 3 17:09:53 2023 +0100 Add `yes-or-no-prompt' user option This implements Bug#60312 * src/fns.c (syms_of_fns): Define `yes-or-no-prompt' Lisp variable. (Fyes_or_no_p): Use `yes-or-no-prompt' instead of a hard-coded string. * lisp/cus-start.el (standard): Add custom specification for it. * doc/emacs/mini.texi (Yes or No Prompts): Document `yes-or-no-prompt' * doc/lispref/minibuf.texi (Yes-or-No Queries): And here. * etc/NEWS: Announce the new option. diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 6fb312ec321..898d9e904f6 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -953,12 +953,14 @@ Yes or No Prompts @end smallexample @cindex yes or no prompt +@vindex yes-or-no-prompt The second type of yes-or-no query is typically employed if giving the wrong answer would have serious consequences; it thus features a -longer prompt ending with @samp{(yes or no)}. For example, if you -invoke @kbd{C-x k} (@code{kill-buffer}) on a file-visiting buffer with -unsaved changes, Emacs activates the minibuffer with a prompt like -this: +longer prompt ending with @samp{(yes or no)} (or the value of +@code{yes-or-no-prompt} if you've customized that). For example, if +you invoke @kbd{C-x k} (@code{kill-buffer}) on a file-visiting buffer +with unsaved changes, Emacs activates the minibuffer with a prompt +like this: @smallexample Buffer foo.el modified; kill anyway? (yes or no) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 114e5d38a80..4b957a68401 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2233,10 +2233,12 @@ Yes-or-No Queries @code{nil} if the user types @samp{no}. The user must type @key{RET} to finalize the response. Upper and lower case are equivalent. -@code{yes-or-no-p} starts by displaying @var{prompt} in the minibuffer, -followed by @w{@samp{(yes or no) }}. The user must type one of the -expected responses; otherwise, the function responds @samp{Please answer -yes or no.}, waits about two seconds and repeats the request. +@vindex yes-or-no-prompt +@code{yes-or-no-p} starts by displaying @var{prompt} in the +minibuffer, followed by the value of @code{yes-or-no-prompt} @w{(default +@samp{(yes or no) })}. The user must type one of the expected +responses; otherwise, the function responds @w{@samp{Please answer yes or +no.}}, waits about two seconds and repeats the request. @code{yes-or-no-p} requires more work from the user than @code{y-or-n-p} and is appropriate for more crucial decisions. diff --git a/etc/NEWS b/etc/NEWS index 10e91ec4ab9..5b8ab06086c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -50,6 +50,12 @@ as it has in batch mode since Emacs 24. When non-nil, this option suppresses moving remote files to the local trash when deleting. Default is nil. ++++ +** New user option 'yes-or-no-prompt'. +This allows the user to customize the prompt that is appended by +'yes-or-no-p' when asking questions. The default value is +"(yes or no) ". + * Editing Changes in Emacs 30.1 diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 054683d7cf6..6ca7d7fcafd 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -310,6 +310,7 @@ minibuffer-prompt-properties--setter (const :tag "Off" :value nil) (const :tag "On" :value t) (const :tag "Auto-raise" :value auto-raise)) "26.1") + (yes-or-no-prompt menu string "30.1") ;; fontset.c ;; FIXME nil is the initial value, fontset.el setqs it. (vertical-centering-font-regexp display diff --git a/src/fns.c b/src/fns.c index d8bd7d318b0..59d5b5c0850 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3182,13 +3182,14 @@ DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, Return t if answer is yes, and nil if the answer is no. PROMPT is the string to display to ask the question; `yes-or-no-p' -adds \"(yes or no) \" to it. +appends `yes-or-no-prompt' (default \"(yes or no) \") to it. The user must confirm the answer with RET, and can edit it until it has been confirmed. If the `use-short-answers' variable is non-nil, instead of asking for -\"yes\" or \"no\", this function will ask for \"y\" or \"n\". +\"yes\" or \"no\", this function will ask for \"y\" or \"n\" (and +ignore the value of `yes-or-no-prompt'). If dialog boxes are supported, a dialog box will be used if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) @@ -3213,8 +3214,7 @@ DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0, if (use_short_answers) return call1 (intern ("y-or-n-p"), prompt); - AUTO_STRING (yes_or_no, "(yes or no) "); - prompt = CALLN (Fconcat, prompt, yes_or_no); + prompt = CALLN (Fconcat, prompt, Vyes_or_no_prompt); specpdl_ref count = SPECPDL_INDEX (); specbind (Qenable_recursive_minibuffers, Qt); @@ -6265,9 +6265,15 @@ syms_of_fns (void) We recommend against setting this variable non-nil, because `yes-or-no-p' is intended to be used when users are expected not to respond too quickly, but to take their time and perhaps think about the answer. -The same variable also affects the function `read-answer'. */); +The same variable also affects the function `read-answer'. See also +`yes-or-no-prompt'. */); use_short_answers = false; + DEFVAR_LISP ("yes-or-no-prompt", Vyes_or_no_prompt, + doc: /* String to append when `yes-or-no-p' asks a question. +For best results this should end in a space. */); + Vyes_or_no_prompt = make_unibyte_string ("(yes or no) ", strlen ("(yes or no) ")); + defsubr (&Sidentity); defsubr (&Srandom); defsubr (&Slength); commit e6c5f32e77dceed4e26b16889cc56547093bdc45 Author: Juri Linkov Date: Mon Jan 23 09:55:29 2023 +0200 * lisp/find-dired.el (find-dired): Fix bug where M-p skips first history item. Don't apply "skip first duplicate history item" trick when find-args used as initial input is nil. diff --git a/lisp/find-dired.el b/lisp/find-dired.el index 9fa139a8025..33376ee4ed9 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -177,7 +177,9 @@ find-dired man page for \"find\"." (interactive (list (read-directory-name "Run find in directory: " nil "" t) (read-string "Run find (with args): " find-args - '(find-args-history . 1)))) + (if find-args + '(find-args-history . 1) + 'find-args-history)))) (setq find-args args ; save for next interactive call args (concat find-program " . " (if (string= args "") commit 114912254262ce412f30e43e3798c750a752b741 Merge: 9c8e82484ab 647cc9c65e7 Author: Stefan Kangas Date: Mon Jan 23 06:30:18 2023 +0100 Merge from origin/emacs-29 647cc9c65e7 Update to Org 9.6.1-16-ge37e9b commit 647cc9c65e7c2b691267bde7333eff6cc8d9132a Author: Kyle Meyer Date: Sun Jan 22 21:53:39 2023 -0500 Update to Org 9.6.1-16-ge37e9b diff --git a/doc/misc/org.org b/doc/misc/org.org index 7ca2cce9e7f..14699e77395 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -8788,7 +8788,9 @@ a ~day~, ~week~, ~month~ or ~year~. For weekly agendas, the default is to start on the previous Monday (see ~org-agenda-start-on-weekday~). You can also set the start date using a date shift: =(setq org-agenda-start-day "+10d")= starts the agenda -ten days from today in the future. +ten days from today in the future. ~org-agenda-start-on-weekday~ +takes precedence over ~org-agenda-start-day~ in weekly and bi-weekly +agendas. Remote editing from the agenda buffer means, for example, that you can change the dates of deadlines and appointments from the agenda buffer. diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 93cdf6ae868..3f6696fce77 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -3277,7 +3277,7 @@ org-babel-temporary-stable-directory (while (or (not dir) (file-exists-p dir)) (setq dir (expand-file-name (format "babel-stable-%d" (random 1000)) - (temporary-file-directory)))) + temporary-file-directory))) (make-directory dir) dir)) "Directory to hold temporary files created to execute code blocks. diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 66b08adf535..2d194ad3413 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -54,6 +54,7 @@ (require 'org) (require 'org-macs) (require 'org-refile) +(require 'org-element) (declare-function diary-add-to-list "diary-lib" (date string specifier &optional marker globcolor literal)) @@ -80,11 +81,6 @@ (declare-function org-columns-quit "org-colview" ()) (declare-function diary-date-display-form "diary-lib" (&optional type)) (declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element--cache-active-p "org-element" - (&optional called-from-cache-change-func-p)) -(declare-function org-element-lineage "org-element" - (datum &optional types with-self)) (declare-function org-habit-insert-consistency-graphs "org-habit" (&optional line)) (declare-function org-is-habit-p "org-habit" (&optional pom)) @@ -95,8 +91,6 @@ (declare-function org-capture "org-capture" (&optional goto keys)) (declare-function org-clock-modify-effort-estimate "org-clock" (&optional value)) -(declare-function org-element-type "org-element" (&optional element)) - (defvar calendar-mode-map) (defvar org-clock-current-task) (defvar org-current-tag-alist) @@ -1184,7 +1178,9 @@ org-agenda-start-on-weekday "Non-nil means start the overview always on the specified weekday. 0 denotes Sunday, 1 denotes Monday, etc. When nil, always start on the current day. -Custom commands can set this variable in the options section." +Custom commands can set this variable in the options section. + +This variable only applies when agenda spans either 7 or 14 days." :group 'org-agenda-daily/weekly :type '(choice (const :tag "Today" nil) (integer :tag "Weekday No."))) @@ -4357,7 +4353,10 @@ org-agenda-start-day Custom commands can set this variable in the options section. This is usually a string like \"2007-11-01\", \"+2d\" or any other input allowed when reading a date through the Org calendar. -See the docstring of `org-read-date' for details.") +See the docstring of `org-read-date' for details. + +This variable has no effect when `org-agenda-start-on-weekday' is set +and agenda spans 7 or 14 days.") (defvar org-starting-day nil) ; local variable in the agenda buffer (defvar org-arg-loc nil) ; local variable diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 4e72141cdc9..55372e5649b 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -1800,17 +1800,25 @@ org-clock-timestamps-change (time-subtract (org-time-string-to-time org-last-changed-timestamp) (org-time-string-to-time ts))) - (save-excursion - (goto-char begts) - (org-timestamp-change - (round (/ (float-time tdiff) - (pcase timestamp? - (`minute 60) - (`hour 3600) - (`day (* 24 3600)) - (`month (* 24 3600 31)) - (`year (* 24 3600 365.2))))) - timestamp? 'updown))))))) + ;; `save-excursion' won't work because + ;; `org-timestamp-change' deletes and re-inserts the + ;; timestamp. + (let ((origin (point))) + (save-excursion + (goto-char begts) + (org-timestamp-change + (round (/ (float-time tdiff) + (pcase timestamp? + (`minute 60) + (`hour 3600) + (`day (* 24 3600)) + (`month (* 24 3600 31)) + (`year (* 24 3600 365.2))))) + timestamp? 'updown)) + ;; Move back to initial position, but never beyond updated + ;; clock. + (unless (< (point) origin) + (goto-char origin)))))))) ;;;###autoload (defun org-clock-cancel () diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index f787fb1f713..389acf82500 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -2382,7 +2382,9 @@ org-element-fixed-width-parser (defun org-element-fixed-width-interpreter (fixed-width _) "Interpret FIXED-WIDTH element as Org syntax." (let ((value (org-element-property :value fixed-width))) - (and value (replace-regexp-in-string "^" ": " value)))) + (and value + (if (string-empty-p value) ":\n" + (replace-regexp-in-string "^" ": " value))))) ;;;; Horizontal Rule diff --git a/lisp/org/org-fold-core.el b/lisp/org/org-fold-core.el index 0855e6f39ce..027ff921581 100644 --- a/lisp/org/org-fold-core.el +++ b/lisp/org/org-fold-core.el @@ -1003,7 +1003,13 @@ org-fold-core-region (overlay-put o (org-fold-core--property-symbol-get-create spec) spec) (overlay-put o 'invisible spec) (overlay-put o 'isearch-open-invisible #'org-fold-core--isearch-show) - (overlay-put o 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary)) + ;; FIXME: Disabling to work around Emacs bug#60399 + ;; and https://orgmode.org/list/87zgb6tk6h.fsf@localhost. + ;; The proper fix will require making sure that + ;; `org-fold-core-isearch-open-function' does not + ;; delete the overlays used by isearch. + ;; (overlay-put o 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary) + ) (put-text-property from to (org-fold-core--property-symbol-get-create spec) spec) (put-text-property from to 'isearch-open-invisible #'org-fold-core--isearch-show) (put-text-property from to 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary) @@ -1131,16 +1137,9 @@ org-fold-core--clear-isearch-state "Clear `org-fold-core--isearch-local-regions'." (clrhash org-fold-core--isearch-local-regions)) -(defun org-fold-core--isearch-show (region) - "Reveal text in REGION found by isearch. -REGION can also be an overlay in current buffer." - (when (overlayp region) - (setq region (cons (overlay-start region) - (overlay-end region)))) - (org-with-point-at (car region) - (while (< (point) (cdr region)) - (funcall org-fold-core-isearch-open-function (car region)) - (goto-char (org-fold-core-next-visibility-change (point) (cdr region) 'ignore-hidden))))) +(defun org-fold-core--isearch-show (_) + "Reveal text at point found by isearch." + (funcall org-fold-core-isearch-open-function (point))) (defun org-fold-core--isearch-show-temporary (region hide-p) "Temporarily reveal text in REGION. diff --git a/lisp/org/org-persist.el b/lisp/org/org-persist.el index 336496efbfb..a0652b99c56 100644 --- a/lisp/org/org-persist.el +++ b/lisp/org/org-persist.el @@ -160,6 +160,8 @@ (declare-function org-next-visible-heading "org" (arg)) (declare-function org-at-heading-p "org" (&optional invisible-not-ok)) +;; Silence byte-compiler (used in `org-persist--write-elisp-file'). +(defvar pp-use-max-width) (defconst org-persist--storage-version "3.1" "Persistent storage layout version.") @@ -335,7 +337,8 @@ org-persist--write-elisp-file (make-directory (file-name-directory file) t)) (with-temp-file file (if pp - (pp data (current-buffer)) + (let ((pp-use-max-width nil)) ; Emacs bug#58687 + (pp data (current-buffer))) (prin1 data (current-buffer)))) (org-persist--display-time (- (float-time) start-time) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index fac9e68c124..5116b1127f7 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1229,7 +1229,7 @@ org-table-blank-field (if (looking-at "|[^|\n]+") (let* ((pos (match-beginning 0)) (match (match-string 0)) - (len (org-string-width match))) + (len (save-match-data (org-string-width match)))) (replace-match (concat "|" (make-string (1- len) ?\ ))) (goto-char (+ 2 pos)) (substring match 1))))) @@ -1725,8 +1725,12 @@ org-table-clean-line (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s "")) (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) (setq s (replace-match - (concat "|" (make-string (org-string-width (match-string 1 s)) - ?\ ) "|") + (concat "|" + (make-string + (save-match-data + (org-string-width (match-string 1 s))) + ?\ ) + "|") t t s))) s)) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 43d50e4387f..22f952d7a30 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -11,7 +11,7 @@ org-release (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.6.1")) + (let ((org-git-version "release_9.6.1-16-ge37e9b")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index 869ff16a6da..153e860f9a5 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -7,7 +7,7 @@ ;; Maintainer: Bastien Guerry ;; Keywords: outlines, hypermedia, calendar, wp ;; URL: https://orgmode.org -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "26.1")) ;; Version: 9.6.1 diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el index 1c233a266a1..949c8f9b5b2 100644 --- a/lisp/org/ox-odt.el +++ b/lisp/org/ox-odt.el @@ -2935,7 +2935,7 @@ org-odt-plain-text (trailing (and (string-match (rx (1+ blank) eos) output) (match-string 0 output)))) ;; Unfill, retaining leading/trailing space. - (let ((fill-column (point-max))) + (let ((fill-column most-positive-fixnum)) (fill-region (point-min) (point-max))) (concat leading (buffer-string) trailing)))))) ;; Return value. diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 12767267a71..65f9ff18279 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -3040,7 +3040,7 @@ org-export-as ;; This way, we will be able to retrieve its export ;; options when calling ;; `org-export--get-subtree-options'. - (backward-char) + (when (bolp) (backward-char)) (narrow-to-region (point) (point-max)))) ;; Initialize communication channel with original buffer ;; attributes, unavailable in its copy. @@ -6407,7 +6407,7 @@ org-export-dictionary ("nb" :default "Innhold") ("nn" :default "Innhald") ("pl" :html "Spis treści") - ("pt_BR" :html "Índice" :utf8 "Índice" :ascii "Indice") + ("pt_BR" :html "Índice" :utf-8 "Índice" :ascii "Indice") ("ro" :default "Cuprins") ("ru" :html "Содержание" :utf-8 "Содержание") commit 9c8e82484ab6744b9d3540895d9dc8b6929439e5 Merge: b767a641c8f b3814b43f60 Author: Stefan Kangas Date: Mon Jan 23 02:09:15 2023 +0100 Merge from origin/emacs-29 b3814b43f60 (ruby-ts--predefined-variables): Fix the $` and $' entries db02cbdfe02 * lisp/find-dired.el (find-dired-with-command): Quote fin... 2343a067c3d Generalize vc-pull-and-push to support more backends (bug... 846838dbab8 Add test suite for sgml-html-meta-auto-coding-function 0fb90f524db Fix decoding HTML files from archives c854ef7a187 ; Fix last change (bug#60556). 8e83604dfe0 Avoid crashes in batch Emacs sub-processes on MS-Windows 808e101fabe Tweak BSD style indentation (bug#60984) 204519a2e73 Fix typo of exposed symbol name 9296e0c6495 Fix typo after move to common lib (bug#61001) e74ba72a6a3 ruby-ts-mode: Fix two additional cases with ruby-method-c... ae7e28a4372 ruby-mode.el: Expand some docstrings with examples 89cb3c3f157 Minor fixes for Haiku 6adc193ad66 Move c-like common utils into own library (bug#60961) # Conflicts: # lisp/progmodes/typescript-ts-mode.el commit b767a641c8fb1f06326de4598ef717014c16a334 Merge: 080595682f7 161706ec331 Author: Stefan Kangas Date: Mon Jan 23 01:34:43 2023 +0100 ; Merge from origin/emacs-29 The following commit was skipped: 161706ec331 ; Actually use dummy package descriptor commit 080595682f73a920b9c9bf3eba10548ccc652e79 Merge: 1c58f3d7fb2 b875c9bf67e Author: Stefan Kangas Date: Mon Jan 23 01:34:43 2023 +0100 Merge from origin/emacs-29 b875c9bf67e Fix file-regular-p in Tramp 63fa225d443 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/... 9f5d6c541e5 ; * doc/emacs/custom.texi (Init Rebinding): Fix wording i... a91b435d0d5 ; Reword user documentation on binding keys in Lisp 0400de6a7de Fix typo in c-ts-mode (bug#60932) commit 1c58f3d7fb298f9ee6aa8554d6537d13cb1944a5 Merge: 0805972e4ca 0400de6a7de Author: Stefan Kangas Date: Mon Jan 23 01:34:43 2023 +0100 ; Merge from origin/emacs-29 The following commit was skipped: 0400de6a7de Fix typo in c-ts-mode (bug#60932) commit 0805972e4cab3493d172edf2e303486d7c3cb386 Merge: 8febda46c45 b3de81a6ee3 Author: Stefan Kangas Date: Mon Jan 23 01:34:39 2023 +0100 Merge from origin/emacs-29 b3de81a6ee3 MH-E: handle removal of mhparam libdir from nmh 1.8 d63e1a89518 Use point-min to anchor top-level constructs (bug#60602) 34793337783 * lisp/org/ob-ruby.el: Fix outdated comments. 472f1425985 ; ruby-ts-mode: Add a Version tag 0cf053648a4 ; ruby-ts-mode: Update font-lock features list in Commentary 67ee627c38d (project-try-vc): Add string-start and string-end anchors... 06953fc8e1d Make `keymap-set-after' work for menus dcd59457b48 Use `key-parse' in `keymap-lookup' 8904a26a9d2 Improve `keymap-set-after' documentation c7e02eaa3d9 Handle after arg correctly in `keymap-set-after' 628b6241763 Don't load erc-goodies atop erc.el 40cf494b7ce ; * etc/NEWS: Fix typos. 6b2f85caa6c Make tree-sitter based modes optional b56cf28b325 ; (ruby-ts--predefined-variables): Make it a little shorter d94dc606a09 ruby-ts-mode: Claw back half of the performance drop from... d0d34514097 (ruby-ts-mode): Rename 'builtin-functions' to 'builtin-fu... d66ac5285f7 ruby-ts-mode: Highlight builtin methods 370b1ac99ec ; ruby-ts-mode.el: Add customize-group mention to commentary 7b7b2b95138 Fix c-ts-mode indent (bug#60873) 7ca71d66dc7 Fix various problems in treesit-explore-mode (bug#60800) b7d6bb47ee5 ; * lisp/treesit.el (treesit-font-lock-fontify-region): M... 0c6bfeddb21 ; Update tree-sitter major mode manual c289786886b ; Add commentary and dostring in c-ts-mode # Conflicts: # etc/NEWS # lisp/progmodes/c-ts-mode.el # lisp/progmodes/go-ts-mode.el commit b3814b43f6017d48bde2ddd12821e83948ee19dc Author: Dmitry Gutov Date: Sun Jan 22 20:50:54 2023 +0200 (ruby-ts--predefined-variables): Fix the $` and $' entries * lisp/progmodes/ruby-ts-mode.el (ruby-ts--predefined-variables): Fix the $` and $' entries, somehow replaced by curly quote. Reported by Mattias Engdegård. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 7e5125453e8..eff846f8585 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -128,7 +128,7 @@ ruby-ts--predefined-constants (defvar ruby-ts--predefined-variables (rx string-start - (or "$!" "$@" "$~" "$&" "$‘" "$‘" "$+" "$=" "$/" "$\\" "$," "$;" + (or "$!" "$@" "$~" "$&" "$`" "$'" "$+" "$=" "$/" "$\\" "$," "$;" "$." "$<" "$>" "$_" "$*" "$$" "$?" "$:" "$LOAD_PATH" "$LOADED_FEATURES" "$DEBUG" "$FILENAME" "$stderr" "$stdin" "$stdout" "$VERBOSE" "$-a" "$-i" "$-l" "$-p" commit db02cbdfe0214ed968e14319051506add08ca17b Author: Juri Linkov Date: Sun Jan 22 19:51:51 2023 +0200 * lisp/find-dired.el (find-dired-with-command): Quote find-command-history. diff --git a/lisp/find-dired.el b/lisp/find-dired.el index 83bdaba5352..9fa139a8025 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -209,7 +209,7 @@ find-dired-with-command " . \\( \\) " (find-dired--escaped-ls-option)) (+ 1 (length find-program) (length " . \\( "))) - find-command-history))) + 'find-command-history))) (let ((dired-buffers dired-buffers)) ;; Expand DIR ("" means default-directory), and make sure it has a ;; trailing slash. commit 2343a067c3de65a7e7b85b1ca4d83147b8f6b647 Author: Juri Linkov Date: Sun Jan 22 19:27:10 2023 +0200 Generalize vc-pull-and-push to support more backends (bug#60569) * lisp/vc/vc-git.el (vc-git-pull-and-push): Remove and move its logic to vc-pull-and-push. * lisp/vc/vc.el (vc-pull-and-push): Add code from vc-git-pull-and-push. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 06bf927831d..04aa37d6400 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1182,25 +1182,6 @@ vc-git-push for the Git command to run." (vc-git--pushpull "push" prompt nil)) -(defun vc-git-pull-and-push (prompt) - "Pull changes into the current Git branch, and then push. -The push will only be performed if the pull was successful. - -Normally, this runs \"git pull\". If PROMPT is non-nil, prompt -for the Git command to run." - (let ((proc (vc-git--pushpull "pull" prompt '("--stat")))) - (when (process-buffer proc) - (with-current-buffer (process-buffer proc) - (if (and (eq (process-status proc) 'exit) - (zerop (process-exit-status proc))) - (let ((vc--inhibit-async-window t)) - (vc-git-push nil)) - (vc-exec-after - (lambda () - (let ((vc--inhibit-async-window t)) - (vc-git-push nil))) - proc)))))) - (defun vc-git-merge-branch () "Merge changes into the current Git branch. This prompts for a branch to merge from." diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index f105461b210..d4a3280f1bd 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3071,9 +3071,20 @@ vc-pull-and-push (interactive "P") (let* ((vc-fileset (vc-deduce-fileset t)) (backend (car vc-fileset))) - (if (vc-find-backend-function backend 'pull-and-push) - (vc-call-backend backend 'pull-and-push arg) - (user-error "VC pull-and-push is unsupported for `%s'" backend)))) + (if (vc-find-backend-function backend 'pull) + (let ((proc (vc-call-backend backend 'pull arg))) + (when (and (processp proc) (process-buffer proc)) + (with-current-buffer (process-buffer proc) + (if (and (eq (process-status proc) 'exit) + (zerop (process-exit-status proc))) + (let ((vc--inhibit-async-window t)) + (vc-push arg)) + (vc-exec-after + (lambda () + (let ((vc--inhibit-async-window t)) + (vc-push arg))) + proc))))) + (user-error "VC pull is unsupported for `%s'" backend)))) (defun vc-version-backup-file (file &optional rev) "Return name of backup file for revision REV of FILE. commit 846838dbab8ebe7fb9e4b90c1077dd5a89f95686 Author: Benjamin Riefenstahl Date: Tue Jan 17 20:13:39 2023 +0200 Add test suite for sgml-html-meta-auto-coding-function * test/lisp/international/mule-tests.el (sgml-html-meta-pre) (sgml-html-meta-post, sgml-html-meta-run, sgml-html-meta-utf-8) (sgml-html-meta-windows-hebrew, sgml-html-meta-none) (sgml-html-meta-unknown-coding, sgml-html-meta-no-pre) (sgml-html-meta-no-post-less-than-10lines) (sgml-html-meta-no-post-10lines, sgml-html-meta-utf-8-with-bom): Add. diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el index 4f70b275848..6e23d8c5421 100644 --- a/test/lisp/international/mule-tests.el +++ b/test/lisp/international/mule-tests.el @@ -70,6 +70,72 @@ mule-hz ;; The chinese-hz encoding is not ASCII compatible. (should-not (coding-system-get 'chinese-hz :ascii-compatible-p))) +;;; Testing `sgml-html-meta-auto-coding-function'. + +(defconst sgml-html-meta-pre "" + "The beginning of a minimal HTML document.") + +(defconst sgml-html-meta-post "" + "The end of a minimal HTML document.") + +(defun sgml-html-meta-run (coding-system) + "Run `sgml-html-meta-auto-coding-function' on a minimal HTML. +When CODING-SYSTEM is not nil, insert it, wrapped in a '' +element. When CODING-SYSTEM contains HTML meta characters or +white space, insert it as-is, without additional formatting. Use +the variables `sgml-html-meta-pre' and `sgml-html-meta-post' to +provide HTML fragments. Some tests override those variables." + (with-temp-buffer + (insert sgml-html-meta-pre + (cond ((not coding-system) + "") + ((string-match "[<>'\"\n ]" coding-system) + coding-system) + (t + (format "" coding-system))) + sgml-html-meta-post) + (goto-char (point-min)) + (sgml-html-meta-auto-coding-function (- (point-max) (point-min))))) + +(ert-deftest sgml-html-meta-utf-8 () + "Baseline: UTF-8." + (should (eq 'utf-8 (sgml-html-meta-run "utf-8")))) + +(ert-deftest sgml-html-meta-windows-hebrew () + "A non-Unicode charset." + (should (eq 'windows-1255 (sgml-html-meta-run "windows-1255")))) + +(ert-deftest sgml-html-meta-none () + (should (eq nil (sgml-html-meta-run nil)))) + +(ert-deftest sgml-html-meta-unknown-coding () + (should (eq nil (sgml-html-meta-run "XXX")))) + +(ert-deftest sgml-html-meta-no-pre () + "Without the prefix, so not HTML." + (let ((sgml-html-meta-pre "")) + (should (eq nil (sgml-html-meta-run "utf-8"))))) + +(ert-deftest sgml-html-meta-no-post-less-than-10lines () + "No '', detect charset in the first 10 lines." + (let ((sgml-html-meta-post "")) + (should (eq 'utf-8 (sgml-html-meta-run + (concat "\n\n\n\n\n\n\n\n\n" + "")))))) + +(ert-deftest sgml-html-meta-no-post-10lines () + "No '', do not detect charset after the first 10 lines." + (let ((sgml-html-meta-post "")) + (should (eq nil (sgml-html-meta-run + (concat "\n\n\n\n\n\n\n\n\n\n" + "")))))) + +(ert-deftest sgml-html-meta-utf-8-with-bom () + "Requesting 'UTF-8' does not override `utf-8-with-signature'. +Check fix for Bug#20623." + (let ((buffer-file-coding-system 'utf-8-with-signature)) + (should (eq 'utf-8-with-signature (sgml-html-meta-run "utf-8"))))) + ;; Stop "Local Variables" above causing confusion when visiting this file. commit 0fb90f524dbacf487bc9b9c2737e0ae3db5a3818 Author: Benjamin Riefenstahl Date: Tue Jan 17 20:08:15 2023 +0200 Fix decoding HTML files from archives * lisp/international/mule.el (sgml-xml-auto-coding-function): Avoid signaling an error from coding-system-equal when the XML encoding tag specifies an encoding whose type is 'charset'. (Bug#61005) This is the same fix as in #df7ed10e for sgml-xml-auto-coding-function. diff --git a/lisp/international/mule.el b/lisp/international/mule.el index eddd7b6407a..52019697ad7 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -2540,6 +2540,10 @@ sgml-html-meta-auto-coding-function (bfcs-type (coding-system-type buffer-file-coding-system))) (if (and enable-multibyte-characters + ;; 'charset' will signal an error in + ;; coding-system-equal, since it isn't a + ;; coding-system. So test that up front. + (not (equal sym-type 'charset)) (coding-system-equal 'utf-8 sym-type) (coding-system-equal 'utf-8 bfcs-type)) buffer-file-coding-system commit c854ef7a187a579ab1dc7e022a841b59c4361ebf Author: Eli Zaretskii Date: Sun Jan 22 15:12:05 2023 +0200 ; Fix last change (bug#60556). diff --git a/src/w32.c b/src/w32.c index 213fee15699..8d344d2e6da 100644 --- a/src/w32.c +++ b/src/w32.c @@ -10536,18 +10536,19 @@ shutdown_handler (DWORD type) /* Shut down cleanly, making sure autosave files are up to date. */ shut_down_emacs (0, Qnil); } - { - /* This handler is run in a thread different from the main - thread. (This is the normal situation when we are killed - by Emacs, for example, which sends us the WM_CLOSE - message). We cannot possibly call functions like - shut_down_emacs or clear_message_stack in that case, since - the main (a.k.a. "Lisp") thread could be in the middle of - some Lisp program. So instead we arrange for maybe_quit to - kill Emacs. */ - Vquit_flag = Qkill_emacs; - Vinhibit_quit = Qnil; - } + else + { + /* This handler is run in a thread different from the main + thread. (This is the normal situation when we are killed + by Emacs, for example, which sends us the WM_CLOSE + message). We cannot possibly call functions like + shut_down_emacs or clear_message_stack in that case, + since the main (a.k.a. "Lisp") thread could be in the + middle of some Lisp program. So instead we arrange for + maybe_quit to kill Emacs. */ + Vquit_flag = Qkill_emacs; + Vinhibit_quit = Qnil; + } } /* Allow other handlers to handle this signal. */ commit 8e83604dfe01e0ea56569c1bc129ecbc67583447 Author: Eli Zaretskii Date: Sun Jan 22 15:07:55 2023 +0200 Avoid crashes in batch Emacs sub-processes on MS-Windows * src/w32.c (shutdown_handler): When run in a separate thread, don't call functions that only the main (a.k.a. "Lisp") thread can call; instead, arrange for maybe_quit to kill Emacs. * src/w32fns.c (emacs_abort): Don't show GUI Abort dialogs in non-interactive sessions. (Bug#60556) diff --git a/src/w32.c b/src/w32.c index 47d79abc5b0..213fee15699 100644 --- a/src/w32.c +++ b/src/w32.c @@ -10509,10 +10509,13 @@ init_ntproc (int dumping) } } -/* - shutdown_handler ensures that buffers' autosave files are - up to date when the user logs off, or the system shuts down. -*/ +/* shutdown_handler ensures that buffers' autosave files are up to + date when the user logs off, or the system shuts down. It also + shuts down Emacs when we get killed by another Emacs process, in + which case we get the CTRL_CLOSE_EVENT. */ + +extern DWORD dwMainThreadId; + static BOOL WINAPI shutdown_handler (DWORD type) { @@ -10521,15 +10524,30 @@ shutdown_handler (DWORD type) || type == CTRL_LOGOFF_EVENT /* User logs off. */ || type == CTRL_SHUTDOWN_EVENT) /* User shutsdown. */ { - /* If we are being shut down in noninteractive mode, we don't - care about the message stack, so clear it to avoid abort in - shut_down_emacs. This happens when an noninteractive Emacs - is invoked as a subprocess of Emacs, and the parent wants to - kill us, e.g. because it's about to exit. */ - if (noninteractive) - clear_message_stack (); - /* Shut down cleanly, making sure autosave files are up to date. */ - shut_down_emacs (0, Qnil); + if (GetCurrentThreadId () == dwMainThreadId) + { + /* If we are being shut down in noninteractive mode, we don't + care about the message stack, so clear it to avoid abort in + shut_down_emacs. This happens when an noninteractive Emacs + is invoked as a subprocess of Emacs, and the parent wants to + kill us, e.g. because it's about to exit. */ + if (noninteractive) + clear_message_stack (); + /* Shut down cleanly, making sure autosave files are up to date. */ + shut_down_emacs (0, Qnil); + } + { + /* This handler is run in a thread different from the main + thread. (This is the normal situation when we are killed + by Emacs, for example, which sends us the WM_CLOSE + message). We cannot possibly call functions like + shut_down_emacs or clear_message_stack in that case, since + the main (a.k.a. "Lisp") thread could be in the middle of + some Lisp program. So instead we arrange for maybe_quit to + kill Emacs. */ + Vquit_flag = Qkill_emacs; + Vinhibit_quit = Qnil; + } } /* Allow other handlers to handle this signal. */ diff --git a/src/w32fns.c b/src/w32fns.c index b4192a5ffa6..745f561e6b1 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -11112,20 +11112,24 @@ emacs_abort (void) abort (); int button; - button = MessageBox (NULL, - "A fatal error has occurred!\n\n" - "Would you like to attach a debugger?\n\n" - "Select:\n" - "YES -- to debug Emacs, or\n" - "NO -- to abort Emacs and produce a backtrace\n" - " (emacs_backtrace.txt in current directory)." + + if (noninteractive) + button = IDNO; + else + button = MessageBox (NULL, + "A fatal error has occurred!\n\n" + "Would you like to attach a debugger?\n\n" + "Select:\n" + "YES -- to debug Emacs, or\n" + "NO -- to abort Emacs and produce a backtrace\n" + " (emacs_backtrace.txt in current directory)." #if __GNUC__ - "\n\n(type \"gdb -p \" and\n" - "\"continue\" inside GDB before clicking YES.)" + "\n\n(Before clicking YES, type\n" + "\"gdb -p \", then \"continue\" inside GDB.)" #endif - , "Emacs Abort Dialog", - MB_ICONEXCLAMATION | MB_TASKMODAL - | MB_SETFOREGROUND | MB_YESNO); + , "Emacs Abort Dialog", + MB_ICONEXCLAMATION | MB_TASKMODAL + | MB_SETFOREGROUND | MB_YESNO); switch (button) { case IDYES: commit 8febda46c458f11270350d0b68c69d8a58b59f8d Author: Theodor Thornhill Date: Sat Jan 21 20:05:52 2023 +0100 Use element as a sentence in html-ts-mode * lisp/textmodes/html-ts-mode.el (html-ts-mode): Tweak the regexp. diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index 7e4360747a3..a2d85bff7d6 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el @@ -106,10 +106,7 @@ html-ts-mode (setq-local treesit-defun-name-function #'html-ts-mode--defun-name) - (setq-local treesit-sentence-type-regexp - (regexp-opt '("start_tag" - "self_closing_tag" - "end_tag"))) + (setq-local treesit-sentence-type-regexp "element") (setq-local treesit-sexp-type-regexp (regexp-opt '("tag" commit 808e101fabec64a2f7a42dd9d9207ebd402ead4f Author: Theodor Thornhill Date: Sun Jan 22 11:14:00 2023 +0100 Tweak BSD style indentation (bug#60984) * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Simplify rules. * test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts: New testfile with bsd style indentation examples. * test/lisp/progmodes/c-ts-mode-tests.el (c-ts-mode-test-indentation-bsd): Add a test for the new style. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 27737a2ee1d..95f9001e0d7 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -237,6 +237,10 @@ c-ts-mode--indent-styles ((node-is "labeled_statement") point-min 0) ,@common) (bsd + ((node-is "}") parent-bol 0) + ((node-is "labeled_statement") parent-bol c-ts-mode-indent-offset) + ((parent-is "labeled_statement") parent-bol c-ts-mode-indent-offset) + ((parent-is "compound_statement") parent-bol c-ts-mode-indent-offset) ((parent-is "if_statement") parent-bol 0) ((parent-is "for_statement") parent-bol 0) ((parent-is "while_statement") parent-bol 0) diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts b/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts new file mode 100644 index 00000000000..07698077ffc --- /dev/null +++ b/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts @@ -0,0 +1,93 @@ +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq c-ts-mode-indent-offset 2) + (setq c-ts-mode-indent-style 'bsd) + (c-ts-mode) + (indent-region (point-min) (point-max))) + +Point-Char: | + +Name: Basic + +=-= +int +main (void) +{ + return 0; +} +=-=-= + +Name: Hanging Braces + +=-= +int +main (void) +{ + if (true) + { + | + } +} +=-=-= + +Name: Labels + +=-= +int +main (void) +{ + label: + return 0; + if (true) + { + label: + return 0; + } + else + { + if (true) + { + label: + return 0; + } + } +} +=-=-= + +Name: If-Else + +=-= +int main() +{ + if (true) + { + return 0; + } + else + { + return 1; + } +} +=-=-= + +Name: Empty Line +=-= +int main() +{ + | +} +=-=-= + +Name: Consecutive blocks (bug#60873) + +=-= +int +main (int argc, + char *argv[]) +{ + { + int i = 0; + } +} +=-=-= diff --git a/test/lisp/progmodes/c-ts-mode-tests.el b/test/lisp/progmodes/c-ts-mode-tests.el index 3d0902fe501..ddf64b40736 100644 --- a/test/lisp/progmodes/c-ts-mode-tests.el +++ b/test/lisp/progmodes/c-ts-mode-tests.el @@ -27,6 +27,10 @@ c-ts-mode-test-indentation (skip-unless (treesit-ready-p 'c)) (ert-test-erts-file (ert-resource-file "indent.erts"))) +(ert-deftest c-ts-mode-test-indentation-bsd () + (skip-unless (treesit-ready-p 'c)) + (ert-test-erts-file (ert-resource-file "indent-bsd.erts"))) + (ert-deftest c-ts-mode-test-filling () (skip-unless (treesit-ready-p 'c)) (ert-test-erts-file (ert-resource-file "filling.erts"))) commit 204519a2e73b5907b2c6f6a670ea6068bc09f6bc Author: Theodor Thornhill Date: Sun Jan 22 10:58:31 2023 +0100 Fix typo of exposed symbol name * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Remove double hyphen. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 5e5b0f87a32..27737a2ee1d 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -167,7 +167,7 @@ c-ts-mode--indent-styles ((node-is "preproc_arg") no-indent) ;; `c-ts-common-looking-at-star' has to come before ;; `c-ts-common-comment-2nd-line-matcher'. - ((and (parent-is "comment") c-ts-common--looking-at-star) + ((and (parent-is "comment") c-ts-common-looking-at-star) c-ts-common-comment-start-after-first-star -1) (c-ts-common-comment-2nd-line-matcher c-ts-common-comment-2nd-line-anchor commit 9296e0c64951ad6a329515aa3f31ad52aeaf8517 Author: Theodor Thornhill Date: Sun Jan 22 10:46:08 2023 +0100 Fix typo after move to common lib (bug#61001) * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Use correct preset. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 03793d61ba3..5e5b0f87a32 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -167,7 +167,7 @@ c-ts-mode--indent-styles ((node-is "preproc_arg") no-indent) ;; `c-ts-common-looking-at-star' has to come before ;; `c-ts-common-comment-2nd-line-matcher'. - ((and (parent-is "comment") c-ts-mode--looking-at-star) + ((and (parent-is "comment") c-ts-common--looking-at-star) c-ts-common-comment-start-after-first-star -1) (c-ts-common-comment-2nd-line-matcher c-ts-common-comment-2nd-line-anchor commit e74ba72a6a34221abf47145ecf0ec4fc8cda2555 Author: Dmitry Gutov Date: Sun Jan 22 04:55:13 2023 +0200 ruby-ts-mode: Fix two additional cases with ruby-method-call-indent=nil * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules): Fix two additional cases with ruby-method-call-indent=nil. * test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb: Add examples. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index ac0b5d7c6d4..7e5125453e8 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -665,7 +665,7 @@ ruby-ts--indent-rules (or (match "\\." "call") (query "(call \".\" (identifier) @indent)"))) - parent 0) + (ruby-ts--bol ruby-ts--statement-ancestor) ruby-indent-level) ((match "\\." "call") parent ruby-indent-level) ;; method parameters -- four styles: diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb b/test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb index 1a8285ee919..624a6caafe5 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb @@ -1,3 +1,8 @@ +foo = subject + .update( + 1 + ) + foo2 = subject. update( @@ -10,6 +15,10 @@ 2 ) +my_array.select { |str| str.size > 5 } + .map { |str| str.downcase } + # Local Variables: # ruby-method-call-indent: nil +# ruby-align-chained-calls: nil # End: commit ae7e28a43726522610df04bd39659b908da9ddfc Author: Dmitry Gutov Date: Sun Jan 22 04:40:40 2023 +0200 ruby-mode.el: Expand some docstrings with examples * lisp/progmodes/ruby-mode.el (ruby-align-chained-calls) (ruby-method-params-indent): Expand docstrings with examples. diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 6e524693e37..dba9ff0a846 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -336,7 +336,15 @@ ruby-align-chained-calls "If non-nil, align chained method calls. Each method call on a separate line will be aligned to the column -of its parent. +of its parent. Example: + + my_array.select { |str| str.size > 5 } + .map { |str| str.downcase } + +When nil, each method call is indented with the usual offset: + + my_array.select { |str| str.size > 5 } + .map { |str| str.downcase } Only has effect when `ruby-use-smie' is t." :type 'boolean @@ -346,12 +354,26 @@ ruby-align-chained-calls (defcustom ruby-method-params-indent t "Indentation of multiline method parameters. -When t, the parameters list is indented to the method name. +When t, the parameters list is indented to the method name: + + def foo( + baz, + bar + ) + hello + end When a number, indent the parameters list this many columns against the beginning of the method (the \"def\" keyword). -The value nil means the same as 0. +The value nil means the same as 0: + + def foo( + baz, + bar + ) + hello + end Only has effect when `ruby-use-smie' is t." :type '(choice (const :tag "Indent to the method name" t) commit 89cb3c3f1576fdc69eb061cccc8b537f4b7c8228 Author: Po Lu Date: Sun Jan 22 08:37:06 2023 +0800 Minor fixes for Haiku * lisp/frame.el (display-symbol-keys-p): * lisp/simple.el (normal-erase-is-backspace-setup-frame): Add support for Haiku. diff --git a/lisp/frame.el b/lisp/frame.el index 9c3fa9ae4bb..af95a047c38 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2189,7 +2189,7 @@ display-symbol-keys-p This means that, for example, DISPLAY can differentiate between the keybinding RET and [return]." (let ((frame-type (framep-on-display display))) - (or (memq frame-type '(x w32 ns pc pgtk)) + (or (memq frame-type '(x w32 ns pc pgtk haiku)) ;; MS-DOS and MS-Windows terminals have built-in support for ;; function (symbol) keys (memq system-type '(ms-dos windows-nt))))) diff --git a/lisp/simple.el b/lisp/simple.el index 3f3dbe78c39..aaad3217982 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10386,7 +10386,7 @@ normal-erase-is-backspace-setup-frame (if (if (eq normal-erase-is-backspace 'maybe) (and (not noninteractive) (or (memq system-type '(ms-dos windows-nt)) - (memq window-system '(w32 ns pgtk)) + (memq window-system '(w32 ns pgtk haiku)) (and (eq window-system 'x) (fboundp 'x-backspace-delete-keys-p) (x-backspace-delete-keys-p)) commit 6adc193ad66445acd84caba6973424ecbd21da26 Author: Theodor Thornhill Date: Sat Jan 21 12:24:55 2023 +0100 Move c-like common utils into own library (bug#60961) * lisp/progmodes/c-ts-common.el: New file. * lisp/progmodes/c-ts-mode.el (treesit-induce-sparse-tree): Remove unused declaration. (c-ts-mode--indent-styles): Refer to the new library. (c-ts-mode--looking-at-star, c-ts-mode--comment-start-after-first-star, c-ts-mode--comment-2nd-line-matcher, c-ts-mode--comment-2nd-line-anchor, c-ts-mode--comment-regexp, c-ts-mode--fill-paragraph, c-ts-mode--fill-block-comment): Move to c-ts-common and expose as public. (c-ts-mode-comment-setup): Move to c-ts-common. * lisp/progmodes/csharp-mode.el (c-ts-common): Require new library. (csharp-ts-mode--indent-rules): Refer to the new symbols. (csharp-ts-mode): Use new function. * lisp/progmodes/java-ts-mode.el (c-ts-common): Require new library. (java-ts-mode--indent-rules): Refer to the new symbols. (java-ts-mode): Use new function. * lisp/progmodes/js.el (c-ts-common): Require new library. (js--treesit-indent-rules): Refer to the new symbols. (js-ts-mode): Use new function. * lisp/progmodes/rust-ts-mode.el (c-ts-common): Require new library. (rust-ts-mode--indent-rules): Refer to the new symbols. (rust-ts-mode): Use new function. * lisp/progmodes/typescript-ts-mode.el (c-ts-common): Require new library. (typescript-ts-mode--indent-rules): Refer to the new symbols. (typescript-ts-base-mode): Use new function. diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el new file mode 100644 index 00000000000..6671d4be5b6 --- /dev/null +++ b/lisp/progmodes/c-ts-common.el @@ -0,0 +1,247 @@ +;;; c-ts-common.el --- Utilities for C like Languages -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author : 付禹安 (Yuan Fu) +;; Keywords : c c++ java javascript rust languages tree-sitter + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; For C-like language major modes: +;; +;; - Use `c-ts-common-comment-setup' to setup comment variables and +;; filling. +;; +;; - Use simple-indent matcher `c-ts-common-looking-at-star' and +;; anchor `c-ts-common-comment-start-after-first-star' for indenting +;; block comments. See `c-ts-mode--indent-styles' for example. + +;;; Code: + +(require 'treesit) +(eval-when-compile (require 'rx)) + +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-end "treesit.c") +(declare-function treesit-node-type "treesit.c") + +(defun c-ts-common-looking-at-star (_n _p bol &rest _) + "A tree-sitter simple indent matcher. +Matches if there is a \"*\" after BOL." + (eq (char-after bol) ?*)) + +(defun c-ts-common-comment-start-after-first-star (_n parent &rest _) + "A tree-sitter simple indent anchor. +Finds the \"/*\" and returns the point after the \"*\". +Assumes PARENT is a comment node." + (save-excursion + (goto-char (treesit-node-start parent)) + (if (looking-at (rx "/*")) + (match-end 0) + (point)))) + +(defun c-ts-common-comment-2nd-line-matcher (_n parent &rest _) + "Matches if point is at the second line of a block comment. +PARENT should be a comment node." + (and (equal (treesit-node-type parent) "comment") + (save-excursion + (forward-line -1) + (back-to-indentation) + (eq (point) (treesit-node-start parent))))) + +(defun c-ts-common-comment-2nd-line-anchor (_n _p bol &rest _) + "Return appropriate anchor for the second line of a comment. + +If the first line is /* alone, return the position right after +the star; if the first line is /* followed by some text, return +the position right before the text minus 1. + +Use an offset of 1 with this anchor. BOL is the beginning of +non-whitespace characters of the current line." + (save-excursion + (forward-line -1) + (back-to-indentation) + (when (looking-at comment-start-skip) + (goto-char (match-end 0)) + (if (looking-at (rx (* (or " " "\t")) eol)) + ;; Only /* at the first line. + (progn (skip-chars-backward " \t") + (if (save-excursion + (goto-char bol) + (looking-at (rx "*"))) + ;; The common case. Checked by "Multiline Block + ;; Comments 4". + (point) + ;; The "Multiline Block Comments 2" test in + ;; c-ts-common-resources/indent.erts checks this. + (1- (point)))) + ;; There is something after /* at the first line. The + ;; "Multiline Block Comments 3" test checks this. + (1- (point)))))) + +(defvar c-ts-common--comment-regexp + ;; These covers C/C++, Java, JavaScript, TypeScript, Rust, C#. + (rx (or "comment" "line_comment" "block_comment")) + "Regexp pattern that matches a comment in C-like languages.") + +(defun c-ts-common--fill-paragraph (&optional arg) + "Fillling function for `c-ts-common'. +ARG is passed to `fill-paragraph'." + (interactive "*P") + (save-restriction + (widen) + (let ((node (treesit-node-at (point)))) + (when (string-match-p c-ts-common--comment-regexp + (treesit-node-type node)) + (if (save-excursion + (goto-char (treesit-node-start node)) + (looking-at "//")) + (fill-comment-paragraph arg) + (c-ts-common--fill-block-comment arg))) + ;; Return t so `fill-paragraph' doesn't attempt to fill by + ;; itself. + t))) + +(defun c-ts-common--fill-block-comment (&optional arg) + "Fillling function for block comments. +ARG is passed to `fill-paragraph'. Assume point is in a block +comment." + (let* ((node (treesit-node-at (point))) + (start (treesit-node-start node)) + (end (treesit-node-end node)) + ;; Bind to nil to avoid infinite recursion. + (fill-paragraph-function nil) + (orig-point (point-marker)) + (start-marker (point-marker)) + (end-marker nil) + (end-len 0)) + (move-marker start-marker start) + ;; We mask "/*" and the space before "*/" like + ;; `c-fill-paragraph' does. + (atomic-change-group + ;; Mask "/*". + (goto-char start) + (when (looking-at (rx (* (syntax whitespace)) + (group "/") "*")) + (goto-char (match-beginning 1)) + (move-marker start-marker (point)) + (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) + (when (looking-back (rx (not (syntax whitespace)) + (group (+ (syntax whitespace))) + "*/") + (line-beginning-position)) + (goto-char (match-beginning 1)) + (setq end-marker (point-marker)) + (setq end-len (- (match-end 1) (match-beginning 1))) + (replace-match (make-string end-len ?x) + nil nil nil 1)) + ;; If "*/" is on its own line, don't included it in the + ;; filling region. + (when (not end-marker) + (goto-char end) + (when (looking-back (rx "*/") 2) + (backward-char 2) + (skip-syntax-backward "-") + (setq end (point)))) + ;; Let `fill-paragraph' do its thing. + (goto-char orig-point) + (narrow-to-region start end) + ;; We don't want to fill the region between START and + ;; START-MARKER, otherwise the filling function might delete + ;; some spaces there. + (fill-region start-marker end arg) + ;; Unmask. + (when start-marker + (goto-char start-marker) + (delete-char 1) + (insert "/")) + (when end-marker + (goto-char end-marker) + (delete-region (point) (+ end-len (point))) + (insert (make-string end-len ?\s)))))) + +(defun c-ts-common-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-common--fill-paragraph'.) + (setq-local adaptive-fill-regexp + (concat (rx (* (syntax whitespace)) + (group (or (seq "/" (+ "/")) (* "*")))) + 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 (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-common--fill-paragraph)) + +(provide 'c-ts-common) + +;;; c-ts-common.el ends here diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 8ddd622a05a..03793d61ba3 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -64,26 +64,18 @@ ;; files, provided that you have the corresponding parser grammar ;; libraries installed. ;; -;; For C-like language major modes: -;; -;; - Use `c-ts-mode-comment-setup' to setup comment variables and -;; filling. -;; -;; - Use simple-indent matcher `c-ts-mode--looking-at-star' and anchor -;; `c-ts-mode--comment-start-after-first-star' for indenting block -;; comments. See `c-ts-mode--indent-styles' for example. -;; ;; - Use variable `c-ts-mode-indent-block-type-regexp' with indent ;; offset c-ts-mode--statement-offset for indenting statements. ;; Again, see `c-ts-mode--indent-styles' for example. +;; ;;; Code: (require 'treesit) +(require 'c-ts-common) (eval-when-compile (require 'rx)) (declare-function treesit-parser-create "treesit.c") -(declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-node-parent "treesit.c") (declare-function treesit-node-start "treesit.c") (declare-function treesit-node-end "treesit.c") @@ -173,12 +165,12 @@ c-ts-mode--indent-styles ((node-is "else") parent-bol 0) ((node-is "case") parent-bol 0) ((node-is "preproc_arg") no-indent) - ;; `c-ts-mode--looking-at-star' has to come before - ;; `c-ts-mode--comment-2nd-line-matcher'. + ;; `c-ts-common-looking-at-star' has to come before + ;; `c-ts-common-comment-2nd-line-matcher'. ((and (parent-is "comment") c-ts-mode--looking-at-star) - c-ts-mode--comment-start-after-first-star -1) - (c-ts-mode--comment-2nd-line-matcher - c-ts-mode--comment-2nd-line-anchor + c-ts-common-comment-start-after-first-star -1) + (c-ts-common-comment-2nd-line-matcher + c-ts-common-comment-2nd-line-anchor 1) ((parent-is "comment") prev-adaptive-prefix 0) @@ -333,60 +325,6 @@ c-ts-mode--close-bracket-offset (- (c-ts-mode--statement-offset node parent) c-ts-mode-indent-offset)) -(defun c-ts-mode--looking-at-star (_n _p bol &rest _) - "A tree-sitter simple indent matcher. -Matches if there is a \"*\" after BOL." - (eq (char-after bol) ?*)) - -(defun c-ts-mode--comment-start-after-first-star (_n parent &rest _) - "A tree-sitter simple indent anchor. -Finds the \"/*\" and returns the point after the \"*\". -Assumes PARENT is a comment node." - (save-excursion - (goto-char (treesit-node-start parent)) - (if (looking-at (rx "/*")) - (match-end 0) - (point)))) - -(defun c-ts-mode--comment-2nd-line-matcher (_n parent &rest _) - "Matches if point is at the second line of a block comment. -PARENT should be a comment node." - (and (equal (treesit-node-type parent) "comment") - (save-excursion - (forward-line -1) - (back-to-indentation) - (eq (point) (treesit-node-start parent))))) - -(defun c-ts-mode--comment-2nd-line-anchor (_n _p bol &rest _) - "Return appropriate anchor for the second line of a comment. - -If the first line is /* alone, return the position right after -the star; if the first line is /* followed by some text, return -the position right before the text minus 1. - -Use an offset of 1 with this anchor. BOL is the beginning of -non-whitespace characters of the current line." - (save-excursion - (forward-line -1) - (back-to-indentation) - (when (looking-at comment-start-skip) - (goto-char (match-end 0)) - (if (looking-at (rx (* (or " " "\t")) eol)) - ;; Only /* at the first line. - (progn (skip-chars-backward " \t") - (if (save-excursion - (goto-char bol) - (looking-at (rx "*"))) - ;; The common case. Checked by "Multiline Block - ;; Comments 4". - (point) - ;; The "Multiline Block Comments 2" test in - ;; c-ts-mode-resources/indent.erts checks this. - (1- (point)))) - ;; There is something after /* at the first line. The - ;; "Multiline Block Comments 3" test checks this. - (1- (point)))))) - ;;; Font-lock (defvar c-ts-mode--preproc-keywords @@ -782,156 +720,6 @@ c-ts-mode-indent-defun (treesit-node-end node)) (goto-char orig-point))) -;;; Filling - -(defvar c-ts-mode--comment-regexp - ;; These covers C/C++, Java, JavaScript, TypeScript, Rust, C#. - (rx (or "comment" "line_comment" "block_comment")) - "Regexp pattern that matches a comment in C-like languages.") - -(defun c-ts-mode--fill-paragraph (&optional arg) - "Fillling function for `c-ts-mode'. -ARG is passed to `fill-paragraph'." - (interactive "*P") - (save-restriction - (widen) - (let ((node (treesit-node-at (point)))) - (when (string-match-p c-ts-mode--comment-regexp - (treesit-node-type node)) - (if (save-excursion - (goto-char (treesit-node-start node)) - (looking-at "//")) - (fill-comment-paragraph arg) - (c-ts-mode--fill-block-comment arg))) - ;; Return t so `fill-paragraph' doesn't attempt to fill by - ;; itself. - t))) - -(defun c-ts-mode--fill-block-comment (&optional arg) - "Fillling function for block comments. -ARG is passed to `fill-paragraph'. Assume point is in a block -comment." - (let* ((node (treesit-node-at (point))) - (start (treesit-node-start node)) - (end (treesit-node-end node)) - ;; Bind to nil to avoid infinite recursion. - (fill-paragraph-function nil) - (orig-point (point-marker)) - (start-marker (point-marker)) - (end-marker nil) - (end-len 0)) - (move-marker start-marker start) - ;; We mask "/*" and the space before "*/" like - ;; `c-fill-paragraph' does. - (atomic-change-group - ;; Mask "/*". - (goto-char start) - (when (looking-at (rx (* (syntax whitespace)) - (group "/") "*")) - (goto-char (match-beginning 1)) - (move-marker start-marker (point)) - (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) - (when (looking-back (rx (not (syntax whitespace)) - (group (+ (syntax whitespace))) - "*/") - (line-beginning-position)) - (goto-char (match-beginning 1)) - (setq end-marker (point-marker)) - (setq end-len (- (match-end 1) (match-beginning 1))) - (replace-match (make-string end-len ?x) - nil nil nil 1)) - ;; If "*/" is on its own line, don't included it in the - ;; filling region. - (when (not end-marker) - (goto-char end) - (when (looking-back (rx "*/") 2) - (backward-char 2) - (skip-syntax-backward "-") - (setq end (point)))) - ;; Let `fill-paragraph' do its thing. - (goto-char orig-point) - (narrow-to-region start end) - ;; We don't want to fill the region between START and - ;; START-MARKER, otherwise the filling function might delete - ;; some spaces there. - (fill-region start-marker end arg) - ;; Unmask. - (when start-marker - (goto-char start-marker) - (delete-char 1) - (insert "/")) - (when end-marker - (goto-char end-marker) - (delete-region (point) (+ end-len (point))) - (insert (make-string end-len ?\s)))))) - -(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)) - ;; 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 (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 @@ -968,7 +756,7 @@ c-ts-base-mode (setq-local indent-tabs-mode t)) ;; Comment - (c-ts-mode-comment-setup) + (c-ts-common-comment-setup) ;; Electric (setq-local electric-indent-chars diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 04f7f222362..852e893dc25 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -34,7 +34,7 @@ (require 'cc-mode) (require 'cc-langs) (require 'treesit) -(require 'c-ts-mode) ; For comment indenting and filling. +(require 'c-ts-common) ; For comment indenting and filling. (eval-when-compile (require 'cc-fonts) @@ -634,8 +634,8 @@ 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) + ((and (parent-is "comment") c-ts-common-looking-at-star) + c-ts-common-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) @@ -908,7 +908,7 @@ csharp-ts-mode (treesit-parser-create 'c-sharp) ;; Comments. - (c-ts-mode-comment-setup) + (c-ts-common-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 8251d9603c3..af2b0c1fa8d 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -29,7 +29,7 @@ (require 'treesit) (eval-when-compile (require 'rx)) -(require 'c-ts-mode) ; For comment indent and filling. +(require 'c-ts-common) ; For comment indent and filling. (declare-function treesit-parser-create "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") @@ -73,8 +73,8 @@ 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") c-ts-mode--looking-at-star) - c-ts-mode--comment-start-after-first-star -1) + ((and (parent-is "comment") c-ts-common-looking-at-star) + c-ts-common-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) @@ -293,7 +293,7 @@ java-ts-mode (treesit-parser-create 'java) ;; Comments. - (c-ts-mode-comment-setup) + (c-ts-common-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 176024863f1..b5c912b8b0d 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -54,7 +54,7 @@ (require 'json) (require 'prog-mode) (require 'treesit) -(require 'c-ts-mode) ; For comment indent and filling. +(require 'c-ts-common) ; For comment indent and filling. (eval-when-compile (require 'cl-lib) @@ -3428,8 +3428,8 @@ js--treesit-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) + ((and (parent-is "comment") c-ts-common-looking-at-star) + c-ts-common-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) @@ -3806,7 +3806,7 @@ js-ts-mode ;; Which-func. (setq-local which-func-imenu-joiner-function #'js--which-func-joiner) ;; Comment. - (c-ts-mode-comment-setup) + (c-ts-common-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 08590ae6a86..3a6cb61b719 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -29,7 +29,7 @@ (require 'treesit) (eval-when-compile (require 'rx)) -(require 'c-ts-mode) ; For comment indent and filling. +(require 'c-ts-common) ; For comment indent and filling. (declare-function treesit-parser-create "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") @@ -71,8 +71,8 @@ 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) + ((and (parent-is "comment") c-ts-common-looking-at-star) + c-ts-common-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) @@ -285,7 +285,7 @@ rust-ts-mode (treesit-parser-create 'rust) ;; Comments. - (c-ts-mode-comment-setup) + (c-ts-common-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 903be93422d..34030968806 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -30,7 +30,7 @@ (require 'treesit) (require 'js) (eval-when-compile (require 'rx)) -(require 'c-ts-mode) ; For comment indent and filling. +(require 'c-ts-common) ; For comment indent and filling. (declare-function treesit-parser-create "treesit.c") @@ -74,8 +74,8 @@ typescript-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) + ((and (parent-is "comment") c-ts-common-looking-at-star) + c-ts-common-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) @@ -321,7 +321,7 @@ typescript-ts-base-mode :syntax-table typescript-ts-mode--syntax-table ;; Comments. - (c-ts-mode-comment-setup) + (c-ts-common-comment-setup) ;; Electric (setq-local electric-indent-chars commit f0971f94fe42224b4d85bb8b6188d5d805689ddf Author: Evgeni Kolev Date: Sat Jan 14 08:28:06 2023 +0200 Extend go-ts-mode with command to add docstring to function go-ts-mode is extended with command go-ts-mode-docstring which adds docstring comment to the defun at point. If a comment already exists, the point is instead moved to the top-most comment line. The command is bound to "C-c C-d". * lisp/progmodes/go-ts-mode.el (go-ts-mode): Extend docstring. (go-ts-mode-docstring): New function. (go-ts-mode--comment-on-previous-line-p): New function. (go-ts-mode-map): New map variable. * etc/NEWS: Mention the change. (bug#60805) diff --git a/etc/NEWS b/etc/NEWS index 4851802716a..10e91ec4ab9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -181,6 +181,14 @@ the new argument NEW-BUFFER non-nil, it will use a new buffer instead. Interactively, invoke 'eww-open-file' with a prefix argument to activate this behavior. +** go-ts-mode + ++++ +*** New command 'go-ts-mode-docstring'. +This command adds a docstring comment to the current defun. If a +comment already exists, point is only moved to the comment. It is +bound to 'C-c C-d' in 'go-ts-mode'. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 64e761d2f72..be5a69c2ec4 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -177,9 +177,16 @@ go-ts-mode--font-lock-settings ;;;###autoload (add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode)) +(defvar-keymap go-ts-mode-map + :doc "Keymap used in Go mode, powered by tree-sitter" + :parent prog-mode-map + "C-c C-d" #'go-ts-mode-docstring) + ;;;###autoload (define-derived-mode go-ts-mode prog-mode "Go" - "Major mode for editing Go, powered by tree-sitter." + "Major mode for editing Go, powered by tree-sitter. + +\\{go-ts-mode-map}" :group 'go :syntax-table go-ts-mode--syntax-table @@ -274,6 +281,32 @@ go-ts-mode--other-type-node-p (not (go-ts-mode--struct-node-p node)) (not (go-ts-mode--alias-node-p node)))) +(defun go-ts-mode-docstring () + "Add a docstring comment for the current defun. +The added docstring is prefilled with the defun's name. If the +comment already exists, jump to it." + (interactive) + (when-let ((defun-node (treesit-defun-at-point))) + (goto-char (treesit-node-start defun-node)) + (if (go-ts-mode--comment-on-previous-line-p) + ;; go to top comment line + (while (go-ts-mode--comment-on-previous-line-p) + (forward-line -1)) + (insert "// " (treesit-defun-name defun-node)) + (newline) + (backward-char)))) + +(defun go-ts-mode--comment-on-previous-line-p () + "Return t if the previous line is a comment." + (when-let ((point (- (pos-bol) 1)) + ((> point 0)) + (node (treesit-node-at point))) + (and + ;; check point is actually inside the found node + ;; treesit-node-at can return nodes after point + (<= (treesit-node-start node) point (treesit-node-end node)) + (string-equal "comment" (treesit-node-type node))))) + ;; go.mod support. (defvar go-mod-ts-mode--syntax-table commit 161706ec3312ba329de582b12c32e09a8dfe95e8 Author: Philip Kaludercic Date: Sat Jan 21 18:56:47 2023 +0100 ; Actually use dummy package descriptor * lisp/emacs-lisp/package-vc.el (package-vc--unpack): Set pkg-desc if nil. This revises the changes from 70947da708c8e06e31a2930520b38bafe43dba39. diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index b5b8a6746a6..33bd0bfd5cd 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -601,7 +601,7 @@ package-vc--unpack for details. The optional argument REV specifies a specific revision to checkout. This overrides the `:branch' attribute in PKG-SPEC." (unless pkg-desc - (package-desc-create :name (car pkg-spec) :kind 'vc)) + (setq pkg-desc (package-desc-create :name (car pkg-spec) :kind 'vc))) (pcase-let* (((map :lisp-dir) pkg-spec) (name (package-desc-name pkg-desc)) (dirname (package-desc-full-name pkg-desc)) commit cb07f1bcd0f3a1af58f8d4d65d96949e20dfa569 Author: Philip Kaludercic Date: Sat Jan 21 18:56:47 2023 +0100 ; Actually use dummy package descriptor * lisp/emacs-lisp/package-vc.el (package-vc--unpack): Set pkg-desc if nil. This revises the changes from 70947da708c8e06e31a2930520b38bafe43dba39. diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index b5b8a6746a6..33bd0bfd5cd 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -601,7 +601,7 @@ package-vc--unpack for details. The optional argument REV specifies a specific revision to checkout. This overrides the `:branch' attribute in PKG-SPEC." (unless pkg-desc - (package-desc-create :name (car pkg-spec) :kind 'vc)) + (setq pkg-desc (package-desc-create :name (car pkg-spec) :kind 'vc))) (pcase-let* (((map :lisp-dir) pkg-spec) (name (package-desc-name pkg-desc)) (dirname (package-desc-full-name pkg-desc)) commit 2bf0ad3be6bec22471c5b32548da99d6eb63da58 Author: Theodor Thornhill Date: Sat Jan 21 14:47:34 2023 +0100 Add sexp navigation to js/typescript/tsx-ts-mode * lisp/progmodes/js.el (js--treesit-sexp-nodes): Add node types. (js-ts-mode): Set 'treesit-sexp-type-regexp'. * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode--sexp-nodes): Add node types. * lisp/progmodes/typescript-ts-mode.el (typescript-ts-base-mode): Set 'treesit-sexp-type-regexp'. (tsx-ts-mode): Add in jsx nodes. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 28305a0b39b..6f3746ca72a 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3817,6 +3817,29 @@ js--treesit-sentence-nodes "Nodes that designate sentences in JavaScript. See `treesit-sentence-type-regexp' for more information.") +(defvar js--treesit-sexp-nodes + '("expression" + "pattern" + "array" + "function" + "string" + "escape" + "template" + "regex" + "number" + "identifier" + "this" + "super" + "true" + "false" + "null" + "undefined" + "arguments" + "pair" + "jsx") + "Nodes that designate sexps in JavaScript. +See `treesit-sexp-type-regexp' for more information.") + ;;;###autoload (define-derived-mode js-ts-mode js-base-mode "JavaScript" "Major mode for editing JavaScript. @@ -3860,6 +3883,9 @@ js-ts-mode (setq-local treesit-sentence-type-regexp (regexp-opt js--treesit-sentence-nodes)) + (setq-local treesit-sexp-type-regexp + (regexp-opt js--treesit-sexp-nodes)) + ;; Fontification. (setq-local treesit-font-lock-settings js--treesit-font-lock-settings) (setq-local treesit-font-lock-feature-list diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index f7bf7ed7e42..69e4746bcc4 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -338,6 +338,28 @@ typescript-ts-mode--sentence-nodes "Nodes that designate sentences in TypeScript. See `treesit-sentence-type-regexp' for more information.") +(defvar typescript-ts-mode--sexp-nodes + '("expression" + "pattern" + "array" + "function" + "string" + "escape" + "template" + "regex" + "number" + "identifier" + "this" + "super" + "true" + "false" + "null" + "undefined" + "arguments" + "pair") + "Nodes that designate sexps in TypeScript. +See `treesit-sexp-type-regexp' for more information.") + ;;;###autoload (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode)) @@ -373,6 +395,9 @@ typescript-ts-base-mode (setq-local treesit-sentence-type-regexp (regexp-opt typescript-ts-mode--sentence-nodes)) + (setq-local treesit-sexp-type-regexp + (regexp-opt typescript-ts-mode--sexp-nodes)) + ;; Imenu (same as in `js-ts-mode'). (setq-local treesit-simple-imenu-settings `(("Function" "\\`function_declaration\\'" nil nil) @@ -438,6 +463,11 @@ tsx-ts-mode '("jsx_element" "jsx_self_closing_element")))) + (setq-local treesit-sexp-type-regexp + (regexp-opt (append + typescript-ts-mode--sexp-nodes + '("jsx")))) + ;; Font-lock. (setq-local treesit-font-lock-settings (typescript-ts-mode--font-lock-settings 'tsx)) commit f55bbc6898898c4b5457e6952b0ae9b5c8c42423 Author: Theodor Thornhill Date: Sat Jan 21 13:35:10 2023 +0100 Add sentence and sexp movement to c-ts-mode * lisp/progmodes/c-ts-mode.el (c-ts-base-mode): Add 'treesit-sentence-type-regexp' and 'treesit-sexp-type-regexp' node types. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 348d027af19..14bbb099a0a 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -896,6 +896,37 @@ c-ts-base-mode (setq-local treesit-defun-skipper #'c-ts-mode--defun-skipper) (setq-local treesit-defun-name-function #'c-ts-mode--defun-name) + (setq-local treesit-sentence-type-regexp + ;; compound_statement makes us jump over too big units + ;; of code, so skip that one, and include the other + ;; statements. + (regexp-opt '("preproc" + "declaration" + "specifier" + "attributed_statement" + "labeled_statement" + "expression_statement" + "if_statement" + "switch_statement" + "do_statement" + "while_statement" + "for_statement" + "return_statement" + "break_statement" + "continue_statement" + "goto_statement" + "case_statement"))) + + (setq-local treesit-sexp-type-regexp + (regexp-opt '("preproc" + "declarator" + "qualifier" + "type" + "parameter" + "expression" + "literal" + "string"))) + ;; Nodes like struct/enum/union_specifier can appear in ;; function_definitions, so we need to find the top-level node. (setq-local treesit-defun-prefer-top-level t) commit b875c9bf67ebf858648a00307c370d7a196aab56 Author: Michael Albinus Date: Sat Jan 21 12:04:50 2023 +0100 Fix file-regular-p in Tramp * test/lisp/net/tramp-archive-tests.el (tramp-archive-test18-file-attributes) (tramp-archive-test21-file-links): * test/lisp/net/tramp-tests.el (tramp-test18-file-attributes) (tramp-test21-file-links): Adapt tests. * lisp/net/tramp.el (tramp-handle-file-regular-p): Fix symlink case. (Bug#60943) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f0b17ef3934..123d01c747d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4031,9 +4031,15 @@ tramp-handle-file-regular-p "Like `file-regular-p' for Tramp files." (and (file-exists-p filename) ;; Sometimes, `file-attributes' does not return a proper value - ;; even if `file-exists-p' does. - (when-let ((attr (file-attributes filename))) - (eq ?- (aref (file-attribute-modes attr) 0))))) + ;; even if `file-exists-p' does. Protect by `ignore-errors', + ;; because `file-truename' could raise an error for cyclic + ;; symlinks. + (ignore-errors + (when-let ((attr (file-attributes filename))) + (cond + ((eq ?- (aref (file-attribute-modes attr) 0))) + ((eq ?l (aref (file-attribute-modes attr) 0)) + (file-regular-p (file-truename filename)))))))) (defun tramp-handle-file-remote-p (filename &optional identification connected) "Like `file-remote-p' for Tramp files." diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 96c1e78e37a..b28b32bc7d3 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -694,6 +694,7 @@ tramp-archive-test18-file-attributes ;; Symlink. (should (file-exists-p tmp-name2)) (should (file-symlink-p tmp-name2)) + (should (file-regular-p tmp-name2)) (setq attr (file-attributes tmp-name2)) (should (string-equal (car attr) (file-name-nondirectory tmp-name1))) @@ -784,12 +785,14 @@ tramp-archive-test21-file-links (unwind-protect (progn (should (file-exists-p tmp-name1)) + (should (file-regular-p tmp-name1)) (should (string-equal tmp-name1 (file-truename tmp-name1))) ;; `make-symbolic-link' is not implemented. (should-error (make-symbolic-link tmp-name1 tmp-name2) :type 'file-error) (should (file-symlink-p tmp-name2)) + (should (file-regular-p tmp-name2)) (should (string-equal ;; This is "/foo.txt". diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 0f21e3a45eb..ff0fc56043e 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3495,6 +3495,9 @@ tramp-test18-file-attributes (access-file tmp-name1 "error") :type 'file-missing) + (should-not (file-exists-p tmp-name1)) + (should-not (file-readable-p tmp-name1)) + (should-not (file-regular-p tmp-name1)) ;; `file-ownership-preserved-p' should return t for ;; non-existing files. (when test-file-ownership-preserved-p @@ -3579,7 +3582,7 @@ tramp-test18-file-attributes (should (file-exists-p tmp-name1)) (should (file-readable-p tmp-name1)) (should-not (file-regular-p tmp-name1)) - (should-not (access-file tmp-name1 "")) + (should-not (access-file tmp-name1 "error")) (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name1 'group))) (setq attr (file-attributes tmp-name1)) @@ -3927,7 +3930,10 @@ tramp-test21-file-links (tramp--test-ignore-make-symbolic-link-error (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) + (should (file-regular-p tmp-name1)) (make-symbolic-link tmp-name1 tmp-name2) + (should (file-exists-p tmp-name2)) + (should (file-regular-p tmp-name2)) (should (string-equal (funcall @@ -3978,6 +3984,8 @@ tramp-test21-file-links (string-equal tmp-name1 (file-symlink-p tmp-name3)))) ;; Check directory as newname. (make-directory tmp-name4) + (should (file-directory-p tmp-name4)) + (should-not (file-regular-p tmp-name4)) (when (tramp--test-expensive-test-p) (should-error (make-symbolic-link tmp-name1 tmp-name4) @@ -3991,6 +3999,8 @@ tramp-test21-file-links (file-symlink-p tmp-name5))) ;; Check, that files in symlinked directories still work. (make-symbolic-link tmp-name4 tmp-name6) + (should (file-symlink-p tmp-name6)) + (should-not (file-regular-p tmp-name6)) (write-region "foo" nil (expand-file-name "foo" tmp-name6)) (delete-file (expand-file-name "foo" tmp-name6)) (should-not (file-exists-p (expand-file-name "foo" tmp-name4))) @@ -4052,9 +4062,11 @@ tramp-test21-file-links (tramp--test-ignore-make-symbolic-link-error (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) + (should (file-regular-p tmp-name1)) (should (string-equal tmp-name1 (file-truename tmp-name1))) (make-symbolic-link tmp-name1 tmp-name2) (should (file-symlink-p tmp-name2)) + (should (file-regular-p tmp-name2)) (should-not (string-equal tmp-name2 (file-truename tmp-name2))) (should (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) @@ -4064,6 +4076,7 @@ tramp-test21-file-links (let ((default-directory ert-remote-temporary-file-directory)) (make-symbolic-link (file-name-nondirectory tmp-name1) tmp-name2)) (should (file-symlink-p tmp-name2)) + (should (file-regular-p tmp-name2)) (should-not (string-equal tmp-name2 (file-truename tmp-name2))) (should (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) @@ -4079,6 +4092,7 @@ tramp-test21-file-links (if quoted #'tramp-compat-file-name-unquote #'identity) penguin) tmp-name2) (should (file-symlink-p tmp-name2)) + (should-not (file-regular-p tmp-name2)) (should (string-equal (file-truename tmp-name2) @@ -4089,6 +4103,7 @@ tramp-test21-file-links (unless (tramp--test-windows-nt-p) (make-symbolic-link tmp-name1 tmp-name3) (should (file-symlink-p tmp-name3)) + (should-not (file-regular-p tmp-name3)) (should-not (string-equal tmp-name3 (file-truename tmp-name3))) ;; `file-truename' returns a quoted file name for `tmp-name3'. ;; We must unquote it. @@ -4117,6 +4132,8 @@ tramp-test21-file-links (make-symbolic-link tmp-name3 (setq tmp-name3 (tramp--test-make-temp-name nil quoted)))) + (should-not (file-regular-p tmp-name2)) + (should-not (file-regular-p tmp-name3)) (should (string-equal (file-truename tmp-name2) @@ -4147,6 +4164,8 @@ tramp-test21-file-links (tramp--test-ignore-make-symbolic-link-error (make-symbolic-link tmp-name2 tmp-name1) (should (file-symlink-p tmp-name1)) + (should-not (file-regular-p tmp-name1)) + (should-not (file-regular-p tmp-name2)) (if (tramp--test-smb-p) ;; The symlink command of "smbclient" detects the ;; cycle already. @@ -4155,6 +4174,7 @@ tramp-test21-file-links :type 'file-error) (make-symbolic-link tmp-name1 tmp-name2) (should (file-symlink-p tmp-name2)) + (should-not (file-regular-p tmp-name2)) (should-error (file-truename tmp-name1) :type 'file-error)))) commit 63fa225d443409038e531fb9843e6d22a2efc94a Merge: 9f5d6c541e5 0400de6a7de Author: Eli Zaretskii Date: Sat Jan 21 09:51:34 2023 +0200 Merge branch 'emacs-29' of git.savannah.gnu.org:/srv/git/emacs into emacs-29 commit 9f5d6c541e55cafb431d8b1226c2d79074574bd6 Author: Eli Zaretskii Date: Sat Jan 21 09:50:59 2023 +0200 ; * doc/emacs/custom.texi (Init Rebinding): Fix wording in last change. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 44c37d3ac83..ee818a74b57 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1888,10 +1888,10 @@ Init Rebinding @xref{Init File}, for a description of the initialization file. @findex keymap-global-set - The recommended way to write a key binding using Lisp is to use one -of the @code{keymap-global-set}, or @code{keymap-set} functions. For -example, here's how to bind @kbd{C-z} to the @code{shell} command in -the global keymap (@pxref{Interactive Shell}): + The recommended way to write a key binding using Lisp is to use +either the @code{keymap-global-set} or the @code{keymap-set} +functions. For example, here's how to bind @kbd{C-z} to the +@code{shell} command in the global keymap (@pxref{Interactive Shell}): @example (keymap-global-set "C-z" 'shell) @@ -1899,18 +1899,19 @@ Init Rebinding @cindex key sequence syntax @noindent -The second argument that describes the key sequence, is a string -containing a series of characters separated by spaces with each -character corresponding to a key. Keys with modifiers can be -specified by prepending the modifier, such as @samp{C-} for Control, -or @samp{M-} for Meta. Special keys, such as @kbd{TAB} and @kbd{RET}, -can be specified within angle brackets as in @kbd{@key{TAB}} and -@kbd{@key{RET}}. - - The single-quote before the command name, @code{shell}, marks it as -a constant symbol rather than a variable. If you omit the quote, -Emacs would try to evaluate @code{shell} as a variable. This probably -causes an error; it certainly isn't what you want. +The first argument to @code{keymap-global-set} describes the key +sequence. It is a string made of a series of characters separated +by spaces, with each character corresponding to a key. Keys with +modifiers can be specified by prepending the modifier, such as +@samp{C-} for Control, or @samp{M-} for Meta. Special keys, such as +@key{TAB} and @key{RET}, can be specified within angle brackets as in +@kbd{@key{TAB}} and @kbd{@key{RET}}. + + The single-quote before the command name that is being bound to the +key sequence, @code{shell} in the above example, marks it as a +constant symbol rather than a variable. If you omit the quote, Emacs +would try to evaluate @code{shell} as a variable. This will probably +cause an error; it certainly isn't what you want. Here are some additional examples, including binding function keys and mouse events: @@ -1929,9 +1930,10 @@ Init Rebinding @findex global-set-key @findex define-key - Alternatively you can use the low level functions @code{define-key} -and @code{global-set-key}. For example to bind @kbd{C-z} to the -@code{shell} command as in the above example, use: + Alternatively, you can use the low level functions @code{define-key} +and @code{global-set-key}. For example, to bind @kbd{C-z} to the +@code{shell} command, as in the above example, using these low-level +functions, use: @example (global-set-key (kbd "C-z") 'shell) @@ -1941,10 +1943,11 @@ Init Rebinding @noindent There are various ways to specify the key sequence but the simplest is to use the function @code{kbd} as shown in the example above. -@code{kbd} takes a single string argument specifying a key sequence in -the syntax described earlier for @code{keymap-global-set}. For more -details about binding keys using Lisp @ref{Keymaps,,, elisp, The Emacs -Lisp Reference Manual}. +@code{kbd} takes a single string argument that is a textual +representation of a key sequence, and converts it into a form suitable +for low-level functions such as @code{global-set-key}. For more +details about binding keys using Lisp, @pxref{Keymaps,,, elisp, The +Emacs Lisp Reference Manual}. @findex keymap-set @findex keymap-unset commit a91b435d0d543f747bbdbd359ab708a3bab67c71 Author: Panagiotis Koutsourakis Date: Tue Jan 17 20:57:41 2023 +0200 ; Reword user documentation on binding keys in Lisp * doc/emacs/custom.texi (Init Rebinding): Move the description of 'kbd' farther down. (Bug#60859) diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 91df15a21d7..44c37d3ac83 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1887,22 +1887,29 @@ Init Rebinding you can specify them in your initialization file by writing Lisp code. @xref{Init File}, for a description of the initialization file. -@findex kbd - There are several ways to write a key binding using Lisp. The -simplest is to use the @code{kbd} function, which converts a textual -representation of a key sequence---similar to how we have written key -sequences in this manual---into a form that can be passed as an -argument to @code{keymap-global-set}. For example, here's how to bind -@kbd{C-z} to the @code{shell} command (@pxref{Interactive Shell}): +@findex keymap-global-set + The recommended way to write a key binding using Lisp is to use one +of the @code{keymap-global-set}, or @code{keymap-set} functions. For +example, here's how to bind @kbd{C-z} to the @code{shell} command in +the global keymap (@pxref{Interactive Shell}): @example (keymap-global-set "C-z" 'shell) @end example +@cindex key sequence syntax @noindent -The single-quote before the command name, @code{shell}, marks it as a -constant symbol rather than a variable. If you omit the quote, Emacs -would try to evaluate @code{shell} as a variable. This probably +The second argument that describes the key sequence, is a string +containing a series of characters separated by spaces with each +character corresponding to a key. Keys with modifiers can be +specified by prepending the modifier, such as @samp{C-} for Control, +or @samp{M-} for Meta. Special keys, such as @kbd{TAB} and @kbd{RET}, +can be specified within angle brackets as in @kbd{@key{TAB}} and +@kbd{@key{RET}}. + + The single-quote before the command name, @code{shell}, marks it as +a constant symbol rather than a variable. If you omit the quote, +Emacs would try to evaluate @code{shell} as a variable. This probably causes an error; it certainly isn't what you want. Here are some additional examples, including binding function keys @@ -1920,6 +1927,25 @@ Init Rebinding Language and coding systems may cause problems with key bindings for non-@acronym{ASCII} characters. @xref{Init Non-ASCII}. +@findex global-set-key +@findex define-key + Alternatively you can use the low level functions @code{define-key} +and @code{global-set-key}. For example to bind @kbd{C-z} to the +@code{shell} command as in the above example, use: + +@example +(global-set-key (kbd "C-z") 'shell) +@end example + +@findex kbd +@noindent +There are various ways to specify the key sequence but the simplest is +to use the function @code{kbd} as shown in the example above. +@code{kbd} takes a single string argument specifying a key sequence in +the syntax described earlier for @code{keymap-global-set}. For more +details about binding keys using Lisp @ref{Keymaps,,, elisp, The Emacs +Lisp Reference Manual}. + @findex keymap-set @findex keymap-unset As described in @ref{Local Keymaps}, major modes and minor modes can commit 0400de6a7de2d27b1141cc9f63ac899e72782b7d Author: Theodor Thornhill Date: Fri Jan 20 22:16:25 2023 +0100 Fix typo in c-ts-mode (bug#60932) * lisp/progmodes/c-ts-mode.el (c-ts-mode-indent-block-type-regexp): enumerator, not enumeratior. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index b13e2036f4f..8ddd622a05a 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -280,7 +280,7 @@ c-ts-mode--top-level-label-matcher (defvar c-ts-mode-indent-block-type-regexp (rx (or "compound_statement" "field_declaration_list" - "enumeratior_list")) + "enumerator_list")) "Regexp matching types of block nodes (i.e., {} blocks).") (defun c-ts-mode--statement-offset (node parent &rest _) commit f4a3e8f29f05f19263d3f600823cdbc0b1cfd3ef Author: Eli Zaretskii Date: Sat Jan 21 08:48:13 2023 +0200 ; * etc/NEWS: Mark 2 entries as documented. diff --git a/etc/NEWS b/etc/NEWS index f9897b33449..4851802716a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -58,10 +58,12 @@ trash when deleting. Default is nil. This works like 'kill-matching-buffers', but without asking for confirmation. ++++ ** New helper variable 'transpose-sexps-function'. Emacs now can set this variable to customize the behavior of the 'transpose-sexps' function. ++++ ** New function 'transpose-sexps-default-function'. The previous implementation is moved into its own function, to be bound by 'transpose-sexps-function'. commit ab538b6f91bcd6f2eac302a11e0cbbd0ab845597 Author: Eli Zaretskii Date: Sat Jan 21 08:46:32 2023 +0200 ; * test/lisp/eshell/esh-var-tests.el: Fix punctuation in doc strings. diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 82324d72163..12412d13640 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -83,7 +83,7 @@ esh-var-test/interp-var-indices '("zero" "two" "four")))) (ert-deftest esh-var-test/interp-var-indices-subcommand () - "Interpolate list variable with subcommand expansion for indices" + "Interpolate list variable with subcommand expansion for indices." (skip-unless (executable-find "echo")) (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) (eshell-command-result-equal @@ -94,7 +94,7 @@ esh-var-test/interp-var-indices-subcommand '("zero" "two")))) (ert-deftest esh-var-test/interp-var-split-indices () - "Interpolate string variable with indices" + "Interpolate string variable with indices." (let ((eshell-test-value "zero one two three four")) (eshell-command-result-equal "echo $eshell-test-value[0]" "zero") @@ -104,7 +104,7 @@ esh-var-test/interp-var-split-indices '("zero" "two" "four")))) (ert-deftest esh-var-test/interp-var-string-split-indices () - "Interpolate string variable with string splitter and indices" + "Interpolate string variable with string splitter and indices." (let ((eshell-test-value "zero:one:two:three:four")) (eshell-command-result-equal "echo $eshell-test-value[: 0]" "zero") @@ -117,7 +117,7 @@ esh-var-test/interp-var-string-split-indices '("zero" "two")))) (ert-deftest esh-var-test/interp-var-regexp-split-indices () - "Interpolate string variable with regexp splitter and indices" + "Interpolate string variable with regexp splitter and indices." (let ((eshell-test-value "zero:one!two:three!four")) (eshell-command-result-equal "echo $eshell-test-value['[:!]' 0]" "zero") @@ -129,7 +129,7 @@ esh-var-test/interp-var-regexp-split-indices '("zero" "two")))) (ert-deftest esh-var-test/interp-var-assoc () - "Interpolate alist variable with index" + "Interpolate alist variable with index." (let ((eshell-test-value '(("foo" . 1) (bar . 2)))) (eshell-command-result-equal "echo $eshell-test-value[foo]" 1) @@ -137,7 +137,7 @@ esh-var-test/interp-var-assoc 2))) (ert-deftest esh-var-test/interp-var-length-list () - "Interpolate length of list variable" + "Interpolate length of list variable." (let ((eshell-test-value '((1 2) (3) (5 (6 7 8 9))))) (eshell-command-result-equal "echo $#eshell-test-value" 3) (eshell-command-result-equal "echo $#eshell-test-value[1]" 1) @@ -149,19 +149,19 @@ esh-var-test/interp-var-length-string (eshell-command-result-equal "echo $#eshell-test-value" 6))) (ert-deftest esh-var-test/interp-var-length-alist () - "Interpolate length of alist variable" + "Interpolate length of alist variable." (let ((eshell-test-value '(("foo" . (1 2 3))))) (eshell-command-result-equal "echo $#eshell-test-value" 1) (eshell-command-result-equal "echo $#eshell-test-value[foo]" 3))) (ert-deftest esh-var-test/interp-var-splice () - "Splice-interpolate list variable" + "Splice-interpolate list variable." (let ((eshell-test-value '(1 2 3))) (eshell-command-result-equal "echo a $@eshell-test-value z" '("a" 1 2 3 "z")))) (ert-deftest esh-var-test/interp-var-splice-concat () - "Splice-interpolate and concat list variable" + "Splice-interpolate and concat list variable." (let ((eshell-test-value '(1 2 3))) (eshell-command-result-equal "echo it is a$@'eshell-test-value'z" '("it" "is" "a1" 2 "3z")) @@ -175,49 +175,49 @@ esh-var-test/interp-var-splice-concat '("it" "is" 1 2 (31 2 3))))) (ert-deftest esh-var-test/interp-lisp () - "Interpolate Lisp form evaluation" + "Interpolate Lisp form evaluation." (eshell-command-result-equal "+ $(+ 1 2) 3" 6)) (ert-deftest esh-var-test/interp-lisp-indices () - "Interpolate Lisp form evaluation with index" + "Interpolate Lisp form evaluation with index." (eshell-command-result-equal "+ $(list 1 2)[1] 3" 5)) (ert-deftest esh-var-test/interp-cmd () - "Interpolate command result" + "Interpolate command result." (eshell-command-result-equal "+ ${+ 1 2} 3" 6)) (ert-deftest esh-var-test/interp-cmd-indices () - "Interpolate command result with index" + "Interpolate command result with index." (eshell-command-result-equal "+ ${listify 1 2}[1] 3" 5)) (ert-deftest esh-var-test/interp-cmd-external () - "Interpolate command result from external command" + "Interpolate command result from external command." (skip-unless (executable-find "echo")) (with-temp-eshell (eshell-match-command-output "echo ${*echo hi}" "hi\n"))) (ert-deftest esh-var-test/interp-cmd-external-indices () - "Interpolate command result from external command with index" + "Interpolate command result from external command with index." (skip-unless (executable-find "echo")) (with-temp-eshell (eshell-match-command-output "echo ${*echo \"hi\nbye\"}[1]" "bye\n"))) (ert-deftest esh-var-test/interp-temp-cmd () - "Interpolate command result redirected to temp file" + "Interpolate command result redirected to temp file." (eshell-command-result-equal "cat $" "hi")) (ert-deftest esh-var-test/interp-concat-lisp () - "Interpolate and concat Lisp form" + "Interpolate and concat Lisp form." (eshell-command-result-equal "+ $(+ 1 2)3 3" 36)) (ert-deftest esh-var-test/interp-concat-lisp2 () - "Interpolate and concat two Lisp forms" + "Interpolate and concat two Lisp forms." (eshell-command-result-equal "+ $(+ 1 2)$(+ 1 2) 3" 36)) (ert-deftest esh-var-test/interp-concat-cmd () - "Interpolate and concat command with literal" + "Interpolate and concat command with literal." (eshell-command-result-equal "+ ${+ 1 2}3 3" 36) (eshell-command-result-equal "echo ${*echo \"foo\nbar\"}-baz" '("foo" "bar-baz")) @@ -230,11 +230,11 @@ esh-var-test/interp-concat-cmd '("hi" "23"))) (ert-deftest esh-var-test/interp-concat-cmd2 () - "Interpolate and concat two commands" + "Interpolate and concat two commands." (eshell-command-result-equal "+ ${+ 1 2}${+ 1 2} 3" 36)) (ert-deftest esh-var-test/interp-concat-cmd-external () - "Interpolate command result from external command with concatenation" + "Interpolate command result from external command with concatenation." (skip-unless (executable-find "echo")) (with-temp-eshell (eshell-match-command-output "echo ${echo hi}-${*echo there}" @@ -244,7 +244,7 @@ esh-var-test/interp-concat-cmd-external ;; Quoted variable interpolation (ert-deftest esh-var-test/quoted-interp-var () - "Interpolate variable inside double-quotes" + "Interpolate variable inside double-quotes." (eshell-command-result-equal "echo \"$user-login-name\"" user-login-name)) @@ -256,7 +256,7 @@ esh-var-test/quoted-interp-quoted-var (concat "hi, " user-login-name))) (ert-deftest esh-var-test/quoted-interp-list-var () - "Interpolate list variable inside double-quotes" + "Interpolate list variable inside double-quotes." (let ((eshell-test-value '(1 2 3))) (eshell-command-result-equal "echo \"$eshell-test-value\"" "(1 2 3)"))) @@ -268,7 +268,7 @@ esh-var-test/quoted-interp-list-var-concat "a(1 2 3)z"))) (ert-deftest esh-var-test/quoted-interp-var-indices () - "Interpolate string variable with indices inside double-quotes" + "Interpolate string variable with indices inside double-quotes." (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) (eshell-command-result-equal "echo \"$eshell-test-value[0]\"" "zero") @@ -283,8 +283,7 @@ esh-var-test/quoted-interp-var-indices "(\"one\" \"two\" \"four\")"))) (ert-deftest esh-var-test/quote-interp-var-indices-subcommand () - "Interpolate list variable with subcommand expansion for indices -inside double-quotes" + "Interpolate list variable with subcommand expansion for indices inside double-quotes." (skip-unless (executable-find "echo")) (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) (eshell-command-result-equal @@ -297,7 +296,7 @@ esh-var-test/quote-interp-var-indices-subcommand "(\"one\" \"two\")"))) (ert-deftest esh-var-test/quoted-interp-var-split-indices () - "Interpolate string variable with indices inside double-quotes" + "Interpolate string variable with indices inside double-quotes." (let ((eshell-test-value "zero one two three four")) (eshell-command-result-equal "echo \"$eshell-test-value[0]\"" "zero") @@ -305,8 +304,7 @@ esh-var-test/quoted-interp-var-split-indices "(\"zero\" \"two\")"))) (ert-deftest esh-var-test/quoted-interp-var-string-split-indices () - "Interpolate string variable with string splitter and indices -inside double-quotes" + "Interpolate string variable with string splitter and indices inside double-quotes." (let ((eshell-test-value "zero:one:two:three:four")) (eshell-command-result-equal "echo \"$eshell-test-value[: 0]\"" "zero") @@ -319,7 +317,7 @@ esh-var-test/quoted-interp-var-string-split-indices "(\"zero\" \"two\")"))) (ert-deftest esh-var-test/quoted-interp-var-regexp-split-indices () - "Interpolate string variable with regexp splitter and indices" + "Interpolate string variable with regexp splitter and indices." (let ((eshell-test-value "zero:one!two:three!four")) (eshell-command-result-equal "echo \"$eshell-test-value['[:!]' 0]\"" "zero") @@ -332,7 +330,7 @@ esh-var-test/quoted-interp-var-regexp-split-indices "(\"zero\" \"two\")"))) (ert-deftest esh-var-test/quoted-interp-var-assoc () - "Interpolate alist variable with index inside double-quotes" + "Interpolate alist variable with index inside double-quotes." (let ((eshell-test-value '(("foo" . 1) (bar . 2)))) (eshell-command-result-equal "echo \"$eshell-test-value[foo]\"" "1") @@ -340,7 +338,7 @@ esh-var-test/quoted-interp-var-assoc "2"))) (ert-deftest esh-var-test/quoted-interp-var-length-list () - "Interpolate length of list variable inside double-quotes" + "Interpolate length of list variable inside double-quotes." (let ((eshell-test-value '((1 2) (3) (5 (6 7 8 9))))) (eshell-command-result-equal "echo \"$#eshell-test-value\"" "3") @@ -350,13 +348,13 @@ esh-var-test/quoted-interp-var-length-list "4"))) (ert-deftest esh-var-test/quoted-interp-var-length-string () - "Interpolate length of string variable inside double-quotes" + "Interpolate length of string variable inside double-quotes." (let ((eshell-test-value "foobar")) (eshell-command-result-equal "echo \"$#eshell-test-value\"" "6"))) (ert-deftest esh-var-test/quoted-interp-var-length-alist () - "Interpolate length of alist variable inside double-quotes" + "Interpolate length of alist variable inside double-quotes." (let ((eshell-test-value '(("foo" . (1 2 3))))) (eshell-command-result-equal "echo \"$#eshell-test-value\"" "1") @@ -364,7 +362,7 @@ esh-var-test/quoted-interp-var-length-alist "3"))) (ert-deftest esh-var-test/quoted-interp-var-splice () - "Splice-interpolate list variable inside double-quotes" + "Splice-interpolate list variable inside double-quotes." (let ((eshell-test-value '(1 2 3))) (eshell-command-result-equal "echo a \"$@eshell-test-value\" z" '("a" "1 2 3" "z")))) @@ -376,27 +374,27 @@ esh-var-test/quoted-interp-var-splice-concat "a1 2 3z"))) (ert-deftest esh-var-test/quoted-interp-lisp () - "Interpolate Lisp form evaluation inside double-quotes" + "Interpolate Lisp form evaluation inside double-quotes." (eshell-command-result-equal "echo \"hi $(concat \\\"the\\\" \\\"re\\\")\"" "hi there")) (ert-deftest esh-var-test/quoted-interp-lisp-indices () - "Interpolate Lisp form evaluation with index" + "Interpolate Lisp form evaluation with index." (eshell-command-result-equal "concat \"$(list 1 2)[1]\" cool" "2cool")) (ert-deftest esh-var-test/quoted-interp-cmd () - "Interpolate command result inside double-quotes" + "Interpolate command result inside double-quotes." (eshell-command-result-equal "echo \"hi ${echo \\\"there\\\"}\"" "hi there")) (ert-deftest esh-var-test/quoted-interp-cmd-indices () - "Interpolate command result with index inside double-quotes" + "Interpolate command result with index inside double-quotes." (eshell-command-result-equal "concat \"${listify 1 2}[1]\" cool" "2cool")) (ert-deftest esh-var-test/quoted-interp-temp-cmd () - "Interpolate command result redirected to temp file inside double-quotes" + "Interpolate command result redirected to temp file inside double-quotes." (let ((temporary-file-directory (file-name-as-directory (make-temp-file "esh-vars-tests" t)))) (unwind-protect @@ -404,7 +402,7 @@ esh-var-test/quoted-interp-temp-cmd (delete-directory temporary-file-directory t)))) (ert-deftest esh-var-test/quoted-interp-concat-cmd () - "Interpolate and concat command with literal" + "Interpolate and concat command with literal." (eshell-command-result-equal "echo \"${echo \\\"foo\nbar\\\"} baz\"" "foo\nbar baz")) @@ -412,13 +410,13 @@ esh-var-test/quoted-interp-concat-cmd ;; Interpolating commands (ert-deftest esh-var-test/command-interp () - "Interpolate a variable as a command name" + "Interpolate a variable as a command name." (let ((eshell-test-value "printnl")) (eshell-command-result-equal "$eshell-test-value hello there" "hello\nthere\n"))) (ert-deftest esh-var-test/command-interp-splice () - "Interpolate a splice variable as a command name with arguments" + "Interpolate a splice variable as a command name with arguments." (let ((eshell-test-value '("printnl" "hello" "there"))) (eshell-command-result-equal "$@eshell-test-value" "hello\nthere\n"))) @@ -427,13 +425,13 @@ esh-var-test/command-interp-splice ;; Interpolated variable conversion (ert-deftest esh-var-test/interp-convert-var-number () - "Interpolate numeric variable" + "Interpolate numeric variable." (let ((eshell-test-value 123)) (eshell-command-result-equal "type-of $eshell-test-value" 'integer))) (ert-deftest esh-var-test/interp-convert-var-split-indices () - "Interpolate and convert string variable with indices" + "Interpolate and convert string variable with indices." ;; Check that numeric forms are converted to numbers. (let ((eshell-test-value "000 010 020 030 040")) (eshell-command-result-equal "echo $eshell-test-value[0]" @@ -448,7 +446,7 @@ esh-var-test/interp-convert-var-split-indices "baz\n"))) (ert-deftest esh-var-test/interp-convert-quoted-var-number () - "Interpolate numeric quoted numeric variable" + "Interpolate numeric quoted numeric variable." (let ((eshell-test-value 123)) (eshell-command-result-equal "type-of $'eshell-test-value'" 'integer) @@ -456,7 +454,7 @@ esh-var-test/interp-convert-quoted-var-number 'integer))) (ert-deftest esh-var-test/interp-convert-quoted-var-split-indices () - "Interpolate and convert quoted string variable with indices" + "Interpolate and convert quoted string variable with indices." (let ((eshell-test-value "000 010 020 030 040")) (eshell-command-result-equal "echo $'eshell-test-value'[0]" 0) @@ -464,11 +462,11 @@ esh-var-test/interp-convert-quoted-var-split-indices '(0 20)))) (ert-deftest esh-var-test/interp-convert-cmd-string-newline () - "Interpolate trailing-newline command result" + "Interpolate trailing-newline command result." (eshell-command-result-equal "echo ${echo \"foo\n\"}" "foo")) (ert-deftest esh-var-test/interp-convert-cmd-multiline () - "Interpolate multi-line command result" + "Interpolate multi-line command result." (eshell-command-result-equal "echo ${echo \"foo\nbar\"}" '("foo" "bar")) ;; Numeric output should be converted to numbers... @@ -479,24 +477,24 @@ esh-var-test/interp-convert-cmd-multiline '("01" "02" "hi"))) (ert-deftest esh-var-test/interp-convert-cmd-number () - "Interpolate numeric command result" + "Interpolate numeric command result." (eshell-command-result-equal "echo ${echo \"1\"}" 1)) (ert-deftest esh-var-test/interp-convert-cmd-split-indices () - "Interpolate command result with indices" + "Interpolate command result with indices." (eshell-command-result-equal "echo ${echo \"000 010 020\"}[0]" 0) (eshell-command-result-equal "echo ${echo \"000 010 020\"}[0 2]" '(0 20))) (ert-deftest esh-var-test/quoted-interp-convert-var-number () - "Interpolate numeric variable inside double-quotes" + "Interpolate numeric variable inside double-quotes." (let ((eshell-test-value 123)) (eshell-command-result-equal "type-of \"$eshell-test-value\"" 'string))) (ert-deftest esh-var-test/quoted-interp-convert-var-split-indices () - "Interpolate string variable with indices inside double-quotes" + "Interpolate string variable with indices inside double-quotes." (let ((eshell-test-value "000 010 020 030 040")) (eshell-command-result-equal "echo \"$eshell-test-value[0]\"" "000") @@ -504,7 +502,7 @@ esh-var-test/quoted-interp-convert-var-split-indices "(\"000\" \"020\")"))) (ert-deftest esh-var-test/quoted-interp-convert-quoted-var-number () - "Interpolate numeric quoted variable inside double-quotes" + "Interpolate numeric quoted variable inside double-quotes." (let ((eshell-test-value 123)) (eshell-command-result-equal "type-of \"$'eshell-test-value'\"" 'string) @@ -512,7 +510,7 @@ esh-var-test/quoted-interp-convert-quoted-var-number 'string))) (ert-deftest esh-var-test/quoted-interp-convert-quoted-var-split-indices () - "Interpolate quoted string variable with indices inside double-quotes" + "Interpolate quoted string variable with indices inside double-quotes." (let ((eshell-test-value "000 010 020 030 040")) (eshell-command-result-equal "echo \"$eshell-test-value[0]\"" "000") @@ -520,23 +518,23 @@ esh-var-test/quoted-interp-convert-quoted-var-split-indices "(\"000\" \"020\")"))) (ert-deftest esh-var-test/quoted-interp-convert-cmd-string-newline () - "Interpolate trailing-newline command result inside double-quotes" + "Interpolate trailing-newline command result inside double-quotes." (eshell-command-result-equal "echo \"${echo \\\"foo\n\\\"}\"" "foo") (eshell-command-result-equal "echo \"${echo \\\"foo\n\n\\\"}\"" "foo")) (ert-deftest esh-var-test/quoted-interp-convert-cmd-multiline () - "Interpolate multi-line command result inside double-quotes" + "Interpolate multi-line command result inside double-quotes." (eshell-command-result-equal "echo \"${echo \\\"foo\nbar\\\"}\"" "foo\nbar")) (ert-deftest esh-var-test/quoted-interp-convert-cmd-number () - "Interpolate numeric command result inside double-quotes" + "Interpolate numeric command result inside double-quotes." (eshell-command-result-equal "echo \"${echo \\\"1\\\"}\"" "1")) (ert-deftest esh-var-test/quoted-interp-convert-cmd-split-indices () - "Interpolate command result with indices inside double-quotes" + "Interpolate command result with indices inside double-quotes." (eshell-command-result-equal "echo \"${echo \\\"000 010 020\\\"}[0]\"" "000")) @@ -695,19 +693,19 @@ esh-var-test/lines-var (window-body-height nil 'remap))) (ert-deftest esh-var-test/columns-var () - "$COLUMNS should equal (window-body-width nil 'remap)" + "$COLUMNS should equal (window-body-width nil 'remap)." (eshell-command-result-equal "echo $COLUMNS" (window-body-width nil 'remap))) (ert-deftest esh-var-test/inside-emacs-var () - "Test presence of \"INSIDE_EMACS\" in subprocesses" + "Test presence of \"INSIDE_EMACS\" in subprocesses." (with-temp-eshell (eshell-match-command-output "env" (format "INSIDE_EMACS=%s,eshell" emacs-version)))) (ert-deftest esh-var-test/inside-emacs-var-split-indices () - "Test using \"INSIDE_EMACS\" with split indices" + "Test using \"INSIDE_EMACS\" with split indices." (with-temp-eshell (eshell-match-command-output "echo $INSIDE_EMACS[, 1]" "eshell"))) @@ -776,7 +774,7 @@ esh-var-test/uid-var (eshell-command-result-equal "echo $UID" (user-uid))) (ert-deftest esh-var-test/last-status-var-lisp-command () - "Test using the \"last exit status\" ($?) variable with a Lisp command" + "Test using the \"last exit status\" ($?) variable with a Lisp command." (with-temp-eshell (eshell-match-command-output "zerop 0; echo $?" "t\n0\n") @@ -786,7 +784,7 @@ esh-var-test/last-status-var-lisp-command "1\n" nil t))) (ert-deftest esh-var-test/last-status-var-lisp-form () - "Test using the \"last exit status\" ($?) variable with a Lisp form" + "Test using the \"last exit status\" ($?) variable with a Lisp form." (let ((eshell-lisp-form-nil-is-failure t)) (with-temp-eshell (eshell-match-command-output "(zerop 0); echo $?" @@ -809,7 +807,7 @@ esh-var-test/last-status-var-lisp-form-2 "1\n" nil t)))) (ert-deftest esh-var-test/last-status-var-ext-cmd () - "Test using the \"last exit status\" ($?) variable with an external command" + "Test using the \"last exit status\" ($?) variable with an external command." (skip-unless (executable-find "[")) (with-temp-eshell (eshell-match-command-output "[ foo = foo ]; echo $?" @@ -818,19 +816,19 @@ esh-var-test/last-status-var-ext-cmd "1\n"))) (ert-deftest esh-var-test/last-result-var () - "Test using the \"last result\" ($$) variable" + "Test using the \"last result\" ($$) variable." (with-temp-eshell (eshell-match-command-output "+ 1 2; + $$ 2" "3\n5\n"))) (ert-deftest esh-var-test/last-result-var-twice () - "Test using the \"last result\" ($$) variable twice" + "Test using the \"last result\" ($$) variable twice." (with-temp-eshell (eshell-match-command-output "+ 1 2; + $$ $$" "3\n6\n"))) (ert-deftest esh-var-test/last-result-var-ext-cmd () - "Test using the \"last result\" ($$) variable with an external command" + "Test using the \"last result\" ($$) variable with an external command." (skip-unless (executable-find "[")) (with-temp-eshell ;; MS-DOS/MS-Windows have an external command 'format', which we @@ -842,7 +840,7 @@ esh-var-test/last-result-var-ext-cmd "nil\n")))) (ert-deftest esh-var-test/last-result-var-split-indices () - "Test using the \"last result\" ($$) variable with split indices" + "Test using the \"last result\" ($$) variable with split indices." (with-temp-eshell (eshell-match-command-output "string-join (list \"01\" \"02\") :; + $$[: 1] 3" @@ -852,13 +850,13 @@ esh-var-test/last-result-var-split-indices "01:02\n02\n"))) (ert-deftest esh-var-test/last-arg-var () - "Test using the \"last arg\" ($_) variable" + "Test using the \"last arg\" ($_) variable." (with-temp-eshell (eshell-match-command-output "+ 1 2; + $_ 4" "3\n6\n"))) (ert-deftest esh-var-test/last-arg-var-indices () - "Test using the \"last arg\" ($_) variable with indices" + "Test using the \"last arg\" ($_) variable with indices." (with-temp-eshell (eshell-match-command-output "+ 1 2; + $_[0] 4" "3\n5\n") @@ -866,7 +864,7 @@ esh-var-test/last-arg-var-indices "3\n6\n"))) (ert-deftest esh-var-test/last-arg-var-split-indices () - "Test using the \"last arg\" ($_) variable with split indices" + "Test using the \"last arg\" ($_) variable with split indices." (with-temp-eshell (eshell-match-command-output "concat 01:02 03:04; + $_[0][: 1] 5" "01:0203:04\n7\n") commit 3dacf583b90c35ffea13e4ae54010df957f0b1b3 Author: Eli Zaretskii Date: Sat Jan 21 08:35:53 2023 +0200 ; Fix documentation of 'kill-matching-buffers-no-ask' * etc/NEWS: Fix wording of 'kill-matching-buffers-no-ask's entry. * lisp/files.el (kill-matching-buffers) (kill-matching-buffers-no-ask): Doc fix. diff --git a/etc/NEWS b/etc/NEWS index f71924812c9..f9897b33449 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -53,8 +53,9 @@ trash when deleting. Default is nil. * Editing Changes in Emacs 30.1 +--- ** New command 'kill-matching-buffers-no-ask'. -Kills buffers whose name matches a regexp without asking for +This works like 'kill-matching-buffers', but without asking for confirmation. ** New helper variable 'transpose-sexps-function'. diff --git a/lisp/files.el b/lisp/files.el index d308e99804d..9da82446112 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7100,10 +7100,11 @@ kill-some-buffers (setq list (cdr list)))) (defun kill-matching-buffers (regexp &optional internal-too no-ask) - "Kill buffers whose name matches the specified REGEXP. -Ignores buffers whose name starts with a space, unless optional -prefix argument INTERNAL-TOO is non-nil. Asks before killing -each buffer, unless NO-ASK is non-nil." + "Kill buffers whose names match the regular expression REGEXP. +Interactively, prompt for REGEXP. +Ignores buffers whose names start with a space, unless optional +prefix argument INTERNAL-TOO(interactively, the prefix argument) +is non-nil. Asks before killing each buffer, unless NO-ASK is non-nil." (interactive "sKill buffers matching this regular expression: \nP") (dolist (buffer (buffer-list)) (let ((name (buffer-name buffer))) @@ -7113,11 +7114,13 @@ kill-matching-buffers (funcall (if no-ask 'kill-buffer 'kill-buffer-ask) buffer))))) (defun kill-matching-buffers-no-ask (regexp &optional internal-too) - "Kill buffers whose name matches the specified REGEXP. -Ignores buffers whose name starts with a space, unless optional -prefix argument INTERNAL-TOO is non-nil. Equivalent to -`kill-matching-buffers' but never ask before killing each -buffer." + "Kill buffers whose names match the regular expression REGEXP. +Interactively, prompt for REGEXP. +Like `kill-matching-buffers', but doesn't ask for confirmation +before killing each buffer. +Ignores buffers whose names start with a space, unless the +optional argument INTERNAL-TOO (interactively, the prefix argument) +is non-nil." (interactive "sKill buffers matching this regular expression: \nP") (kill-matching-buffers regexp internal-too t)) commit 623fdf30ff3b7c3e97b5022e2cdcb109430dcc01 Author: Eli Zaretskii Date: Sat Jan 21 08:25:51 2023 +0200 ; * etc/NEWS: Fix wording of 'html-ts-mode's entry. diff --git a/etc/NEWS b/etc/NEWS index ceae78a6601..f71924812c9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -186,7 +186,7 @@ activate this behavior. +++ *** New major mode 'html-ts-mode'. An optional major mode based on the tree-sitter library for editing -files written in HTML. +HTML files. --- ** The highly accessible Modus themes collection has six items. commit b3de81a6ee3b379fc1dfb9a071e469365081f438 Author: Mike Kupfer Date: Mon Jan 16 13:50:49 2023 -0800 MH-E: handle removal of mhparam libdir from nmh 1.8 * lisp/mh-e/mh-e.el (mh-variant-nmh-info): If "libdir" doesn't work, try "libexecdir" (Bug#60952) (SF#491). diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 1640c23e002..34c809a5ecd 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -764,6 +764,8 @@ mh-variant-nmh-info ;; Sample '-version' outputs: ;; mhparam -- nmh-1.1-RC1 [compiled on chaak at Fri Jun 20 11:03:28 PDT 2003] ;; install-mh -- nmh-1.7.1 built October 26, 2019 on build-server-000 + ;; "libdir" was deprecated in nmh-1.7 in favor of "libexecdir", and + ;; removed completely in nmh-1.8. (let ((install-mh (expand-file-name "install-mh" dir))) (when (mh-file-command-p install-mh) (erase-buffer) @@ -774,7 +776,8 @@ mh-variant-nmh-info (mh-progs dir)) `(,version (variant nmh) - (mh-lib-progs ,(mh-profile-component "libdir")) + (mh-lib-progs ,(or (mh-profile-component "libdir") + (mh-profile-component "libexecdir"))) (mh-lib ,(mh-profile-component "etcdir")) (mh-progs ,dir) (flists ,(file-exists-p commit ca8f5f71f412f29d52da0bdb8ac196d298b3b0d3 Author: Theodor Thornhill Date: Fri Jan 20 22:59:51 2023 +0100 Change top-level anchor to point-min * lisp/textmodes/html-ts-mode.el (html-ts-mode--indent-rules): Anchor to point-min. diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index 3f88a087163..7e4360747a3 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el @@ -42,7 +42,7 @@ html-ts-mode-indent-offset (defvar html-ts-mode--indent-rules `((html - ((parent-is "fragment") parent-bol 0) + ((parent-is "fragment") point-min 0) ((node-is "/>") parent-bol 0) ((node-is ">") parent-bol 0) ((node-is "end_tag") parent-bol 0) commit d63e1a89518338bc3450b11d6c2d4644cb0440e1 Author: Theodor Thornhill Date: Fri Jan 20 22:37:47 2023 +0100 Use point-min to anchor top-level constructs (bug#60602) * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): New anchor. * lisp/progmodes/java-ts-mode.el (java-ts-mode--indent-rules): New anchor. * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules): New anchor. * lisp/progmodes/typescript-ts-mode.el (typescript-ts-mode--indent-rules): New anchor. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 5749e568185..b13e2036f4f 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -167,7 +167,7 @@ c-ts-mode--indent-styles "Indent rules supported by `c-ts-mode'. MODE is either `c' or `cpp'." (let ((common - `(((parent-is "translation_unit") parent-bol 0) + `(((parent-is "translation_unit") point-min 0) ((node-is ")") parent 1) ((node-is "]") parent-bol 0) ((node-is "else") parent-bol 0) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index d909a366e5d..8251d9603c3 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -69,7 +69,7 @@ java-ts-mode--syntax-table (defvar java-ts-mode--indent-rules `((java - ((parent-is "program") parent-bol 0) + ((parent-is "program") point-min 0) ((node-is "}") (and parent parent-bol) 0) ((node-is ")") parent-bol 0) ((node-is "]") parent-bol 0) diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 2a7d850c3e3..ac0b5d7c6d4 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -555,7 +555,7 @@ ruby-ts--indent-rules (let ((common `( ;; Slam all top level nodes to the left margin - ((parent-is "program") parent 0) + ((parent-is "program") point-min 0) ;; Do not indent here docs or the end. Not sure why it ;; takes the grand-parent but ok fine. diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index 6aaa852895c..903be93422d 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -69,7 +69,7 @@ typescript-ts-mode--indent-rules "Rules used for indentation. Argument LANGUAGE is either `typescript' or `tsx'." `((,language - ((parent-is "program") parent-bol 0) + ((parent-is "program") point-min 0) ((node-is "}") parent-bol 0) ((node-is ")") parent-bol 0) ((node-is "]") parent-bol 0) commit 34793337783489297313c67d4a56682514877597 Author: Dmitry Gutov Date: Fri Jan 20 23:32:21 2023 +0200 * lisp/org/ob-ruby.el: Fix outdated comments. diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index 03c94b1ba99..b94bc73dd79 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -29,11 +29,10 @@ ;; - ruby and irb executables :: https://www.ruby-lang.org/ ;; -;; - ruby-mode :: Can be installed through ELPA, or from -;; https://github.com/eschulte/rinari/raw/master/util/ruby-mode.el +;; - ruby-mode :: Comes with Emacs. ;; ;; - inf-ruby mode :: Can be installed through ELPA, or from -;; https://github.com/eschulte/rinari/raw/master/util/inf-ruby.el +;; https://raw.githubusercontent.com/nonsequitur/inf-ruby/master/inf-ruby.el ;;; Code: commit affdf7901190789616eb40d4c2857974d5394491 Author: Theodor Thornhill Date: Fri Jan 20 22:16:25 2023 +0100 Fix typo in c-ts-mode (bug#60932) * lisp/progmodes/c-ts-mode.el (c-ts-mode-indent-block-type-regexp): enumerator, not enumeratior. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index b3d162cd3ab..348d027af19 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -228,7 +228,7 @@ c-ts-mode--top-level-label-matcher (defvar c-ts-mode-indent-block-type-regexp (rx (or "compound_statement" "field_declaration_list" - "enumeratior_list")) + "enumerator_list")) "Regexp matching types of block nodes (i.e., {} blocks).") (defun c-ts-mode--statement-offset (node parent &rest _) commit c6a7664f06710751b1122eff4492557ef5b2bfba Author: Theodor Thornhill Date: Fri Jan 20 21:05:41 2023 +0100 Add html-ts-mode (bug#60972) * lisp/textmodes/html-ts-mode.el: New major mode for HTML support powered by Tree-sitter. * etc/NEWS: Mention it in NEWS. diff --git a/etc/NEWS b/etc/NEWS index f111d401df8..ceae78a6601 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -181,6 +181,13 @@ activate this behavior. * New Modes and Packages in Emacs 30.1 +** New major modes based on the tree-sitter library. + ++++ +*** New major mode 'html-ts-mode'. +An optional major mode based on the tree-sitter library for editing +files written in HTML. + --- ** The highly accessible Modus themes collection has six items. The 'modus-operandi' and 'modus-vivendi' are the main themes that have diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el new file mode 100644 index 00000000000..3f88a087163 --- /dev/null +++ b/lisp/textmodes/html-ts-mode.el @@ -0,0 +1,137 @@ +;;; html-ts-mode.el --- tree-sitter support for HTML -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author : Theodor Thornhill +;; Maintainer : Theodor Thornhill +;; Created : January 2023 +;; Keywords : html languages tree-sitter + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; + +;;; Code: + +(require 'treesit) +(require 'sgml-mode) + +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-node-type "treesit.c") + +(defcustom html-ts-mode-indent-offset 2 + "Number of spaces for each indentation step in `html-ts-mode'." + :version "29.1" + :type 'integer + :safe 'integerp + :group 'html) + +(defvar html-ts-mode--indent-rules + `((html + ((parent-is "fragment") parent-bol 0) + ((node-is "/>") parent-bol 0) + ((node-is ">") parent-bol 0) + ((node-is "end_tag") parent-bol 0) + ((parent-is "comment") prev-adaptive-prefix 0) + ((parent-is "element") parent-bol html-ts-mode-indent-offset) + ((parent-is "script_element") parent-bol html-ts-mode-indent-offset) + ((parent-is "style_element") parent-bol html-ts-mode-indent-offset) + ((parent-is "start_tag") parent-bol html-ts-mode-indent-offset) + ((parent-is "self_closing_tag") parent-bol html-ts-mode-indent-offset))) + "Tree-sitter indent rules.") + +(defvar html-ts-mode--font-lock-settings + (treesit-font-lock-rules + :language 'html + :override t + :feature 'comment + `((comment) @font-lock-comment-face) + :language 'html + :override t + :feature 'keyword + `("doctype" @font-lock-keyword-face) + :language 'html + :override t + :feature 'definition + `((tag_name) @font-lock-function-name-face) + :language 'html + :override t + :feature 'string + `((quoted_attribute_value) @font-lock-string-face) + :language 'html + :override t + :feature 'property + `((attribute_name) @font-lock-variable-name-face)) + "Tree-sitter font-lock settings for `html-ts-mode'.") + +(defun html-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." + (when (equal (treesit-node-type node) "tag_name") + (treesit-node-text node t))) + +;;;###autoload +(define-derived-mode html-ts-mode html-mode "HTML" + "Major mode for editing Html, powered by tree-sitter." + :group 'html + + (unless (treesit-ready-p 'html) + (error "Tree-sitter for HTML isn't available")) + + (treesit-parser-create 'html) + + ;; Comments. + (setq-local treesit-text-type-regexp + (regexp-opt '("comment" "text"))) + + ;; Indent. + (setq-local treesit-simple-indent-rules html-ts-mode--indent-rules) + + ;; Navigation. + (setq-local treesit-defun-type-regexp "element") + + (setq-local treesit-defun-name-function #'html-ts-mode--defun-name) + + (setq-local treesit-sentence-type-regexp + (regexp-opt '("start_tag" + "self_closing_tag" + "end_tag"))) + + (setq-local treesit-sexp-type-regexp + (regexp-opt '("tag" + "text" + "attribute" + "value"))) + + ;; Font-lock. + (setq-local treesit-font-lock-settings html-ts-mode--font-lock-settings) + (setq-local treesit-font-lock-feature-list + '((comment keyword definition) + (property string) + () ())) + + ;; Imenu. + (setq-local treesit-simple-imenu-settings + '(("Element" "\\`tag_name\\'" nil nil))) + (treesit-major-mode-setup)) + +(if (treesit-ready-p 'html) + (add-to-list 'auto-mode-alist '("\\.html\\'" . html-ts-mode))) + +(provide 'html-ts-mode) + +;;; html-ts-mode.el ends here commit 472f142598566fbaeedcacaf9a9c757a1281c0c5 Author: Dmitry Gutov Date: Fri Jan 20 19:25:12 2023 +0200 ; ruby-ts-mode: Add a Version tag diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 4a00914371f..2a7d850c3e3 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -5,6 +5,7 @@ ;; Author: Perry Smith ;; Created: December 2022 ;; Keywords: ruby languages tree-sitter +;; Version: 0.2 ;; This file is part of GNU Emacs. commit 0cf053648a4f7d33f78700e40c0d5b790814135a Author: Dmitry Gutov Date: Fri Jan 20 19:08:22 2023 +0200 ; ruby-ts-mode: Update font-lock features list in Commentary diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index d143c06a8a4..4a00914371f 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -50,11 +50,11 @@ ;; Currently tree treesit-font-lock-feature-list is set with the ;; following levels: -;; 1: comment method-definition +;; 1: comment method-definition parameter-definition ;; 2: keyword regexp string type -;; 3: builtin-variable builtin-constant constant +;; 3: builtin-variable builtin-constant builtin-function ;; delimiter escape-sequence -;; global instance +;; constant global instance ;; interpolation literal symbol assignment ;; 4: bracket error function operator punctuation commit 67ee627c38d5817a091a89e0a356fb8028c70e1a Author: Dmitry Gutov Date: Fri Jan 20 18:43:56 2023 +0200 (project-try-vc): Add string-start and string-end anchors to marker-re * lisp/progmodes/project.el (project-try-vc): Add string-start and string-end anchors to marker-re (bug#60956). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index dc87cb8e15d..59270070484 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,7 +1,7 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2023 Free Software Foundation, Inc. -;; Version: 0.9.4 +;; Version: 0.9.5 ;; Package-Requires: ((emacs "26.1") (xref "1.4.0")) ;; This is a GNU ELPA :core package. Avoid using functionality that @@ -514,11 +514,14 @@ project-try-vc (lambda (b) (assoc-default b backend-markers-alist)) vc-handled-backends))) (marker-re - (mapconcat - (lambda (m) (format "\\(%s\\)" (wildcard-to-regexp m))) - (append backend-markers - (project--value-in-dir 'project-vc-extra-root-markers dir)) - "\\|")) + (concat + "\\`" + (mapconcat + (lambda (m) (format "\\(%s\\)" (wildcard-to-regexp m))) + (append backend-markers + (project--value-in-dir 'project-vc-extra-root-markers dir)) + "\\|") + "\\'")) (locate-dominating-stop-dir-regexp (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp)) last-matches commit 06953fc8e1d70397f421e1c6efc327af8e0bad6c Author: Robert Pluim Date: Thu Jan 19 16:05:45 2023 +0100 Make `keymap-set-after' work for menus It still doesn't work for an AFTER that's a key, though, since `key-parse' produces vectors, and keymaps contain integers. * lisp/keymap.el (keymap-set-after): Only parse AFTER as a key if it's a string. For consistency, use `key-parse' on the definition if it's a string, just like `keymap-set'. * test/src/keymap-tests.el (keymap-tests--command-3): New dummy command. (keymap-set-after-menus): New test. Check that we can insert a menu item after a specific entry. diff --git a/lisp/keymap.el b/lisp/keymap.el index 89461416a9c..791221f2459 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -187,10 +187,16 @@ keymap-set-after (compiler-macro (lambda (form) (keymap--compile-check key) form))) (keymap--check key) (when (eq after t) (setq after nil)) ; nil and t are treated the same - (when after - (keymap--check after)) + (when (stringp after) + (keymap--check after) + (setq after (key-parse after))) + ;; If we're binding this key to another key, then parse that other + ;; key, too. + (when (stringp definition) + (keymap--check definition) + (setq definition (key-parse definition))) (define-key-after keymap (key-parse key) definition - (and after (key-parse after)))) + after)) (defun key-parse (keys) "Convert KEYS to the internal Emacs key representation. diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index d7be2cac53a..aa710519825 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -226,6 +226,7 @@ keymap-store_in_keymap-XFASTINT-on-non-characters (defun keymap-tests--command-1 () (interactive) nil) (defun keymap-tests--command-2 () (interactive) nil) +(defun keymap-tests--command-3 () (interactive) nil) (put 'keymap-tests--command-1 :advertised-binding [?y]) (ert-deftest keymap-where-is-internal () @@ -446,6 +447,22 @@ keymap-set-consistency (should-not (keymap-set-after k "f" "f" "a")) (should (equal (keymap-lookup k "f") (key-parse "f"))))) +(ert-deftest keymap-set-after-menus () + (let ((map (make-sparse-keymap))) + (keymap-set map "" + '(menu-item "Run Command 1" keymap-tests--command-1 + :help "Command 1 Help")) + (keymap-set-after map "" + '(menu-item "Run Command 2" keymap-tests--command-2 + :help "Command 2 Help")) + (keymap-set-after map "" + '(menu-item "Run Command 3" keymap-tests--command-3 + :help "Command 3 Help") + 'cmd1) + (should (equal (caadr map) 'cmd1)) + (should (equal (caaddr map) 'cmd3)) + (should (equal (caar (last map)) 'cmd2)))) + (ert-deftest keymap-test-duplicate-definitions () "Check that defvar-keymap rejects duplicate key definitions." (should-error commit dcd59457b48f1fb115e9847eef1c983406885717 Author: Robert Pluim Date: Thu Jan 19 15:58:51 2023 +0100 Use `key-parse' in `keymap-lookup' It's stricter than `kbd', and doesn't try to do anything with key sequences that look like macros. * lisp/keymap.el (keymap-lookup): Use `key-parse' instead of `kbd'. * test/src/keymap-tests.el (keymap-set-after-menus): Test the `keymap-set-after' API. diff --git a/lisp/keymap.el b/lisp/keymap.el index 2caaafabb94..89461416a9c 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -405,7 +405,7 @@ keymap-lookup (symbolp value)) (or (command-remapping value) value) value)) - (key-binding (kbd key) accept-default no-remap position))) + (key-binding (key-parse key) accept-default no-remap position))) (defun keymap-local-lookup (keys &optional accept-default) "Return the binding for command KEYS in current local keymap only. diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index b7715a280a6..d7be2cac53a 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -430,6 +430,22 @@ test-non-key-events (make-non-key-event 'keymap-tests-event) (should (equal (where-is-internal 'keymap-tests-command) '([3 103])))) +(ert-deftest keymap-set-consistency () + (let ((k (make-sparse-keymap))) + ;; `keymap-set' returns the binding, `keymap-set-after' doesn't, + ;; so we need to check for nil. + (should (keymap-set k "a" "a")) + (should (equal (keymap-lookup k "a") (key-parse "a"))) + (should-not (keymap-set-after k "b" "b")) + (should (equal (keymap-lookup k "b") (key-parse "b"))) + (should-not (keymap-set-after k "d" "d" t)) + (should (equal (keymap-lookup k "d") (key-parse "d"))) + (should-not (keymap-set-after k "e" "e" nil)) + (should (equal (keymap-lookup k "e") (key-parse "e"))) + ;; This doesn't fail, but it does not add the 'f' binding after 'a' + (should-not (keymap-set-after k "f" "f" "a")) + (should (equal (keymap-lookup k "f") (key-parse "f"))))) + (ert-deftest keymap-test-duplicate-definitions () "Check that defvar-keymap rejects duplicate key definitions." (should-error commit 8904a26a9d227e464ac1c6b054a0e3cf1bfb3016 Author: Robert Pluim Date: Thu Jan 19 15:56:21 2023 +0100 Improve `keymap-set-after' documentation * doc/lispref/keymaps.texi (Changing Key Bindings): Mention `key-valid-p' (Modifying Menus): Correct description of KEY arg. diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 1c548af1990..7876780dcd4 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1378,7 +1378,8 @@ Changing Key Bindings or if @var{key} is not a valid key. @var{key} is a string representing a single key or a series of key -strokes. Key strokes are separated by a single space character. +strokes, and must satisfy @code{key-valid-p}. Key strokes are +separated by a single space character. Each key stroke is either a single character, or the name of an event, surrounded by angle brackets. In addition, any key stroke @@ -1413,6 +1414,7 @@ Changing Key Bindings The modifiers have to be specified in alphabetical order: @samp{A-C-H-M-S-s}, which is @samp{Alt-Control-Hyper-Meta-Shift-super}. +@findex keymap-set @defun keymap-set keymap key binding This function sets the binding for @var{key} in @var{keymap}. (If @var{key} is more than one event long, the change is actually made @@ -3079,13 +3081,13 @@ Modifying Menus @defun keymap-set-after map key binding &optional after Define a binding in @var{map} for @var{key}, with value @var{binding}, just like @code{define-key}, but position the binding in @var{map} after -the binding for the event @var{after}. The argument @var{key} should be -of length one---a vector or string with just one element. But -@var{after} should be a single event type---a symbol or a character, not -a sequence. The new binding goes after the binding for @var{after}. If -@var{after} is @code{t} or is omitted, then the new binding goes last, at -the end of the keymap. However, new bindings are added before any -inherited keymap. +the binding for the event @var{after}. The argument @var{key} should +represent a single menu item or key, and @var{after} should be a +single event type---a symbol or a character, not a sequence. The new +binding goes after the binding for @var{after}. If @var{after} is +@code{t} or is omitted, then the new binding goes last, at the end of +the keymap. However, new bindings are added before any inherited +keymap. Here is an example: commit c7e02eaa3d9af545f2acbb747da7a606fb0d1277 Author: Robert Pluim Date: Thu Jan 19 14:34:10 2023 +0100 Handle after arg correctly in `keymap-set-after' * lisp/keymap.el (keymap-set-after): AFTER: t means the same as nil, so just change it to nil. (Bug#60867) diff --git a/lisp/keymap.el b/lisp/keymap.el index 315eaab7560..2caaafabb94 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -186,6 +186,7 @@ keymap-set-after (declare (indent defun) (compiler-macro (lambda (form) (keymap--compile-check key) form))) (keymap--check key) + (when (eq after t) (setq after nil)) ; nil and t are treated the same (when after (keymap--check after)) (define-key-after keymap (key-parse key) definition commit 628b624176357117f6ff89980a81eff0920cde37 Author: F. Jason Park Date: Thu Jan 19 20:19:40 2023 -0800 Don't load erc-goodies atop erc.el * lisp/erc/erc.el: Commit c2d657e7c4fd9685591f2120007eabf78745919d "Move ERC's core dependencies to a separate file" ironed out ERC's interwoven dependencies for the better but didn't cleanly sidestep the goodies interdependency, specifically with regard to custom options. This reverts the tiny portion impacting this aspect by once again requiring `erc-goodies' at the very end of ERC's main library. Special thanks to Libera.Chat user jrm for reporting this bug. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7f51b7bfb2e..ff1820cfaf2 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -61,7 +61,6 @@ (load "erc-loaddefs" 'noerror 'nomessage) (require 'erc-networks) -(require 'erc-goodies) (require 'erc-backend) (require 'cl-lib) (require 'format-spec) @@ -7386,4 +7385,6 @@ erc-handle-irc-url (provide 'erc) +;; FIXME this is a temporary stopgap for Emacs 29. +(require 'erc-goodies) ;;; erc.el ends here commit 1fdd720b6b8e1858e9ab92b2f63cc473402e54d1 Author: Michael Albinus Date: Fri Jan 20 12:27:07 2023 +0100 ; * etc/NEWS: Fix typos. diff --git a/etc/NEWS b/etc/NEWS index 8df540f6d8d..f111d401df8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -53,7 +53,7 @@ trash when deleting. Default is nil. * Editing Changes in Emacs 30.1 -** New command 'kill-matching-buffers-no-ask' +** New command 'kill-matching-buffers-no-ask'. Kills buffers whose name matches a regexp without asking for confirmation. @@ -63,11 +63,11 @@ Emacs now can set this variable to customize the behavior of the ** New function 'transpose-sexps-default-function'. The previous implementation is moved into its own function, to be -bound by transpose-sexps-function'. +bound by '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 +Tree-sitter now unconditionally sets 'transpose-sexps-function' for all +tree-sitter enabled modes. This functionality utilizes the new 'transpose-sexps-function'. ** Commands and variables to move by program statements @@ -80,20 +80,20 @@ Major modes can now set this variable to customize the behavior of the The previous implementation of 'forward-sentence' is moved into its own function, to be bound by 'forward-sentence-function'. -*** New defvar-local 'treesit-sentence-type-regexp. +*** New buffer-local variable 'treesit-sentence-type-regexp'. Similarly to 'treesit-defun-type-regexp', this variable is used to -define "sentences" in Tree-sitter enabled modes. +define "sentences" in tree-sitter enabled modes. *** New function 'treesit-forward-sentence'. -All tree-sitter modes that define 'treesit-sentence-type-regexp' now -set 'forward-sentence-function' to call 'treesit-forward-sentence'. +All tree-sitter enabled modes that define 'treesit-sentence-type-regexp' +now set 'forward-sentence-function' to call 'treesit-forward-sentence'. -*** New defvar-local 'treesit-sexp-type-regexp'. +*** New buffer-local variable 'treesit-sexp-type-regexp'. Similarly to 'treesit-defun-type-regexp', this variable is used to -define "sexps" in Tree-sitter enabled modes. +define "sexps" in tree-sitter enabled modes. *** New function 'treesit-forward-sexp'. -treesit.el conditionally sets 'forward-sexp-function` for major modes +Tree-sitter conditionally sets 'forward-sexp-function' for major modes that have defined 'treesit-sexp-type-regexp' to enable sexp-related motion commands. @@ -142,10 +142,10 @@ manual. --- *** Eshell now uses 'field' properties in its output. -In particular, this means that pressing the key moves the point -to the beginning of your input, not the beginning of the whole line. -If you want to go back to the old behavior, add something like this to -your configuration: +In particular, this means that pressing the '' key moves the +point to the beginning of your input, not the beginning of the whole +line. If you want to go back to the old behavior, add something like +this to your configuration: (keymap-set eshell-mode-map "" #'eshell-bol-ignoring-prompt) @@ -167,14 +167,14 @@ point is not in a comment or a string. It is by default bound to +++ *** New connection method "toolbox". -This allow accessing system containers provided by Toolbox. +This allows accessing system containers provided by Toolbox. ** EWW +++ *** 'eww-open-file' can now display the file in a new buffer. -By default, the command reuses the '*eww*' buffer, but if called with -the new argument non-nil, it will use a new buffer instead. +By default, the command reuses the "*eww*" buffer, but if called with +the new argument NEW-BUFFER non-nil, it will use a new buffer instead. Interactively, invoke 'eww-open-file' with a prefix argument to activate this behavior. commit 40cf494b7ce8e2ad457d0e6841496239b756f313 Author: Michael Albinus Date: Fri Jan 20 12:20:08 2023 +0100 ; * etc/NEWS: Fix typos. diff --git a/etc/NEWS b/etc/NEWS index fa0e7a1f661..64c26f93c50 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3191,7 +3191,7 @@ files. You can also customize 'major-mode-remap-alist' to automatically turn on some tree-sitter based modes for the same files for which a "built-in" mode would be turned on. For example: - (add-to-list 'major-mode-remap-alist '(ruby-mode . ruby-ts-mode)) + (add-to-list 'major-mode-remap-alist '(ruby-mode . ruby-ts-mode)) If you try these modes and don't like them, you can go back to the "built-in" modes by restarting Emacs. But please tell us why you @@ -3280,7 +3280,6 @@ Dockerfiles. *** New major mode 'cmake-ts-mode'. A major mode based on the tree-sitter library for editing CMake files. - +++ *** New major mode 'toml-ts-mode'. An optional major mode based on the tree-sitter library for editing commit 83afcf285b1044f79257d52215660d334ee336b8 Merge: 0f9cf31ccdd 4fb7b0b0b88 Author: Stefan Kangas Date: Fri Jan 20 11:30:22 2023 +0100 ; Merge from origin/emacs-29 The following commit was skipped: 4fb7b0b0b88 Fix an oversight in advice.el commit 0f9cf31ccddc6059f4c58c117ec99af02ed44447 Merge: ede5e82418a 78b83a744fa Author: Stefan Kangas Date: Fri Jan 20 11:30:22 2023 +0100 Merge from origin/emacs-29 78b83a744fa ; * etc/NEWS: Rearrange instructions for building tree-si... fb82d4e3286 (treesit-simple-indent-presets): Have n-p-gp check for gr... 25ddb3f7d99 ; ruby-ts--indent-rules: Minor cleanup a0ce569d3b7 ruby-toggle-block: Fix in ruby-ts-mode 0d3b6518e39 (ruby-ts--indent-rules): Indent inside empty parens properly 7fb69ce233b ; * doc/emacs/modes.texi (Choosing Modes): Add index entr... # Conflicts: # etc/NEWS commit ede5e82418a0b8cfce2bf96b2a3255ca86b65000 Merge: e9ceeee1198 12d7670b90f Author: Stefan Kangas Date: Fri Jan 20 11:30:22 2023 +0100 ; Merge from origin/emacs-29 The following commit was skipped: 12d7670b90f Fix bug in 'sieve-manage--append-to-log' commit e9ceeee1198aa10cac3cd61ff9537b64640455c2 Merge: 117f90865ad 21be03cccb6 Author: Stefan Kangas Date: Fri Jan 20 11:30:22 2023 +0100 Merge from origin/emacs-29 21be03cccb6 CC Mode: Prevent two classes of "type" prematurely enteri... commit 117f90865adca03eab84778db0370ddc05ba8ae7 Author: Andrea Corallo Date: Wed Jan 18 15:15:51 2023 +0100 Add new command `kill-matching-buffers-no-ask' (bug#60714) * lisp/files.el (kill-matching-buffers-no-ask): New function. * etc/NEWS: Announce `kill-matching-buffers-no-ask'. diff --git a/etc/NEWS b/etc/NEWS index fc8a3ac66a0..8df540f6d8d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -53,6 +53,10 @@ trash when deleting. Default is nil. * Editing Changes in Emacs 30.1 +** New command 'kill-matching-buffers-no-ask' +Kills buffers whose name matches a regexp without asking for +confirmation. + ** New helper variable 'transpose-sexps-function'. Emacs now can set this variable to customize the behavior of the 'transpose-sexps' function. diff --git a/lisp/files.el b/lisp/files.el index 29ba523fa69..d308e99804d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7112,6 +7112,15 @@ kill-matching-buffers (string-match regexp name)) (funcall (if no-ask 'kill-buffer 'kill-buffer-ask) buffer))))) +(defun kill-matching-buffers-no-ask (regexp &optional internal-too) + "Kill buffers whose name matches the specified REGEXP. +Ignores buffers whose name starts with a space, unless optional +prefix argument INTERNAL-TOO is non-nil. Equivalent to +`kill-matching-buffers' but never ask before killing each +buffer." + (interactive "sKill buffers matching this regular expression: \nP") + (kill-matching-buffers regexp internal-too t)) + (defun rename-auto-save-file () "Adjust current buffer's auto save file name for current conditions. commit 6b2f85caa6cae1178b8abee531b0b9b0cf618a00 Author: Eli Zaretskii Date: Fri Jan 20 10:28:26 2023 +0200 Make tree-sitter based modes optional * lisp/progmodes/c-ts-mode.el: Update Commentary. Make 'auto-mode-alist' update conditional on the tree-sitter and grammar libraries being available. * lisp/progmodes/cmake-ts-mode.el: * lisp/progmodes/csharp-mode.el: * lisp/progmodes/dockerfile-ts-mode.el: * lisp/progmodes/go-ts-mode.el: * lisp/progmodes/java-ts-mode.el: * lisp/progmodes/js.el: * lisp/progmodes/json-ts-mode.el: * lisp/progmodes/python.el: * lisp/progmodes/ruby-ts-mode.el: * lisp/progmodes/typescript-ts-mode.el: * lisp/textmodes/css-mode.el: * lisp/textmodes/toml-ts-mode.el: * lisp/textmodes/yaml-ts-mode.el: Make 'auto-mode-alist' update for tree-sitter based modes be conditional on the tree-sitter and grammar libraries being available. (Bug#60559) diff --git a/etc/NEWS b/etc/NEWS index 38f2db26a1a..fa0e7a1f661 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -34,13 +34,14 @@ This feature existed in Emacs 28.1, but was less easy to request. +++ ** Emacs can be built with the tree-sitter parsing library. -This library, together with grammar libraries, provides incremental -parsing capabilities for several popular programming languages and -other formatted files. Emacs built with this library offers major -modes, described elsewhere in this file, that are based on the -tree-sitter's parsers. If you have the tree-sitter library -installed, the configure script will automatically include it in the -build; use '--without-tree-sitter' at configure time to disable that. +This library, together with separate grammar libraries for each +language, provides incremental parsing capabilities for several +popular programming languages and other formatted files. Emacs built +with this library offers major modes, described elsewhere in this +file, that are based on the tree-sitter's parsers. If you have the +tree-sitter library installed, the configure script will automatically +include it in the build; use '--without-tree-sitter' at configure time +to disable that. Emacs modes based on the tree-sitter library require an additional grammar library for each mode. These grammar libraries provide the @@ -3183,19 +3184,19 @@ indentation, and navigation by defuns based on parsing the buffer text by a tree-sitter parser. Some major modes also offer support for Imenu and 'which-func'. -Where major modes already exist in Emacs for editing certain kinds of -files, the new modes based on tree-sitter are for now entirely -optional, and you must turn them on manually, or customize -'auto-mode-alist' to turn them on automatically. +The new modes based on tree-sitter are for now entirely optional, and +you must turn them on manually, or load them in your init file, or +customize 'auto-mode-alist' to turn them on automatically for certain +files. You can also customize 'major-mode-remap-alist' to +automatically turn on some tree-sitter based modes for the same files +for which a "built-in" mode would be turned on. For example: -Where no major modes previously existed in Emacs for editing the kinds -of files for which Emacs now provides a tree-sitter based mode, Emacs -will now try to enable these new modes automatically when you visit -such files, and will display a warning if the tree-sitter library or -the parser grammar library is not available. To prevent the warnings, -either build Emacs with tree-sitter and install the grammar libraries, -or customize 'auto-mode-alist' to specify some other major mode (or -even 'fundamental-mode') for those kinds of files. + (add-to-list 'major-mode-remap-alist '(ruby-mode . ruby-ts-mode)) + +If you try these modes and don't like them, you can go back to the +"built-in" modes by restarting Emacs. But please tell us why you +didn't like the tree-sitter based modes, so that we could try +improving them. Each major mode based on tree-sitter needs a language grammar library, usually named "libtree-sitter-LANG.so" ("libtree-sitter-LANG.dll" on @@ -3212,20 +3213,18 @@ We recommend to install these libraries in one of the standard system locations (the last place in the above list). If a language grammar library required by a mode is not found in any -of the above places, the mode will signal an error when you try to +of the above places, the mode will display a warning when you try to turn it on. +++ *** New major mode 'typescript-ts-mode'. A major mode based on the tree-sitter library for editing programs -in the TypeScript language. This mode is auto-enabled for files with -the ".ts" extension. +in the TypeScript language. +++ *** New major mode 'tsx-ts-mode'. A major mode based on the tree-sitter library for editing programs -in the TypeScript language, with support for TSX. This mode is -auto-enabled for files with the ".tsx" extension. +in the TypeScript language, with support for TSX. +++ *** New major mode 'c-ts-mode'. @@ -3275,15 +3274,12 @@ Bash shell scripts. +++ *** New major mode 'dockerfile-ts-mode'. A major mode based on the tree-sitter library for editing -Dockerfiles. This mode is auto-enabled for files which are named -"Dockerfile", have the "Dockerfile." prefix, or have the ".dockerfile" -extension. +Dockerfiles. +++ *** New major mode 'cmake-ts-mode'. A major mode based on the tree-sitter library for editing CMake files. -It is auto-enabled for files whose name is "CMakeLists.txt" or whose -extension is ".cmake". + +++ *** New major mode 'toml-ts-mode'. @@ -3293,23 +3289,22 @@ files written in TOML, a format for writing configuration files. +++ *** New major mode 'go-ts-mode'. A major mode based on the tree-sitter library for editing programs in -the Go language. It is auto-enabled for files with the ".go" extension. +the Go language. +++ *** New major mode 'go-mod-ts-mode'. A major mode based on the tree-sitter library for editing "go.mod" -files. It is auto-enabled for files which are named "go.mod". +files. +++ *** New major mode 'yaml-ts-mode'. A major mode based on the tree-sitter library for editing files -written in YAML. It is auto-enabled for files with the ".yaml" or -".yml" extensions. +written in YAML. +++ *** New major mode 'rust-ts-mode'. A major mode based on the tree-sitter library for editing programs in -the Rust language. It is auto-enabled for files with the ".rs" extension. +the Rust language. --- *** New major mode 'ruby-ts-mode'. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 3d887971f64..5749e568185 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -32,13 +32,37 @@ ;; `c-or-c++-ts-mode' which automatically chooses the right mode for ;; C/C++ header files. ;; -;; To use these more by default, evaluate +;; To use these modes by default, assuming you have the respective +;; tree-sitter grammars available, do one of the following: ;; -;; (add-to-list 'major-mode-remap-alist '(c-mode . c-ts-mode)) -;; (add-to-list 'major-mode-remap-alist '(c++-mode . c++-ts-mode)) -;; (add-to-list 'major-mode-remap-alist '(c-or-c++-mode . c-or-c++-ts-mode)) +;; - If you have both C and C++ grammars installed, add ;; -;; in your configuration. +;; (require 'c-ts-mode) +;; +;; to your init file. +;; +;; - Add one or mode of the following to your init file: +;; +;; (add-to-list 'major-mode-remap-alist '(c-mode . c-ts-mode)) +;; (add-to-list 'major-mode-remap-alist '(c++-mode . c++-ts-mode)) +;; (add-to-list 'major-mode-remap-alist '(c-or-c++-mode . c-or-c++-ts-mode)) +;; +;; If you have only C grammar available, use only the first one; if +;; you have only the C++ grammar, use only the second one. +;; +;; - Customize 'auto-mode-alist' to turn one or more of the modes +;; automatically. For example: +;; +;; (add-to-list 'auto-mode-alist +;; '("\\(\\.ii\\|\\.\\(CC?\\|HH?\\)\\|\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\|\\.\\(cc\\|hh\\)\\)\\'" +;; . c++-ts-mode)) +;; +;; will turn on the c++-ts-mode for C++ source files. +;; +;; You can also turn on these modes manually in a buffer. Doing so +;; will set up Emacs to use the C/C++ modes defined here for other +;; files, provided that you have the corresponding parser grammar +;; libraries installed. ;; ;; For C-like language major modes: ;; @@ -1072,6 +1096,22 @@ c-or-c++-ts-mode (re-search-forward c-ts-mode--c-or-c++-regexp nil t)))) (c++-ts-mode) (c-ts-mode))) +;; The entries for C++ must come first to prevent *.c files be taken +;; as C++ on case-insensitive filesystems, since *.C files are C++, +;; not C. +(if (treesit-ready-p 'cpp) + (add-to-list 'auto-mode-alist + '("\\(\\.ii\\|\\.\\(CC?\\|HH?\\)\\|\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\|\\.\\(cc\\|hh\\)\\)\\'" + . c++-ts-mode))) + +(if (treesit-ready-p 'c) + (add-to-list 'auto-mode-alist + '("\\(\\.[chi]\\|\\.lex\\|\\.y\\(acc\\)?\\|\\.x[bp]m\\)\\'" + . c-ts-mode))) + +(if (and (treesit-ready-p 'cpp) + (treesit-ready-p 'c)) + (add-to-list 'auto-mode-alist '("\\.h\\'" . c-or-c++-ts-mode))) (provide 'c-ts-mode) diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index a31250f68be..c241a2868e5 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -194,10 +194,6 @@ cmake-ts-mode--imenu-1 (t `((,name . ,marker)))))) -;;;###autoload -(add-to-list 'auto-mode-alist - '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode)) - ;;;###autoload (define-derived-mode cmake-ts-mode prog-mode "CMake" "Major mode for editing CMake files, powered by tree-sitter." @@ -229,6 +225,10 @@ cmake-ts-mode (treesit-major-mode-setup))) +(if (treesit-ready-p 'cmake) + (add-to-list 'auto-mode-alist + '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode))) + (provide 'cmake-ts-mode) ;;; cmake-ts-mode.el ends here diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 81ce41618e7..04f7f222362 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -883,9 +883,6 @@ csharp-ts-mode--defun-name node "name") t)))) -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) - ;;;###autoload (define-derived-mode csharp-mode prog-mode "C#" "Major mode for editing Csharp code. @@ -941,7 +938,9 @@ csharp-ts-mode ("Struct" "\\`struct_declaration\\'" nil nil) ("Method" "\\`method_declaration\\'" nil nil))) - (treesit-major-mode-setup)) + (treesit-major-mode-setup) + + (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-ts-mode))) (provide 'csharp-mode) diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el index 3f8766e6713..2a295e885b0 100644 --- a/lisp/progmodes/dockerfile-ts-mode.el +++ b/lisp/progmodes/dockerfile-ts-mode.el @@ -132,12 +132,6 @@ dockerfile-ts-mode--imenu-1 (t `((,name . ,marker)))))) -;;;###autoload -(add-to-list 'auto-mode-alist - ;; NOTE: We can't use `rx' here, as it breaks bootstrap. - '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" - . dockerfile-ts-mode)) - ;;;###autoload (define-derived-mode dockerfile-ts-mode prog-mode "Dockerfile" "Major mode for editing Dockerfiles, powered by tree-sitter." @@ -172,6 +166,12 @@ dockerfile-ts-mode (treesit-major-mode-setup))) +(if (treesit-ready-p 'dockerfile) + (add-to-list 'auto-mode-alist + ;; NOTE: We can't use `rx' here, as it breaks bootstrap. + '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" + . dockerfile-ts-mode))) + (provide 'dockerfile-ts-mode) ;;; dockerfile-ts-mode.el ends here diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 64e761d2f72..d552e1360e0 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -174,9 +174,6 @@ go-ts-mode--font-lock-settings '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `go-ts-mode'.") -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode)) - ;;;###autoload (define-derived-mode go-ts-mode prog-mode "Go" "Major mode for editing Go, powered by tree-sitter." @@ -226,6 +223,9 @@ go-ts-mode (treesit-major-mode-setup))) +(if (treesit-ready-p 'go) + (add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode))) + (defun go-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." @@ -345,9 +345,6 @@ go-mod-ts-mode--font-lock-settings '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `go-mod-ts-mode'.") -;;;###autoload -(add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode)) - ;;;###autoload (define-derived-mode go-mod-ts-mode prog-mode "Go Mod" "Major mode for editing go.mod files, powered by tree-sitter." @@ -376,6 +373,9 @@ go-mod-ts-mode (treesit-major-mode-setup))) +(if (treesit-ready-p 'gomod) + (add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode))) + (provide 'go-ts-mode) ;;; go-ts-mode.el ends here diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index d29fcd80861..d909a366e5d 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -331,6 +331,9 @@ java-ts-mode ("Method" "\\`method_declaration\\'" nil nil))) (treesit-major-mode-setup)) +(if (treesit-ready-p 'java) + (add-to-list 'auto-mode-alist '("\\.java\\'" . java-ts-mode))) + (provide 'java-ts-mode) ;;; java-ts-mode.el ends here diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index cc556c4d0ec..176024863f1 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3843,7 +3843,10 @@ js-ts-mode "method_definition") eos) nil nil))) - (treesit-major-mode-setup))) + (treesit-major-mode-setup) + + (add-to-list 'auto-mode-alist + '("\\(\\.js[mx]\\|\\.har\\)\\'" . js-ts-mode)))) ;;;###autoload (define-derived-mode js-json-mode js-mode "JSON" diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index fbcda22acca..f54d0187f98 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -160,6 +160,10 @@ json-ts-mode (treesit-major-mode-setup)) +(if (treesit-ready-p 'json) + (add-to-list 'auto-mode-alist + '("\\.json\\'" . json-ts-mode))) + (provide 'json-ts-mode) ;;; json-ts-mode.el ends here diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 21d16db287c..a869cdc5fdb 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -6713,7 +6713,10 @@ python-ts-mode (treesit-major-mode-setup) (when python-indent-guess-indent-offset - (python-indent-guess-indent-offset)))) + (python-indent-guess-indent-offset)) + + (add-to-list 'auto-mode-alist + '("\\.py[iw]?\\'\\|python[0-9.]*" . python-ts-mode)))) ;;; Completion predicates for M-x ;; Commands that only make sense when editing Python code diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 45174811605..d143c06a8a4 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1047,6 +1047,20 @@ ruby-ts-mode (treesit-major-mode-setup)) +(if (treesit-ready-p 'ruby) + ;; Copied from ruby-mode.el. + (add-to-list 'auto-mode-alist + (cons (concat "\\(?:\\.\\(?:" + "rbw?\\|ru\\|rake\\|thor" + "\\|jbuilder\\|rabl\\|gemspec\\|podspec" + "\\)" + "\\|/" + "\\(?:Gem\\|Rake\\|Cap\\|Thor" + "\\|Puppet\\|Berks\\|Brew" + "\\|Vagrant\\|Guard\\|Pod\\)file" + "\\)\\'") + 'ruby-ts-mode))) + (provide 'ruby-ts-mode) ;;; ruby-ts-mode.el ends here diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 7536726165e..08590ae6a86 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -275,9 +275,6 @@ rust-ts-mode--defun-name (treesit-node-text (treesit-node-child-by-field-name node "name") t)))) -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode)) - ;;;###autoload (define-derived-mode rust-ts-mode prog-mode "Rust" "Major mode for editing Rust, powered by tree-sitter." @@ -322,6 +319,9 @@ rust-ts-mode (treesit-major-mode-setup))) +(if (treesit-ready-p 'rust) + (add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode))) + (provide 'rust-ts-mode) ;;; rust-ts-mode.el ends here diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index ffd5b941daf..6aaa852895c 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -314,12 +314,6 @@ typescript-ts-mode--font-lock-settings :override t '((escape_sequence) @font-lock-escape-face))) -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode)) - -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.tsx\\'" . tsx-ts-mode)) - ;;;###autoload (define-derived-mode typescript-ts-base-mode prog-mode "TypeScript" "Major mode for editing TypeScript." @@ -375,6 +369,9 @@ typescript-ts-mode (treesit-major-mode-setup))) +(if (treesit-ready-p 'typescript) + (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode))) + ;;;###autoload (define-derived-mode tsx-ts-mode typescript-ts-base-mode "TypeScript[TSX]" "Major mode for editing TypeScript." @@ -410,6 +407,9 @@ tsx-ts-mode (treesit-major-mode-setup))) +(if (treesit-ready-p 'tsx) + (add-to-list 'auto-mode-alist '("\\.tsx\\'" . tsx-ts-mode))) + (provide 'typescript-ts-mode) ;;; typescript-ts-mode.el ends here diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 8991610a50f..a1d7d4bbbec 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1827,7 +1827,9 @@ css-ts-mode (setq-local treesit-simple-imenu-settings `(( nil ,(rx bos (or "rule_set" "media_statement") eos) nil nil))) - (treesit-major-mode-setup))) + (treesit-major-mode-setup) + + (add-to-list 'auto-mode-alist '("\\.css\\'" . css-ts-mode)))) ;;;###autoload (define-derived-mode css-mode css-base-mode "CSS" diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el index 2430c5f3e76..416542084f1 100644 --- a/lisp/textmodes/toml-ts-mode.el +++ b/lisp/textmodes/toml-ts-mode.el @@ -117,8 +117,6 @@ toml-ts-mode--defun-name (or (treesit-node-text (treesit-node-child node 1) t) "Root table")))) -(add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode)) - ;;;###autoload (define-derived-mode toml-ts-mode text-mode "TOML" "Major mode for editing TOML, powered by tree-sitter." @@ -155,6 +153,9 @@ toml-ts-mode (treesit-major-mode-setup))) +(if (treesit-ready-p 'toml) + (add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode))) + (provide 'toml-ts-mode) ;;; toml-ts-mode.el ends here diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index 8c61ee062cf..a25230e6e61 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -117,9 +117,6 @@ yaml-ts-mode--font-lock-settings '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `yaml-ts-mode'.") -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode)) - ;;;###autoload (define-derived-mode yaml-ts-mode text-mode "YAML" "Major mode for editing YAML, powered by tree-sitter." @@ -146,6 +143,9 @@ yaml-ts-mode (treesit-major-mode-setup))) +(if (treesit-ready-p 'yaml) + (add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode))) + (provide 'yaml-ts-mode) ;;; yaml-ts-mode.el ends here commit b56cf28b325c927d5e51173b00f5e5354ba62def Author: Dmitry Gutov Date: Fri Jan 20 05:41:39 2023 +0200 ; (ruby-ts--predefined-variables): Make it a little shorter diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 2105aaaecab..45174811605 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -131,7 +131,7 @@ ruby-ts--predefined-variables "$." "$<" "$>" "$_" "$*" "$$" "$?" "$:" "$LOAD_PATH" "$LOADED_FEATURES" "$DEBUG" "$FILENAME" "$stderr" "$stdin" "$stdout" "$VERBOSE" "$-a" "$-i" "$-l" "$-p" - (seq "$" (+ digit))) + "$0" "$1" "$2" "$3" "$4" "$5" "$6" "$7" "$8" "$9") string-end) "Ruby predefined global variables.") commit d94dc606a0934e52f86bd939684867ada4b944fe Author: Dmitry Gutov Date: Fri Jan 20 05:35:12 2023 +0200 ruby-ts-mode: Claw back half of the performance drop from last change * lisp/progmodes/ruby-ts-mode.el (ruby-ts--builtin-method-p): New function. (ruby-ts--font-lock-settings): Use it instead of :match. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 58da5ef9c69..2105aaaecab 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -208,6 +208,9 @@ ruby-ts--comment-font-lock (treesit-fontify-with-override (max plus-1 start) (min node-end end) font-lock-comment-face override))) +(defun ruby-ts--builtin-method-p (node) + (string-match-p ruby-ts--builtin-methods (treesit-node-text node t))) + (defun ruby-ts--font-lock-settings (language) "Tree-sitter font-lock settings for Ruby." (treesit-font-lock-rules @@ -336,8 +339,7 @@ ruby-ts--font-lock-settings :language language :feature 'builtin-function `((((identifier) @font-lock-builtin-face) - (:match ,ruby-ts--builtin-methods - @font-lock-builtin-face))) + (:pred ruby-ts--builtin-method-p @font-lock-builtin-face))) ;; Yuan recommends also putting method definitions into the ;; 'function' category (thus keeping it in both). I've opted to commit 167bf3408e437704b27171c6fad5d15bbc623b3a Author: Paul Eggert Date: Thu Jan 19 15:15:52 2023 -0800 Pacify clang 15.0.6 on Fedora 37 * configure.ac: Suppress clang -Wbitwise-instead-of-logical, as there’s nothing wrong with using & and | on bool. * src/coding.c: Suppress -Wunused-but-set-variable in this file, as it’s too much trouble to recode to pacify clang. diff --git a/configure.ac b/configure.ac index d7aec4414e3..fc17dbd8318 100644 --- a/configure.ac +++ b/configure.ac @@ -1139,6 +1139,7 @@ AC_DEFUN # clang is unduly picky about some things. if test "$emacs_cv_clang" = yes; then + gl_WARN_ADD([-Wno-bitwise-instead-of-logical]) gl_WARN_ADD([-Wno-missing-braces]) gl_WARN_ADD([-Wno-null-pointer-arithmetic]) gl_WARN_ADD([-Wno-implicit-const-int-float-conversion]) diff --git a/src/coding.c b/src/coding.c index 49dcd8634f3..79461addd1a 100644 --- a/src/coding.c +++ b/src/coding.c @@ -651,6 +651,12 @@ #define ONE_MORE_BYTE(c) \ consumed_chars++; \ } while (0) +/* Suppress clang warnings about consumed_chars never being used. + Although correct, the warnings are too much trouble to code around. */ +#if 13 <= __clang_major__ +# pragma clang diagnostic ignored "-Wunused-but-set-variable" +#endif + /* Safely get two bytes from the source text pointed by SRC which ends at SRC_END, and set C1 and C2 to those bytes while skipping the heading multibyte characters. If there are not enough bytes in the commit d0d34514097c03d787012478d5217449481cfc04 Author: Dmitry Gutov Date: Fri Jan 20 04:14:38 2023 +0200 (ruby-ts-mode): Rename 'builtin-functions' to 'builtin-function' * lisp/progmodes/ruby-ts-mode.el (ruby-ts--font-lock-settings) (ruby-ts-mode): Rename 'builtin-functions' to 'builtin-function', for consistency with similar features. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index f365ca7f8c2..58da5ef9c69 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -334,7 +334,7 @@ ruby-ts--font-lock-settings pattern: (identifier) @font-lock-variable-name-face)) :language language - :feature 'builtin-functions + :feature 'builtin-function `((((identifier) @font-lock-builtin-face) (:match ,ruby-ts--builtin-methods @font-lock-builtin-face))) @@ -1037,7 +1037,7 @@ ruby-ts-mode (setq-local treesit-font-lock-feature-list '(( comment method-definition parameter-definition) ( keyword regexp string type) - ( builtin-variable builtin-constant builtin-functions + ( builtin-variable builtin-constant builtin-function delimiter escape-sequence constant global instance interpolation literal symbol assignment) commit d66ac5285f72e0343d1cc6aae2db70a00b35feed Author: Dmitry Gutov Date: Fri Jan 20 03:56:44 2023 +0200 ruby-ts-mode: Highlight builtin methods * lisp/progmodes/ruby-mode.el (ruby-builtin-methods-with-reqs) (ruby-builtin-methods-no-reqs): New constants, extracted. (ruby-font-lock-keywords): Replace values with references. * lisp/progmodes/ruby-ts-mode.el (ruby-ts--builtin-methods): New variable. Construct regexp from aforementioned constants' values. * lisp/progmodes/ruby-ts-mode.el (ruby-ts--font-lock-settings): Use it. * lisp/progmodes/ruby-ts-mode.el (ruby-ts-mode): Add new font-lock feature: builtin-functions. * lisp/progmodes/ruby-ts-mode.el (ruby-ts--predefined-constants) (ruby-ts--predefined-variables): Unrelated to the rest of the patch, add string-start and string-end anchors. diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 2de7395f765..6e524693e37 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -141,6 +141,81 @@ ruby-endless-method-head-re It should match the part after \"def\" and until \"=\".") +(defconst ruby-builtin-methods-with-reqs + '( ;; built-in methods on Kernel + "at_exit" + "autoload" + "autoload?" + "callcc" + "catch" + "eval" + "exec" + "format" + "lambda" + "load" + "loop" + "open" + "p" + "printf" + "proc" + "putc" + "require" + "require_relative" + "spawn" + "sprintf" + "syscall" + "system" + "throw" + "trace_var" + "trap" + "untrace_var" + "warn" + ;; keyword-like private methods on Module + "alias_method" + "attr" + "attr_accessor" + "attr_reader" + "attr_writer" + "define_method" + "extend" + "include" + "module_function" + "prepend" + "private_class_method" + "private_constant" + "public_class_method" + "public_constant" + "refine" + "using") + "List of built-in methods that require at least one argument.") + +(defconst ruby-builtin-methods-no-reqs + '("__callee__" + "__dir__" + "__method__" + "abort" + "binding" + "block_given?" + "caller" + "exit" + "exit!" + "fail" + "fork" + "global_variables" + "local_variables" + "print" + "private" + "protected" + "public" + "puts" + "raise" + "rand" + "readline" + "readlines" + "sleep" + "srand") + "List of built-in methods that only have optional arguments.") + (defvar ruby-use-smie t) (make-obsolete-variable 'ruby-use-smie nil "28.1") @@ -2292,84 +2367,13 @@ ruby-font-lock-keywords ;; Core methods that have required arguments. (,(concat ruby-font-lock-keyword-beg-re - (regexp-opt - '( ;; built-in methods on Kernel - "at_exit" - "autoload" - "autoload?" - "callcc" - "catch" - "eval" - "exec" - "format" - "lambda" - "load" - "loop" - "open" - "p" - "printf" - "proc" - "putc" - "require" - "require_relative" - "spawn" - "sprintf" - "syscall" - "system" - "throw" - "trace_var" - "trap" - "untrace_var" - "warn" - ;; keyword-like private methods on Module - "alias_method" - "attr" - "attr_accessor" - "attr_reader" - "attr_writer" - "define_method" - "extend" - "include" - "module_function" - "prepend" - "private_class_method" - "private_constant" - "public_class_method" - "public_constant" - "refine" - "using") - 'symbols)) + (regexp-opt ruby-builtin-methods-with-reqs 'symbols)) (1 (unless (looking-at " *\\(?:[]|,.)}=]\\|$\\)") font-lock-builtin-face))) ;; Kernel methods that have no required arguments. (,(concat ruby-font-lock-keyword-beg-re - (regexp-opt - '("__callee__" - "__dir__" - "__method__" - "abort" - "binding" - "block_given?" - "caller" - "exit" - "exit!" - "fail" - "fork" - "global_variables" - "local_variables" - "print" - "private" - "protected" - "public" - "puts" - "raise" - "rand" - "readline" - "readlines" - "sleep" - "srand") - 'symbols)) + (regexp-opt ruby-builtin-methods-no-reqs 'symbols)) (1 font-lock-builtin-face)) ;; Here-doc beginnings. (,ruby-here-doc-beg-re diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index da2d00ce168..f365ca7f8c2 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -116,21 +116,30 @@ ruby-ts--delimiters "Ruby's punctuation characters.") (defvar ruby-ts--predefined-constants - (rx (or "ARGF" "ARGV" "DATA" "ENV" "RUBY_COPYRIGHT" + (rx string-start + (or "ARGF" "ARGV" "DATA" "ENV" "RUBY_COPYRIGHT" "RUBY_DESCRIPTION" "RUBY_ENGINE" "RUBY_ENGINE_VERSION" "RUBY_PATCHLEVEL" "RUBY_PLATFORM" "RUBY_RELEASE_DATE" "RUBY_REVISION" "RUBY_VERSION" "STDERR" "STDIN" "STDOUT" - "TOPLEVEL_BINDING")) + "TOPLEVEL_BINDING") + string-end) "Ruby predefined global constants.") (defvar ruby-ts--predefined-variables - (rx (or "$!" "$@" "$~" "$&" "$‘" "$‘" "$+" "$=" "$/" "$\\" "$," "$;" + (rx string-start + (or "$!" "$@" "$~" "$&" "$‘" "$‘" "$+" "$=" "$/" "$\\" "$," "$;" "$." "$<" "$>" "$_" "$*" "$$" "$?" "$:" "$LOAD_PATH" "$LOADED_FEATURES" "$DEBUG" "$FILENAME" "$stderr" "$stdin" "$stdout" "$VERBOSE" "$-a" "$-i" "$-l" "$-p" - (seq "$" (+ digit)))) + (seq "$" (+ digit))) + string-end) "Ruby predefined global variables.") +(defvar ruby-ts--builtin-methods + (format "\\`%s\\'" (regexp-opt (append ruby-builtin-methods-no-reqs + ruby-builtin-methods-with-reqs))) + "Ruby built-in methods.") + (defconst ruby-ts--class-or-module-regex (rx string-start (or "class" "module" "singleton_class") @@ -324,6 +333,12 @@ ruby-ts--font-lock-settings (in_clause pattern: (identifier) @font-lock-variable-name-face)) + :language language + :feature 'builtin-functions + `((((identifier) @font-lock-builtin-face) + (:match ,ruby-ts--builtin-methods + @font-lock-builtin-face))) + ;; Yuan recommends also putting method definitions into the ;; 'function' category (thus keeping it in both). I've opted to ;; just use separate categories for them -- dgutov. @@ -1022,9 +1037,9 @@ ruby-ts-mode (setq-local treesit-font-lock-feature-list '(( comment method-definition parameter-definition) ( keyword regexp string type) - ( builtin-variable builtin-constant constant + ( builtin-variable builtin-constant builtin-functions delimiter escape-sequence - global instance + constant global instance interpolation literal symbol assignment) ( bracket error function operator punctuation))) commit 370b1ac99ec4328981ce8502ecb03353dbea5041 Author: Dmitry Gutov Date: Fri Jan 20 03:54:36 2023 +0200 ; ruby-ts-mode.el: Add customize-group mention to commentary diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 71562b46306..da2d00ce168 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -71,6 +71,8 @@ ;; ruby-ts-mode tries to adhere to the indentation related user ;; options from ruby-mode, such as ruby-indent-level, ;; ruby-indent-tabs-mode, and so on. +;; +;; Type 'M-x customize-group RET ruby RET' to see the options. ;; * IMenu ;; * Navigation commit 54d5ea66c99f03240379d6d2e411145cced585a5 Author: Jim Porter Date: Wed Jan 18 19:15:38 2023 -0800 Fix evaluation of asynchronous expansions in Eshell indices Previously, this code passed the indices to a separate function, which called 'eval' on them, but it should instead make an S-expr that 'eshell-do-eval' can evaluate (bug#60942). * lisp/eshell/esh-var.el (eshell-eval-indices): Mark obsolete. (eshell-prepare-indices): New function... (eshell-parse-variable): ... use it. Also, remove irrelevant comment. (eshell-parse-variable-ref): Fix quoting in docstring. (eshell-parse-indices): Fix typo in docstring. * test/lisp/eshell/esh-var-tests.el (esh-var-test/interp-var-indices-subcommand) (esh-var-test/quoted-interp-var-indices-subcommand): New tests. diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 27e68138aa2..83dd5cb50f5 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -467,9 +467,7 @@ eshell-parse-variable indices (and (not (eobp)) (eq (char-after) ?\[) (eshell-parse-indices)) - ;; This is an expression that will be evaluated by `eshell-do-eval', - ;; which only support let-binding of dynamically-scoped vars - value `(let ((indices (eshell-eval-indices ',indices))) ,value)) + value `(let ((indices ,(eshell-prepare-indices indices))) ,value)) (when get-len (setq value `(length ,value))) (when eshell-current-quoted @@ -496,7 +494,7 @@ eshell-parse-variable-ref NAME an environment or Lisp variable value \"LONG-NAME\" disambiguates the length of the name - `LONG-NAME' as above + \\='LONG-NAME\\=' as above {COMMAND} result of command is variable's value (LISP-FORM) result of Lisp form is variable's value write the output of command to a temporary file; @@ -591,7 +589,7 @@ eshell-parse-indices "Parse and return a list of index-lists. For example, \"[0 1][2]\" becomes: - ((\"0\" \"1\") (\"2\")." + ((\"0\" \"1\") (\"2\"))." (let (indices) (while (eq (char-after) ?\[) (let ((end (eshell-find-delimiter ?\[ ?\]))) @@ -609,8 +607,14 @@ eshell-parse-indices (defun eshell-eval-indices (indices) "Evaluate INDICES, a list of index-lists generated by `eshell-parse-indices'." + (declare (obsolete eshell-prepare-indices "30.1")) (mapcar (lambda (i) (mapcar #'eval i)) indices)) +(defun eshell-prepare-indices (indices) + "Prepare INDICES to be evaluated by Eshell. +INDICES is a list of index-lists generated by `eshell-parse-indices'." + `(list ,@(mapcar (lambda (idx-list) (cons 'list idx-list)) indices))) + (defun eshell-get-variable (name &optional indices quoted) "Get the value for the variable NAME. INDICES is a list of index-lists (see `eshell-parse-indices'). diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 0cc1b92266f..82324d72163 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -82,6 +82,17 @@ esh-var-test/interp-var-indices (eshell-command-result-equal "echo $eshell-test-value[0 2 4]" '("zero" "two" "four")))) +(ert-deftest esh-var-test/interp-var-indices-subcommand () + "Interpolate list variable with subcommand expansion for indices" + (skip-unless (executable-find "echo")) + (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) + (eshell-command-result-equal + "echo $eshell-test-value[${*echo 0}]" + "zero") + (eshell-command-result-equal + "echo $eshell-test-value[${*echo 0} ${*echo 2}]" + '("zero" "two")))) + (ert-deftest esh-var-test/interp-var-split-indices () "Interpolate string variable with indices" (let ((eshell-test-value "zero one two three four")) @@ -271,6 +282,20 @@ esh-var-test/quoted-interp-var-indices (eshell-command-result-equal "echo \"$eshell-test-value[1 2 4]\"" "(\"one\" \"two\" \"four\")"))) +(ert-deftest esh-var-test/quote-interp-var-indices-subcommand () + "Interpolate list variable with subcommand expansion for indices +inside double-quotes" + (skip-unless (executable-find "echo")) + (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) + (eshell-command-result-equal + "echo \"$eshell-test-value[${*echo 0}]\"" + "zero") + ;; FIXME: These tests would use the 0th index like the other tests + ;; here, but see above. + (eshell-command-result-equal + "echo \"$eshell-test-value[${*echo 1} ${*echo 2}]\"" + "(\"one\" \"two\")"))) + (ert-deftest esh-var-test/quoted-interp-var-split-indices () "Interpolate string variable with indices inside double-quotes" (let ((eshell-test-value "zero one two three four")) commit 7b7b2b95138e691f1b155060b91a8998e3905651 Author: Yuan Fu Date: Thu Jan 19 14:46:17 2023 -0800 Fix c-ts-mode indent (bug#60873) * lisp/progmodes/c-ts-mode.el: (c-ts-mode--statement-offset): Handle the edge case. * test/lisp/progmodes/c-ts-mode-resources/indent.erts: Add a test. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 0cf77c21d83..3d887971f64 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -285,7 +285,18 @@ c-ts-mode--statement-offset (cl-incf level) (save-excursion (goto-char (treesit-node-start node)) - (cond ((bolp) nil) + ;; Add an extra level if the opening bracket is on its own + ;; line, except (1) it's at top-level, or (2) it's immedate + ;; parent is another block. + (cond ((bolp) nil) ; Case (1). + ((let ((parent-type (treesit-node-type + (treesit-node-parent node)))) + ;; Case (2). + (and parent-type + (string-match-p c-ts-mode-indent-block-type-regexp + parent-type))) + nil) + ;; Add a level. ((looking-back (rx bol (* whitespace)) (line-beginning-position)) (cl-incf level)))))) diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts b/test/lisp/progmodes/c-ts-mode-resources/indent.erts index 70fce68b0ec..b8524432d02 100644 --- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts +++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts @@ -92,6 +92,19 @@ int main() } =-=-= +Name: Concecutive blocks (GNU Style) (bug#60873) + +=-= +int +main (int argc, + char *argv[]) +{ + { + int i = 0; + } +} +=-=-= + Name: Multiline Parameter List (bug#60398) =-= commit 7ca71d66dc7365a3dd8dd5f20638b4fa612fdc5e Author: Yuan Fu Date: Thu Jan 19 14:22:56 2023 -0800 Fix various problems in treesit-explore-mode (bug#60800) * lisp/treesit.el: (treesit--explorer-kill-explorer-buffer): New function. (treesit-explore-mode): 1. Move prompt for language earlier, and terminate early if language not available. 2. Make sure desktop-save doesn't save the explorer buffer. 3. Kill the explorer buffer when the source buffer is killed. diff --git a/lisp/treesit.el b/lisp/treesit.el index 5a65d565236..660039cc7cc 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -2621,6 +2621,11 @@ treesit--explorer-draw-node (when (not named) (overlay-put ov 'face 'treesit-explorer-anonymous-node))))) +(defun treesit--explorer-kill-explorer-buffer () + "Kill the explorer buffer of this buffer." + (when (buffer-live-p treesit--explorer-buffer) + (kill-buffer treesit--explorer-buffer))) + (define-derived-mode treesit--explorer-tree-mode special-mode "TS Explorer" "Mode for displaying syntax trees for `treesit-explore-mode'." @@ -2632,30 +2637,46 @@ treesit-explore-mode current buffer in real time. The corresponding node enclosing the text in the active region is highlighted in the explorer window." - :lighter " TSplay" + :lighter " TSexplore" (if treesit-explore-mode - (progn - (unless (buffer-live-p treesit--explorer-buffer) - (setq-local treesit--explorer-buffer - (get-buffer-create - (format "*tree-sitter explorer for %s*" - (buffer-name)))) - (setq-local treesit--explorer-language - (intern (completing-read + (let ((language (intern (completing-read "Language: " (mapcar #'treesit-parser-language - (treesit-parser-list))))) - (with-current-buffer treesit--explorer-buffer - (treesit--explorer-tree-mode))) - (display-buffer treesit--explorer-buffer - (cons nil '((inhibit-same-window . t)))) - (treesit--explorer-refresh) - (add-hook 'post-command-hook - #'treesit--explorer-post-command 0 t) - (setq-local treesit--explorer-last-node nil)) + (treesit-parser-list)))))) + (if (not (treesit-language-available-p language)) + (user-error "Cannot find tree-sitter grammar for %s: %s" + language (cdr (treesit-language-available-p + language t))) + ;; Create explorer buffer. + (unless (buffer-live-p treesit--explorer-buffer) + (setq-local treesit--explorer-buffer + (get-buffer-create + (format "*tree-sitter explorer for %s*" + (buffer-name)))) + (setq-local treesit--explorer-language language) + (with-current-buffer treesit--explorer-buffer + (treesit--explorer-tree-mode))) + (display-buffer treesit--explorer-buffer + (cons nil '((inhibit-same-window . t)))) + (treesit--explorer-refresh) + ;; Setup variables and hooks. + (add-hook 'post-command-hook + #'treesit--explorer-post-command 0 t) + (add-hook 'kill-buffer-hook + #'treesit--explorer-kill-explorer-buffer 0 t) + (setq-local treesit--explorer-last-node nil) + ;; Tell `desktop-save' to not save explorer buffers. + (when (boundp 'desktop-modes-not-to-save) + (unless (memq 'treesit--explorer-tree-mode + desktop-modes-not-to-save) + (push 'treesit--explorer-tree-mode + desktop-modes-not-to-save))))) + ;; Turn off explore mode. (remove-hook 'post-command-hook #'treesit--explorer-post-command t) - (kill-buffer treesit--explorer-buffer))) + (remove-hook 'post-command-hook + #'treesit--explorer-kill-explorer-buffer t) + (treesit--explorer-kill-explorer-buffer))) ;;; Install & build language grammar commit b7d6bb47ee5f6a459a873c5053c2dde9df4f2e2f Author: Yuan Fu Date: Thu Jan 19 11:53:14 2023 -0800 ; * lisp/treesit.el (treesit-font-lock-fontify-region): Minor fix. The check for treesit--font-lock-fast-mode is not really necessary, but anyway. diff --git a/lisp/treesit.el b/lisp/treesit.el index 7669ed6d18c..5a65d565236 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -987,7 +987,8 @@ treesit-font-lock-fontify-region (end-time (current-time))) ;; If for any query the query time is strangely long, ;; switch to fast mode (see comments above). - (when (and (> (time-to-seconds + (when (and (null treesit--font-lock-fast-mode) + (> (time-to-seconds (time-subtract end-time start-time)) 0.01)) (if (> treesit--font-lock-fast-mode-grace-count 0) commit 0c6bfeddb21df16a6001328882fe2aaf6b063f68 Author: Yuan Fu Date: Wed Jan 18 15:45:29 2023 -0800 ; Update tree-sitter major mode manual * doc/lispref/parsing.texi (Tree-sitter Major Modes): Update. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index e4a25249829..cebb59b6501 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1692,26 +1692,48 @@ Tree-sitter Major Modes A major mode supporting tree-sitter features should roughly follow this pattern: -@c FIXME: Update this part once we settle on the exact format. @example @group (define-derived-mode woomy-mode prog-mode "Woomy" "A mode for Woomy programming language." - ;; Shared setup. - ... - (cond - ;; Tree-sitter setup. - ((treesit-ready-p 'woomy) + (when (treesit-ready-p 'woomy) (setq-local treesit-variables ...) - (treesit-major-mode-setup)) - ;; Non-tree-sitter setup. - (t - ...))) + ... + (treesit-major-mode-setup))) @end group @end example -First, the major mode should use @code{treesit-ready-p} to determine -whether tree-sitter can be activated in this mode. +@code{treesit-ready-p} automatically emits a warning if conditions for +enabling tree-sitter aren't met. + +If a tree-sitter major mode shares setup with their ``native'' +counterpart, they can create a ``base mode'' that contains the common +setup, like this: + +@example +@group +(define-derived-mode woomy--base-mode prog-mode "Woomy" + "An internal mode for Woomy programming language." + (common-setup) + ...) +@end group + +@group +(define-derived-mode woomy-mode woomy--base-mode "Woomy" + "A mode for Woomy programming language." + (native-setup) + ...) +@end group + +@group +(define-derived-mode woomy-ts-mode woomy--base-mode "Woomy" + "A mode for Woomy programming language." + (when (treesit-ready-p 'woomy) + (setq-local treesit-variables ...) + ... + (treesit-major-mode-setup))) +@end group +@end example @defun treesit-ready-p language &optional quiet This function checks for conditions for activating tree-sitter. It @@ -1722,15 +1744,12 @@ Tree-sitter Major Modes This function emits a warning if tree-sitter cannot be activated. If @var{quiet} is @code{message}, the warning is turned into a message; -if @var{quiet} is @code{nil}, no warning or message is displayed. +if @var{quiet} is @code{t}, no warning or message is displayed. If all the necessary conditions are met, this function returns non-@code{nil}; otherwise it returns @code{nil}. @end defun -Next, the major mode should set up tree-sitter variables and call -@code{treesit-major-mode-setup}. - @defun treesit-major-mode-setup This function activates some tree-sitter features for a major mode. commit c289786886bade70f284035d85ae2c9b10df67c5 Author: Yuan Fu Date: Wed Jan 18 15:32:12 2023 -0800 ; Add commentary and dostring in c-ts-mode * lisp/progmodes/c-ts-mode.el: Add commentary. (c-ts-mode, c++-ts-mode): Add docstring. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index f9f75a0e452..0cf77c21d83 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -24,6 +24,34 @@ ;;; Commentary: ;; +;; This package provides major modes for C and C++, plus some handy +;; functions that are useful generally to major modes for C-like +;; languages. +;; +;; This package provides `c-ts-mode' for C, `c++-ts-mode' for C++, and +;; `c-or-c++-ts-mode' which automatically chooses the right mode for +;; C/C++ header files. +;; +;; To use these more by default, evaluate +;; +;; (add-to-list 'major-mode-remap-alist '(c-mode . c-ts-mode)) +;; (add-to-list 'major-mode-remap-alist '(c++-mode . c++-ts-mode)) +;; (add-to-list 'major-mode-remap-alist '(c-or-c++-mode . c-or-c++-ts-mode)) +;; +;; in your configuration. +;; +;; For C-like language major modes: +;; +;; - Use `c-ts-mode-comment-setup' to setup comment variables and +;; filling. +;; +;; - Use simple-indent matcher `c-ts-mode--looking-at-star' and anchor +;; `c-ts-mode--comment-start-after-first-star' for indenting block +;; comments. See `c-ts-mode--indent-styles' for example. +;; +;; - Use variable `c-ts-mode-indent-block-type-regexp' with indent +;; offset c-ts-mode--statement-offset for indenting statements. +;; Again, see `c-ts-mode--indent-styles' for example. ;;; Code: @@ -936,7 +964,16 @@ c-ts-mode This mode is independent from the classic cc-mode.el based `c-mode', so configuration variables of that mode, like -`c-basic-offset', don't affect this mode." +`c-basic-offset', doesn't affect this mode. + +To use tree-sitter C/C++ modes by default, evaluate + + (add-to-list \\='major-mode-remap-alist \\='(c-mode . c-ts-mode)) + (add-to-list \\='major-mode-remap-alist \\='(c++-mode . c++-ts-mode)) + (add-to-list \\='major-mode-remap-alist + \\='(c-or-c++-mode . c-or-c++-ts-mode)) + +in your configuration." :group 'c (when (treesit-ready-p 'c) @@ -957,7 +994,16 @@ c++-ts-mode This mode is independent from the classic cc-mode.el based `c++-mode', so configuration variables of that mode, like -`c-basic-offset', don't affect this mode." +`c-basic-offset', don't affect this mode. + +To use tree-sitter C/C++ modes by default, evaluate + + (add-to-list \\='major-mode-remap-alist \\='(c-mode . c-ts-mode)) + (add-to-list \\='major-mode-remap-alist \\='(c++-mode . c++-ts-mode)) + (add-to-list \\='major-mode-remap-alist + \\='(c-or-c++-mode . c-or-c++-ts-mode)) + +in your configuration." :group 'c++ (when (treesit-ready-p 'cpp) commit 4fb7b0b0b889a317b4a98cce24ed08d5eadc2df1 Author: Michael Heerdegen Date: Wed Jan 18 12:32:05 2023 +0100 Fix an oversight in advice.el This fixes an oversight from 77c3c464a16: "* lisp/emacs-lisp/advice.el (ad-advised-functions): Make it a plain list" that caused an issue as reported in Bug#60893. * lisp/emacs-lisp/advice.el (ad-read-advised-function): Adjust to handle the new type of elements of `ad-advised-functions'. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 080a6d84498..56f0ae2212c 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1850,7 +1850,7 @@ ad-read-advised-function ad-advised-functions (if predicate (lambda (function) - (funcall predicate (intern (car function))))) + (funcall predicate (intern function)))) t))) (if (equal function "") (if (ad-is-advised default) commit 207901457c018d94b1ce9e13a897d8241b1f3af2 Author: Theodor Thornhill Date: Tue Jan 17 21:18:29 2023 +0100 Add treesit-forward-sexp (bug#60894) * lisp/progmodes/java-ts-mode.el (java-ts-mode): Use treesit-sexp-type-regexp. * lisp/treesit.el (treesit-sexp-type-regexp): New defvar. (treesit-forward-sexp): New command. (treesit-major-mode-setup): Conditionally set forward-sexp-function. * lisp/progmodes/ruby-ts-mode.el: Add some types to ruby-ts-mode. * doc/lispref/positions.texi (List Motion): Mention the change in the manual. * etc/NEWS: Mention the change. diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index 8d95ecee7ab..838877b6282 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -875,6 +875,23 @@ List Motion @code{backward-sentence}(@pxref{Moving by Sentences,,, emacs, The extensible self-documenting text editor}). +@defvar treesit-sexp-type-regexp +The value of this variable is a regexp matching the node type of sexp +nodes. (For ``node'' and ``node type'', @pxref{Parsing Program +Source}.) +@end defvar + +@findex treesit-forward-sexp +@findex forward-sexp@r{, and tree-sitter} +@findex backward-sexp@r{, and tree-sitter} +If Emacs is compiled with tree-sitter, it can use the tree-sitter +parser information to move across syntax constructs. Since what +exactly is considered a sexp varies between languages, a major mode +should set @code{treesit-sexp-type-regexp} to determine that. Then +the mode can get navigation-by-sexp functionality for free, by using +@code{forward-sexp} and @code{backward-sexp}(@pxref{Moving by +Sentences,,, emacs, The extensible self-documenting text editor}). + @node Skipping Characters @subsection Skipping Characters @cindex skipping characters diff --git a/etc/NEWS b/etc/NEWS index cde6783349f..fc8a3ac66a0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -84,6 +84,15 @@ define "sentences" in Tree-sitter enabled modes. All tree-sitter modes that define 'treesit-sentence-type-regexp' now set 'forward-sentence-function' to call 'treesit-forward-sentence'. +*** New defvar-local 'treesit-sexp-type-regexp'. +Similarly to 'treesit-defun-type-regexp', this variable is used to +define "sexps" in Tree-sitter enabled modes. + +*** New function 'treesit-forward-sexp'. +treesit.el conditionally sets 'forward-sexp-function` for major modes +that have defined 'treesit-sexp-type-regexp' to enable sexp-related +motion commands. + * Changes in Specialized Modes and Packages in Emacs 30.1 --- diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 83c437d307b..03093e09805 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -328,6 +328,21 @@ java-ts-mode "package_declaration" "import_declaration"))) + (setq-local treesit-sexp-type-regexp + (regexp-opt '("annotation" + "parenthesized_expression" + "argument_list" + "identifier" + "modifiers" + "block" + "body" + "literal" + "access" + "reference" + "_type" + "true" + "false"))) + ;; Font-lock. (setq-local treesit-font-lock-settings java-ts-mode--font-lock-settings) (setq-local treesit-font-lock-feature-list diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index f075824591d..66b50a4b540 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1008,6 +1008,20 @@ ruby-ts-mode ;; Navigation. (setq-local treesit-defun-type-regexp ruby-ts--method-regex) + (setq-local treesit-sexp-type-regexp + (regexp-opt '("class" + "module" + "method" + "argument_list" + "array" + "hash" + "parenthesized_statements" + "if" + "case" + "block" + "do_block" + "begin"))) + ;; AFAIK, Ruby can not nest methods (setq-local treesit-defun-prefer-top-level nil) diff --git a/lisp/treesit.el b/lisp/treesit.el index e8571d43db3..7aeff3b8b49 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1636,6 +1636,21 @@ treesit-search-forward-goto (goto-char current-pos))) node)) +(defvar-local treesit-sexp-type-regexp nil + "A regexp that matches the node type of sexp nodes. + +A sexp node is a node that is bigger than punctuation, and +delimits medium sized statements in the source code. It is, +however, smaller in scope than sentences. This is used by +`treesit-forward-sexp' and friends.") + +(defun treesit-forward-sexp (&optional arg) + (interactive "^p") + (or arg (setq arg 1)) + (funcall + (if (> arg 0) #'treesit-end-of-thing #'treesit-beginning-of-thing) + treesit-sexp-type-regexp (abs arg))) + (defun treesit-transpose-sexps (&optional arg) "Tree-sitter `transpose-sexps' function. Arg is the same as in `transpose-sexps'. @@ -2301,6 +2316,8 @@ treesit-major-mode-setup (setq-local add-log-current-defun-function #'treesit-add-log-current-defun)) + (when treesit-sexp-type-regexp + (setq-local forward-sexp-function #'treesit-forward-sexp)) (setq-local transpose-sexps-function #'treesit-transpose-sexps) (when treesit-sentence-type-regexp (setq-local forward-sentence-function #'treesit-forward-sentence)) commit 78b83a744fa28abb3bb631e2688c19bd68896425 Author: Eli Zaretskii Date: Thu Jan 19 20:13:54 2023 +0200 ; * etc/NEWS: Rearrange instructions for building tree-sitter grammars. diff --git a/etc/NEWS b/etc/NEWS index 9f735bec443..38f2db26a1a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -53,29 +53,31 @@ yourself. Many libraries can be downloaded from the tree-sitter site: https://github.com/tree-sitter -To compile such a library, compile the files "scanner.c" and "parser.c" -(sometimes named "scanner.cc" and "parser.cc") in the "src" subdirectory -of the library's source tree using the C or C++ compiler, then link -these two files into a shared library named "libtree-sitter-LANG.so", -where LANG is the name of the language supported by the grammar as it -is expected by the Emacs major mode (for example, "c" for 'c-ts-mode', -"cpp" for 'c++-ts-mode', "python" for 'python-ts-mode', etc.). Then place -the shared library you've built in the same directory where you keep -the other shared libraries used by Emacs, or in the "tree-sitter" -subdirectory of your 'user-emacs-directory', or in a directory -mentioned in the variable 'treesit-extra-load-path'. - -You only need to install language grammar libraries required by the -Emacs modes you will use, as Emacs loads these libraries only when the -corresponding mode is turned on in some buffer for the first time in -an Emacs session. - Emacs provides a user command, 'treesit-install-language-grammar', that automates the download and build process of a grammar library. It prompts for the language, the URL of the language grammar's VCS repository, and then uses the installed C/C++ compiler to build the library and install it. +You can also do this manually. To compile such a library after +cloning its Git repository, compile the files "scanner.c" and +"parser.c" (sometimes named "scanner.cc" and "parser.cc") in the "src" +subdirectory of the library's source tree using the C or C++ compiler, +then link these two files into a shared library named +"libtree-sitter-LANG.so", where LANG is the name of the language +supported by the grammar as it is expected by the Emacs major mode +(for example, "c" for 'c-ts-mode', "cpp" for 'c++-ts-mode', "python" +for 'python-ts-mode', etc.). Then place the shared library you've +built in the same directory where you keep the other shared libraries +used by Emacs, or in the "tree-sitter" subdirectory of your +'user-emacs-directory', or in a directory mentioned in the variable +'treesit-extra-load-path'. + +You only need to install language grammar libraries required by the +Emacs modes you will use, as Emacs loads these libraries only when the +corresponding mode is turned on in some buffer for the first time in +an Emacs session. + +++ ** Emacs can be built with built-in support for accessing SQLite databases. This uses the popular sqlite3 library, and can be disabled by using commit fb82d4e3286935286b51765c4823f290428f25aa Author: Dmitry Gutov Date: Thu Jan 19 19:43:19 2023 +0200 (treesit-simple-indent-presets): Have n-p-gp check for grandparent's presence * lisp/treesit.el (treesit-simple-indent-presets): Have n-p-gp check for grandparent's presence before checking its type. diff --git a/lisp/treesit.el b/lisp/treesit.el index 34d288226fa..7669ed6d18c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1102,10 +1102,12 @@ treesit-simple-indent-presets (string-match-p parent-t (treesit-node-type parent))) (or (null grand-parent-t) - (string-match-p - grand-parent-t - (treesit-node-type - (treesit-node-parent parent)))))))) + (and + (treesit-node-parent parent) + (string-match-p + grand-parent-t + (treesit-node-type + (treesit-node-parent parent))))))))) (cons 'no-node (lambda (node &rest _) (null node))) (cons 'parent-is (lambda (type) (lambda (_n parent &rest _) commit 25ddb3f7d999d64989295e694b3111cb05561585 Author: Dmitry Gutov Date: Thu Jan 19 18:31:57 2023 +0200 ; ruby-ts--indent-rules: Minor cleanup * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules): Remove the (match "begin" "assignment") rule. The catch-all has the same effect. Update a comment referring to rules removed previously. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 41a1d8df2a6..71562b46306 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -648,9 +648,6 @@ ruby-ts--indent-rules parent 0) ((match "\\." "call") parent ruby-indent-level) - ;; ruby-indent-after-block-in-continued-expression - ((match "begin" "assignment") parent ruby-indent-level) - ;; method parameters -- four styles: ;; 1) With paren, first arg on same line: ((and (query "(method_parameters \"(\" _ @indent)") @@ -706,10 +703,9 @@ ruby-ts--indent-rules ;; ruby-mode does not touch these... ((match "bare_string" "string_array") no-indent 0) - ;; hash and array other than assignments. Note that the - ;; first sibling is the "{" or "[". There is a special - ;; case where the hash is an argument to a method. These - ;; need to be processed first. + ;; hash and array. Note that the first sibling is the "{" + ;; or "[". There is a special case where the hash is an + ;; argument to a method. These need to be processed first. ((and ruby-ts--same-line-hash-array-p (match "}" "hash")) first-sibling 0) commit a0ce569d3b75eb98e945dbd443444fddfb779fde Author: Dmitry Gutov Date: Thu Jan 19 17:42:05 2023 +0200 ruby-toggle-block: Fix in ruby-ts-mode * lisp/progmodes/ruby-mode.el (ruby-toggle-block): Make it work with ruby-ts-mode. ruby-forward-sexp checks ruby-use-smie. diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 2e8d335f151..2de7395f765 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1927,7 +1927,7 @@ ruby-toggle-block (end-of-line) (unless (if (and (re-search-backward "\\(?:[^#]\\)\\({\\)\\|\\(\\_\\)") - (progn + (let ((ruby-use-smie (and ruby-use-smie (consp smie-grammar)))) (goto-char (or (match-beginning 1) (match-beginning 2))) (setq beg (point)) (with-suppressed-warnings ((obsolete ruby-forward-sexp)) commit 0d3b6518e39a28774e4e70ed9bb7ef4aa009c0cf Author: Dmitry Gutov Date: Thu Jan 19 17:31:43 2023 +0200 (ruby-ts--indent-rules): Indent inside empty parens properly * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules): Consider the case when there are no arguments inside the call yet. * test/lisp/progmodes/ruby-ts-mode-tests.el (ruby-ts-indent-call-no-args): Add test. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index f075824591d..41a1d8df2a6 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -680,7 +680,9 @@ ruby-ts--indent-rules ((and (query "(argument_list \"(\" _ @indent)") (node-is ")")) ruby-ts--parent-call-or-bol 0) - ((query "(argument_list \"(\" _ @indent)") + ((or (query "(argument_list \"(\" _ @indent)") + ;; No arguments yet; NODE is nil in that case. + (match "\\`\\'" "argument_list")) ruby-ts--parent-call-or-bol ruby-indent-level) ;; 3) No paren, ruby-parenless-call-arguments-indent is t ((and ruby-ts--parenless-call-arguments-indent-p (parent-is "argument_list")) diff --git a/test/lisp/progmodes/ruby-ts-mode-tests.el b/test/lisp/progmodes/ruby-ts-mode-tests.el index d34c235e82b..18e3e60a04a 100644 --- a/test/lisp/progmodes/ruby-ts-mode-tests.el +++ b/test/lisp/progmodes/ruby-ts-mode-tests.el @@ -110,6 +110,18 @@ ruby-ts-align-to-stmt-keywords-case | 42 | end"))) + +(ert-deftest ruby-ts-indent-call-no-args () + (skip-unless (treesit-ready-p 'ruby t)) + (ruby-ts-with-temp-buffer + "variable = foo( + +)" + (goto-char (point-min)) + (forward-line 1) + (funcall indent-line-function) + (should (= (current-indentation) ruby-indent-level)))) + (ert-deftest ruby-ts-add-log-current-method-examples () (skip-unless (treesit-ready-p 'ruby t)) (let ((pairs '(("foo" . "#foo") commit 03a8d132b0e0fe318cc37381a67c1f9a8e82eab3 Author: Michael Heerdegen Date: Wed Jan 18 12:32:05 2023 +0100 Fix an oversight in advice.el This fixes an oversight from 77c3c464a16: "* lisp/emacs-lisp/advice.el (ad-advised-functions): Make it a plain list" that caused an issue as reported in Bug#60893. * lisp/emacs-lisp/advice.el (ad-read-advised-function): Adjust to handle the new type of elements of `ad-advised-functions'. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 080a6d84498..56f0ae2212c 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1850,7 +1850,7 @@ ad-read-advised-function ad-advised-functions (if predicate (lambda (function) - (funcall predicate (intern (car function))))) + (funcall predicate (intern function)))) t))) (if (equal function "") (if (ad-is-advised default) commit 7fb69ce233b8a655af63d4c47b7359c43660acf6 Author: Eli Zaretskii Date: Thu Jan 19 16:15:13 2023 +0200 ; * doc/emacs/modes.texi (Choosing Modes): Add index entries. diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi index 06f9929092c..0e4b15fb514 100644 --- a/doc/emacs/modes.texi +++ b/doc/emacs/modes.texi @@ -429,8 +429,11 @@ Choosing Modes @code{(@t{"\\.c\\'"} . c-mode)}, and it is responsible for selecting C mode for files whose names end in @file{.c}. (Note that @samp{\\} is needed in Lisp syntax to include a @samp{\} in the string, which must -be used to suppress the special meaning of @samp{.} in regexps.) If -the element has the form @w{@code{(@var{regexp} @var{mode-function} +be used to suppress the special meaning of @samp{.} in regexps.) + +@cindex backup files, choosing a major mode +@cindex encrypted files, choosing a major mode +If the element has the form @w{@code{(@var{regexp} @var{mode-function} @var{flag})}} and @var{flag} is non-@code{nil}, then after calling @var{mode-function} (if it is non-@code{nil}), Emacs discards the suffix that matched @var{regexp} and searches the list again for commit 12d7670b90f66f1d45a8c69d9acfc25238a65b02 Author: Kai Tetzlaff Date: Thu Jan 19 03:16:14 2023 +0100 Fix bug in 'sieve-manage--append-to-log' * lisp/net/sieve-manage.el (sieve-manage--append-to-log): Fix log buffer creation. (Bug#54154) Do not merge to master. diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el index 5bee4f4c4ad..4866f788bff 100644 --- a/lisp/net/sieve-manage.el +++ b/lisp/net/sieve-manage.el @@ -168,19 +168,25 @@ sieve-manage-capability ;; Internal utility functions (defun sieve-manage--append-to-log (&rest args) - "Append ARGS to sieve-manage log buffer. + "Append ARGS to `sieve-manage-log' buffer. ARGS can be a string or a list of strings. -The buffer to use for logging is specifified via -`sieve-manage-log'. If it is nil, logging is disabled." +The buffer to use for logging is specifified via `sieve-manage-log'. +If it is nil, logging is disabled. + +When the `sieve-manage-log' buffer doesn't exist, it gets created (and +configured with some initial settings)." (when sieve-manage-log - (with-current-buffer (or (get-buffer sieve-manage-log) - (with-current-buffer - (get-buffer-create sieve-manage-log) - (set-buffer-multibyte nil) - (buffer-disable-undo))) - (goto-char (point-max)) - (apply #'insert args)))) + (let* ((existing-log-buffer (get-buffer sieve-manage-log)) + (log-buffer (or existing-log-buffer + (get-buffer-create sieve-manage-log)))) + (with-current-buffer log-buffer + (unless existing-log-buffer + ;; Do this only once, when creating the log buffer. + (set-buffer-multibyte nil) + (buffer-disable-undo)) + (goto-char (point-max)) + (apply #'insert args))))) (defun sieve-manage--message (format-string &rest args) "Wrapper around `message' which also logs to sieve manage log. commit 21be03cccb611ea9e6c73fb04e578c48edf49a25 Author: Alan Mackenzie Date: Thu Jan 19 10:59:10 2023 +0000 CC Mode: Prevent two classes of "type" prematurely entering c-found-types This fixes bug #60769. The two classes of "type" are foo and bar in "foo d(bar () ...)", where the d could be a mistyped C-M-d. * list/progmodes/cc-engine.el (c-forward-decl-or-cast-1): New local variable got-arglist. Refactor a sequence of enclosed `if' forms into a `cond' form. Set got-arglist when needed. In CASE 2, set unsafe-maybe to inhibit foo being entered into c-found-types. In CASE 19, likewise set unsafe-maybe, to inhibit bar entering c-found-types. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 3fa407dd338..ebcb20f0f8c 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -10475,6 +10475,8 @@ c-forward-decl-or-cast-1 got-prefix ;; True if the declarator is surrounded by a parenthesis pair. got-parens + ;; True if there is a terminated argument list. + got-arglist ;; True if there is an identifier in the declarator. got-identifier ;; True if we find a number where an identifier was expected. @@ -10622,13 +10624,17 @@ c-forward-decl-or-cast-1 (when (> paren-depth 0) (setq paren-depth (1- paren-depth)) (forward-char) + (when (and (not got-parens) + (eq paren-depth 0)) + (setq got-arglist t)) t) - (when (if (save-match-data (looking-at "\\s(")) - (c-safe (c-forward-sexp 1) t) - (if (save-match-data - (looking-at c-fun-name-substitute-key)) ; requires - (c-forward-c++-requires-clause) - (goto-char (match-end 1)) + (when (cond + ((save-match-data (looking-at "\\s(")) + (c-safe (c-forward-sexp 1) t)) + ((save-match-data + (looking-at c-fun-name-substitute-key)) ; C++ requires + (c-forward-c++-requires-clause)) + (t (goto-char (match-end 1)) t)) (when (and (not got-suffix-after-parens) (= paren-depth 0)) @@ -10690,8 +10696,11 @@ c-forward-decl-or-cast-1 (goto-char pos) (setq pd (1- pd))) t))) - (c-fdoc-shift-type-backward) - t))) + (c-fdoc-shift-type-backward) + (when (and (not got-parens) + (eq paren-depth 0)) + (setq got-arglist t)) + t))) (c-forward-syntactic-ws)) @@ -10759,6 +10768,9 @@ c-forward-decl-or-cast-1 (not (or got-prefix got-parens))) ;; Got another identifier directly after the type, so it's a ;; declaration. + (when (and got-arglist + (eq at-type 'maybe)) + (setq unsafe-maybe t)) (throw 'at-decl-or-cast t)) (when (and got-parens @@ -11147,9 +11159,17 @@ c-forward-decl-or-cast-1 ;; inside an arglist that contains declarations. Update (2017-09): We ;; now recognize a top-level "foo(bar);" as a declaration in C. ;; CASE 19 - (or (eq context 'decl) - (and (c-major-mode-is 'c-mode) - (or (eq context 'top) make-top)))))) + (when + (or (eq context 'decl) + (and (c-major-mode-is 'c-mode) + (or (eq context 'top) make-top))) + (when (and (eq at-type 'maybe) + got-parens) + ;; If we've got "foo d(bar () ...)", the d could be a typing + ;; mistake, so we don't promote the 'maybe type "bar" to a 'found + ;; type. + (setq unsafe-maybe t)) + t)))) ;; The point is now after the type decl expression. commit 9161a302c9f9fbfa1a8f33181bb332d2c5df3aa7 Merge: efb9ec11bbe db727873803 Author: Stefan Kangas Date: Thu Jan 19 06:30:25 2023 +0100 Merge from origin/emacs-29 db727873803 ruby-ts-mode: Use font-lock-constant-face for true/false/nil 819719330ad (ruby-ts--indent-rules): Add a rule for continuation of a... 94b9cbf96fb (ruby-ts--parent-call-or-bol): Handle more cases with nes... ba33b83ce4b (ruby-ts--statement-container-regexp): Remove "parenthesi... f2bedf695c1 ruby-ts-mode: Handle indent in parenless calls much close... 758ac5eabbe Fix split-window-below for the case when split-window-kee... 8e9783b4ce4 Rebind in read-regexp-map ‘M-c’ to ‘M-s c’ compatible wit... 78f93d92b28 * lisp/vc/vc-dir.el: Make keys ‘% m’ and ‘* %’ compatible... dc3f85fd4b0 Use proper types for Eshell warnings 6a8338a8bc8 ; Avoid byte-compiler warning in cc-fonts.el. 9186be20aeb ; Clarify doc strings of some functions in files.el bd5ef3ef95e Improve the documentation of 'auto-mode-alist' search 1798ff5a663 ; Fix minor mistakes in documentation faee7e1f1bd ; * lisp/treesit.el (treesit-font-lock-fontify-region): M... 24f0dfd3731 Revert "Revert "Add c-or-c++-ts-mode (bug#59613)"" ac3bc775b6f Make it harder to misactivate tree-sitter font-lock fast ... bdd82fa7977 ; * src/treesit.c: Remove unused boilerplate. 343b9b3dfe3 ruby-ts-mode: Obey the option ruby-method-call-indent 045404d1aac ruby-ts-mode: Obey the option ruby-after-operator-indent 300ca6ac372 ruby-ts-mode: Fix indent after operator or conditional ac5516bd7d5 ruby-ts-mode: Fix/change indentation of a continuation me... 5e2e68a0c2d ruby-ts-mode: Fix indent inside parenthesized_expr and el... 9ed9ff4690a ruby-ts-mode: Fix the rules for hanging arrays and hashes c4f0b6ccea1 Add more detail about how to invoke Eshell commands dbac923b9df CC Mode: On removal of "typedef", remove pertinent types ... 56d69c2fc47 ; Relax timeouts for failing ERC test 183e7492702 Don't preserve non-module minor modes in erc-open 7b8322f6285 Use correct buffer for local-module vars in erc-open 7b13422298a ; Avoid plist-get as generalized var in erc-compat 09e9d7c7496 Fix display of warnings on w32 console bd094207c76 Fix buffer-list-update-hook for indirect buffers 9e7a5d58eea ; Fix tree-sitter indent anchor preset 7c61a304104 Fix treesit-node-first-child-for-pos (bug#60127) b36cc7e7bbb ; * src/treesit.c (Ftreesit_induce_sparse_tree): Minor ch... # Conflicts: # etc/NEWS commit db727873803a974ba210c4942ae7cbcc3d6268ab Author: Dmitry Gutov Date: Thu Jan 19 05:43:10 2023 +0200 ruby-ts-mode: Use font-lock-constant-face for true/false/nil * lisp/progmodes/ruby-ts-mode.el (ruby-ts--font-lock-settings): Use font-lock-constant-face for true/false/nil. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index c334c4aff0c..f075824591d 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -220,9 +220,9 @@ ruby-ts--font-lock-settings :language language :feature 'constant - '((true) @font-lock-doc-markup-face - (false) @font-lock-doc-markup-face - (nil) @font-lock-doc-markup-face) + '((true) @font-lock-constant-face + (false) @font-lock-constant-face + (nil) @font-lock-constant-face) ;; Before 'operator so (unary) works. :language language commit 819719330ad9d1c2836079ef3006c5790fa7f93f Author: Dmitry Gutov Date: Thu Jan 19 05:26:03 2023 +0200 (ruby-ts--indent-rules): Add a rule for continuation of a hash pair * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules): Add a rule for continuation of a hash pair. * test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb: Add examples. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index a2b2721dc1b..c334c4aff0c 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -723,6 +723,8 @@ ruby-ts--indent-rules ((match "]" "array") ruby-ts--parent-call-or-bol 0) ((parent-is "array") ruby-ts--parent-call-or-bol ruby-indent-level) + ((parent-is "pair") ruby-ts--parent-call-or-bol 0) + ((match ")" "parenthesized_statements") parent-bol 0) ((parent-is "parenthesized_statements") parent-bol ruby-indent-level) diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb index fa16107c56e..4be532a5e9d 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb @@ -79,6 +79,12 @@ c: d }) +foo(foo, bar: + tee) + +foo(foo, :bar => + tee) + # Local Variables: # mode: ruby-ts # ruby-after-operator-indent: t commit 94b9cbf96fbb61b53242d205ff559deee36279c6 Author: Dmitry Gutov Date: Thu Jan 19 05:10:05 2023 +0200 (ruby-ts--parent-call-or-bol): Handle more cases with nested literals * lisp/progmodes/ruby-ts-mode.el (ruby-ts--parent-call-or-bol): Handle more cases with nested literals. * test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb: Add examples. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 5df7e397f03..a2b2721dc1b 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -796,18 +796,21 @@ ruby-ts--parent-call-or-bol (treesit-parent-until parent (lambda (node) - (or (<= (treesit-node-start node) parent-bol) - (and - ;; Parenless call. - (equal (treesit-node-type node) "argument_list") - (not (equal (treesit-node-type - (treesit-node-child node 0)) - "("))))) - t))) + (or (< (treesit-node-start node) parent-bol) + (string-match-p "\\`array\\|hash\\'" (treesit-node-type node)) + ;; Method call on same line. + (equal (treesit-node-type node) "argument_list")))))) (cond - ;; No parenless call found on the current line. - ((<= (treesit-node-start found) parent-bol) + ((null found) parent-bol) + ;; No paren/curly/brace found on the same line. + ((< (treesit-node-start found) parent-bol) + parent-bol) + ;; Hash or array opener on the same line. + ((string-match-p "\\`array\\|hash\\'" (treesit-node-type found)) + (save-excursion + (goto-char (treesit-node-start (treesit-node-child found 1))) + (point))) ;; Parenless call found: indent to stmt with offset. ((not ruby-parenless-call-arguments-indent) (save-excursion @@ -815,6 +818,12 @@ ruby-ts--parent-call-or-bol (ruby-ts--statement-ancestor found))) ;; (**) Same. (+ (point) ruby-indent-level))) + ;; Call with parens -- ident to first arg. + ((equal (treesit-node-type (treesit-node-child found 0)) + "(") + (save-excursion + (goto-char (treesit-node-start (treesit-node-child found 1))) + (point))) ;; Indent to the parenless call args beginning. (t (save-excursion diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb index 1f7caf64c34..fa16107c56e 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb @@ -62,6 +62,23 @@ c * d + 12 +{'a' => { + 'b' => 'c', + 'd' => %w(e f) + } +} + +[1, 2, { + 'b' => 'c', + 'd' => %w(e f) + } +] + +foo(a, { + a: b, + c: d + }) + # Local Variables: # mode: ruby-ts # ruby-after-operator-indent: t commit ba33b83ce4b27b353441a174faaba024d59e4614 Author: Dmitry Gutov Date: Thu Jan 19 03:51:51 2023 +0200 (ruby-ts--statement-container-regexp): Remove "parenthesized_statements" * lisp/progmodes/ruby-ts-mode.el (ruby-ts--statement-container-regexp): Remove "parenthesized_statements", it's not really a statement container, not one we'd use for indentation alignment anyway. * test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb: Add examples. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 3a6d513c330..5df7e397f03 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -152,7 +152,6 @@ ruby-ts--statement-container-regexp "then" "ensure" "body_statement" - "parenthesized_statements" "interpolation") string-end) "Regular expression of the nodes that can contain statements.") diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb index 9959de4fe71..1f7caf64c34 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb @@ -54,6 +54,14 @@ bar : tee +with_paren = (a + b * + c * d + + 12) + +without_paren = a + b * + c * d + + 12 + # Local Variables: # mode: ruby-ts # ruby-after-operator-indent: t commit f2bedf695c15da93e8e240ad11a350a8dc8b5549 Author: Dmitry Gutov Date: Thu Jan 19 03:38:58 2023 +0200 ruby-ts-mode: Handle indent in parenless calls much closer to ruby-mode * lisp/progmodes/ruby-ts-mode.el (ruby-ts--parent-call-or-bol): New function. (ruby-ts--indent-rules): Use it for cases which need special anchoring logic when inside a parenless method call. Remove the ad-hoc handling of pair-hash-pair etc indentation, which was there only for the parenless cases, apparently. Have "No paren, ruby-parenless-call-arguments-indent is nil" case align to the statement, if only because ruby-mode does that. * test/lisp/progmodes/ruby-ts-mode-tests.el: Run indent test for ruby-parenless-call-arguments-indent.rb. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 27e5d002881..3a6d513c330 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -680,14 +680,15 @@ ruby-ts--indent-rules ;; 2) With paren, 1st arg on next line ((and (query "(argument_list \"(\" _ @indent)") (node-is ")")) - parent-bol 0) + ruby-ts--parent-call-or-bol 0) ((query "(argument_list \"(\" _ @indent)") - parent-bol ruby-indent-level) + ruby-ts--parent-call-or-bol ruby-indent-level) ;; 3) No paren, ruby-parenless-call-arguments-indent is t ((and ruby-ts--parenless-call-arguments-indent-p (parent-is "argument_list")) first-sibling 0) ;; 4) No paren, ruby-parenless-call-arguments-indent is nil - ((parent-is "argument_list") (ruby-ts--bol ruby-ts--grand-parent-node) ruby-indent-level) + ((parent-is "argument_list") + (ruby-ts--bol ruby-ts--statement-ancestor) ruby-indent-level) ;; Old... probably too simple ((parent-is "block_parameters") first-sibling 1) @@ -718,27 +719,10 @@ ruby-ts--indent-rules ((and ruby-ts--same-line-hash-array-p (parent-is "array")) (nth-sibling 0 ruby-ts--true) 0) - ;; NOTE to folks trying to understand my insanity... - ;; I having trouble understanding the "logic" of why things - ;; are indented like they are so I am adding special cases - ;; hoping at some point I will be struck by lightning. - ((and (n-p-gp "}" "hash" "pair") - (not ruby-ts--same-line-hash-array-p)) - grand-parent 0) - ((and (n-p-gp "pair" "hash" "pair") - (not ruby-ts--same-line-hash-array-p)) - grand-parent ruby-indent-level) - ((and (n-p-gp "}" "hash" "method") - (not ruby-ts--same-line-hash-array-p)) - grand-parent 0) - ((and (n-p-gp "pair" "hash" "method") - (not ruby-ts--same-line-hash-array-p)) - grand-parent ruby-indent-level) - - ((match "}" "hash") parent-bol 0) - ((parent-is "hash") parent-bol ruby-indent-level) - ((match "]" "array") parent-bol 0) - ((parent-is "array") parent-bol ruby-indent-level) + ((match "}" "hash") ruby-ts--parent-call-or-bol 0) + ((parent-is "hash") ruby-ts--parent-call-or-bol ruby-indent-level) + ((match "]" "array") ruby-ts--parent-call-or-bol 0) + ((parent-is "array") ruby-ts--parent-call-or-bol ruby-indent-level) ((match ")" "parenthesized_statements") parent-bol 0) ((parent-is "parenthesized_statements") parent-bol ruby-indent-level) @@ -798,9 +782,46 @@ ruby-ts--binary-indent-anchor (goto-char (treesit-node-start parent)) (when (string-match-p ruby-ts--statement-container-regexp (treesit-node-type (treesit-node-parent parent))) + ;; Hack alert: it's not the proper place to alter the offset. + ;; Redoing the analysis in the OFFSET form seems annoying, + ;; though. (**) (forward-char ruby-indent-level)) (point))) +(defun ruby-ts--parent-call-or-bol (_not parent _bol &rest _) + (let* ((parent-bol (save-excursion + (goto-char (treesit-node-start parent)) + (back-to-indentation) + (point))) + (found + (treesit-parent-until + parent + (lambda (node) + (or (<= (treesit-node-start node) parent-bol) + (and + ;; Parenless call. + (equal (treesit-node-type node) "argument_list") + (not (equal (treesit-node-type + (treesit-node-child node 0)) + "("))))) + t))) + (cond + ;; No parenless call found on the current line. + ((<= (treesit-node-start found) parent-bol) + parent-bol) + ;; Parenless call found: indent to stmt with offset. + ((not ruby-parenless-call-arguments-indent) + (save-excursion + (goto-char (treesit-node-start + (ruby-ts--statement-ancestor found))) + ;; (**) Same. + (+ (point) ruby-indent-level))) + ;; Indent to the parenless call args beginning. + (t + (save-excursion + (goto-char (treesit-node-start found)) + (point)))))) + (defun ruby-ts--after-op-indent-p (&rest _) ruby-after-operator-indent) diff --git a/test/lisp/progmodes/ruby-ts-mode-tests.el b/test/lisp/progmodes/ruby-ts-mode-tests.el index 1d2cfbfb901..d34c235e82b 100644 --- a/test/lisp/progmodes/ruby-ts-mode-tests.el +++ b/test/lisp/progmodes/ruby-ts-mode-tests.el @@ -255,6 +255,7 @@ "ruby-after-operator-indent.rb" (ruby-ts-deftest-indent "ruby-block-indent.rb") (ruby-ts-deftest-indent "ruby-method-call-indent.rb") (ruby-ts-deftest-indent "ruby-method-params-indent.rb") +(ruby-ts-deftest-indent "ruby-parenless-call-arguments-indent.rb") (provide 'ruby-ts-mode-tests) commit 758ac5eabbe05fa5244e1bf863e45069035f311c Author: Juri Linkov Date: Wed Jan 18 20:24:26 2023 +0200 Fix split-window-below for the case when split-window-keep-point is nil. * lisp/window.el (split-window-below): Don't try to move point when split-window-keep-point is nil and window-to-split is not the selected window or nil (that defaults to the selected window) because code makes sense only for the selected window. (split-window-below, split-window-right): Improve docstrings (bug#60886) diff --git a/lisp/window.el b/lisp/window.el index 4099b707009..84f5c5c3f5a 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5670,7 +5670,8 @@ split-window-keep-point (defun split-window-below (&optional size window-to-split) "Split WINDOW-TO-SPLIT into two windows, one above the other. -WINDOW-TO-SPLIT is above. The newly split-off window is +WINDOW-TO-SPLIT defaults to the selected window and and will be above +the other window after splitting. The newly split-off window is below and displays the same buffer. Return the new window. If optional argument SIZE is omitted or nil, both windows get the @@ -5691,7 +5692,9 @@ split-window-below ;; `split-window' would not signal an error here. (error "Size of new window too small")) (setq new-window (split-window window-to-split size)) - (unless split-window-keep-point + (when (and (null split-window-keep-point) + (or (null window-to-split) + (eq window-to-split (selected-window)))) (with-current-buffer (window-buffer window-to-split) ;; Use `save-excursion' around vertical movements below ;; (Bug#10971). Note: When WINDOW-TO-SPLIT's buffer has a @@ -5732,8 +5735,9 @@ split-root-window-below (defun split-window-right (&optional size window-to-split) "Split WINDOW-TO-SPLIT into two side-by-side windows. -WINDOW-TO-SPLIT is on the left. The newly split-off window is on -the right and displays the same buffer. Return the new window. +WINDOW-TO-SPLIT defaults to the selected window and and will be on the +left after splitting. The newly split-off window is on the right and +displays the same buffer. Return the new window. If optional argument SIZE is omitted or nil, both windows get the same width, or close to it. If SIZE is positive, the left-hand commit 8e9783b4ce42122a8670f16f21a73597a226b674 Author: Juri Linkov Date: Wed Jan 18 20:05:19 2023 +0200 Rebind in read-regexp-map ‘M-c’ to ‘M-s c’ compatible with search-map Also it's compatible with 'M-s c' (isearch-toggle-case-fold) used during Isearch. Also makes possible to use the global keybinding 'M-c' (capitalize-dwim) in the minibuffer. * doc/lispref/minibuf.texi (Text from Minibuffer): Rename ‘M-c’ to ‘M-s c’. * lisp/replace.el (read-regexp-map): Rebind ‘M-c’ to ‘M-s c’ (bug#60741). (read-regexp-toggle-case-fold): Rename from read-regexp-toggle-case-folding to more standard name. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 18125c372ce..114e5d38a80 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -312,7 +312,7 @@ Text from Minibuffer @cindex @code{case-fold}, text property @findex read-regexp-case-fold-search -The user can use the @kbd{M-c} command to indicate whether case +The user can use the @kbd{M-s c} command to indicate whether case folding should be on or off. If the user has used this command, the returned string will have the text property @code{case-fold} set to either @code{fold} or @code{inhibit-fold}. It is up to the caller of diff --git a/etc/NEWS b/etc/NEWS index 14941b906ef..9f735bec443 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3807,7 +3807,7 @@ These function now take an optional comparison PREDICATE argument. ** 'read-multiple-choice' can now use long-form answers. +++ -** 'M-c' in 'read-regexp' now toggles case folding. +** 'M-s c' in 'read-regexp' now toggles case folding. +++ ** 'completing-read' now allows a function as its REQUIRE-MATCH argument. diff --git a/lisp/replace.el b/lisp/replace.el index 2f063bbf66b..3c2b925ea92 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -824,11 +824,11 @@ read-regexp-suggestions (defvar-keymap read-regexp-map :parent minibuffer-local-map - "M-c" #'read-regexp-toggle-case-folding) + "M-s c" #'read-regexp-toggle-case-fold) (defvar read-regexp--case-fold nil) -(defun read-regexp-toggle-case-folding () +(defun read-regexp-toggle-case-fold () (interactive) (setq read-regexp--case-fold (if (or (eq read-regexp--case-fold 'fold) @@ -875,7 +875,7 @@ read-regexp The optional argument HISTORY is a symbol to use for the history list. If nil, use `regexp-history'. -If the user has used the \\\\[read-regexp-toggle-case-folding] command to specify case +If the user has used the \\\\[read-regexp-toggle-case-fold] command to specify case sensitivity, the returned string will have a text property named `case-fold' that has a value of either `fold' or `inhibit-fold'. (It's up to the caller of `read-regexp' to commit 78f93d92b2871cc05f5293c7344fe5fe188a763c Author: Juri Linkov Date: Wed Jan 18 19:55:10 2023 +0200 * lisp/vc/vc-dir.el: Make keys ‘% m’ and ‘* %’ compatible with Dired (vc-dir-mode-map): Replace ‘%’ for vc-dir-mark-by-regexp with ‘% m’ in regexp-map and ‘* %’ in mark-map (bug#60887). * doc/emacs/maintaining.texi (VC Directory Commands): Replace ‘%’ with ‘% m’ and ‘* %’. Mention vc-dir-mark-registered-files. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 8c77ded55d3..5191bb2918d 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1331,11 +1331,18 @@ VC Directory Commands listed files and directories. @findex vc-dir-mark-by-regexp -@item % +@item % m +@itemx * % You can use this command to mark files by regexp (@code{vc-dir-mark-by-regexp}). If given a prefix, unmark files instead. +@findex vc-dir-mark-registered-files +@item * r +You can use this command to mark files that are in one of registered +states, including edited, added or removed. +(@code{vc-dir-mark-registered-files}). + @item G Add the file under point to the list of files that the VC should ignore (@code{vc-dir-ignore}). For instance, if the VC is Git, it diff --git a/etc/NEWS b/etc/NEWS index 95dd4a24ec3..14941b906ef 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2079,7 +2079,7 @@ The VC Directory buffer now uses the prefix 'b' for these branch-related commands. +++ -*** New command '%' ('vc-dir-mark-by-regexp'). +*** New command 'vc-dir-mark-by-regexp' bound to '% m' and '* %'. This command marks files based on a regexp. If given a prefix argument, unmark instead. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 312556f644a..53d58870b32 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -325,7 +325,6 @@ vc-dir-mode-map (define-key map "U" #'vc-dir-unmark-all-files) (define-key map "\C-?" #'vc-dir-unmark-file-up) (define-key map "\M-\C-?" #'vc-dir-unmark-all-files) - (define-key map "%" #'vc-dir-mark-by-regexp) ;; Movement. (define-key map "n" #'vc-dir-next-line) (define-key map " " #'vc-dir-next-line) @@ -361,8 +360,13 @@ vc-dir-mode-map (define-key branch-map "l" #'vc-print-branch-log) (define-key branch-map "s" #'vc-switch-branch)) + (let ((regexp-map (make-sparse-keymap))) + (define-key map "%" regexp-map) + (define-key regexp-map "m" #'vc-dir-mark-by-regexp)) + (let ((mark-map (make-sparse-keymap))) (define-key map "*" mark-map) + (define-key mark-map "%" #'vc-dir-mark-by-regexp) (define-key mark-map "r" #'vc-dir-mark-registered-files)) ;; Hook up the menu. @@ -791,7 +795,7 @@ vc-dir-mark-state-files vc-ewoc)) (defun vc-dir-mark-registered-files () - "Mark files that are in one of registered state: edited, added or removed." + "Mark files that are in one of registered states: edited, added or removed." (interactive) (vc-dir-mark-state-files '(edited added removed))) commit efb9ec11bbee3871d77dc4e9217bd9293d525d5d Author: Mattias Engdegård Date: Wed Jan 18 18:41:39 2023 +0100 Improved docstring single quote warning * lisp/emacs-lisp/bytecomp.el (byte-compile-docstring-style-warn): More robust regexp. More explicit warning message. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index fb4b73b1c14..aa9521e5a65 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1772,10 +1772,16 @@ byte-compile-docstring-style-warn kind name col)) ;; There's a "naked" ' character before a symbol/list, so it ;; should probably be quoted with \=. - (when (string-match-p "\\( [\"#]\\|[ \t]\\|^\\)'[a-z(]" docs) + (when (string-match-p (rx (| (in " \t") bol) + (? (in "\"#")) + "'" + (in "A-Za-z" "(")) + docs) (byte-compile-warn-x - name "%s%sdocstring has wrong usage of unescaped single quotes (use \\= or different quoting)" - kind name)) + name + (concat "%s%sdocstring has wrong usage of unescaped single quotes" + " (use \\=%c or different quoting such as %c...%c)") + kind name ?' ?` ?')) ;; There's a "Unicode quote" in the string -- it should probably ;; be an ASCII one instead. (when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes) commit 1b52eaa190663756e79f44c02e7388ee53e756b2 Author: Mattias Engdegård Date: Wed Jan 18 17:30:15 2023 +0100 Better lambda quote warning * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Avoid `...` shown backslash-escaped as a symbol, and render an empty argument list as `()` instead of `nil`. diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 069adb3edad..c909ffb6933 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -458,12 +458,13 @@ macroexp--expand-all (let ((arg (nth funarg form))) (when (and (eq 'quote (car-safe arg)) (eq 'lambda (car-safe (cadr arg)))) - (setcar (nthcdr funarg form) - (macroexp-warn-and-return - (format "%S quoted with ' rather than with #'" - (let ((f (cadr arg))) - (if (symbolp f) f `(lambda ,(nth 1 f) ...)))) - arg nil nil (cadr arg)))))) + (setcar + (nthcdr funarg form) + (macroexp-warn-and-return + (format + "(lambda %s ...) quoted with ' rather than with #'" + (or (nth 1 (cadr arg)) "()")) + arg nil nil (cadr arg)))))) ;; Macro expand compiler macros. This cannot be delayed to ;; byte-optimize-form because the output of the compiler-macro can ;; use macros. commit dc3f85fd4b00b4f43d781eb5803a995019a57d57 Author: Jim Porter Date: Tue Jan 17 20:51:15 2023 -0800 Use proper types for Eshell warnings * lisp/eshell/esh-var.el (eshell-get-variable): * lisp/eshell/em-basic (eshell/echo): Don't use ':warning'; that's a warning level, not a warning type. diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el index dfbe4db0896..bfff3bdf56e 100644 --- a/lisp/eshell/em-basic.el +++ b/lisp/eshell/em-basic.el @@ -132,7 +132,8 @@ eshell/echo ;; bug#27361. (when (equal output-newline '(nil)) (display-warning - :warning "To terminate with a newline, you should use -N instead.")) + '(eshell echo) + "To terminate with a newline, you should use -N instead.")) (eshell-echo args output-newline)))) (defun eshell/printnl (&rest args) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index df1413c2de7..dfc52083acb 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -613,9 +613,10 @@ eshell-get-variable (if (or (eq max-arity 'many) (>= max-arity 2)) (funcall target indices quoted) (display-warning - :warning (concat "Function for `eshell-variable-aliases-list' " - "entry should accept two arguments: INDICES " - "and QUOTED.'")) + '(eshell variable-alias) + (concat "Function for `eshell-variable-aliases-list' " + "entry should accept two arguments: INDICES " + "and QUOTED.'")) (funcall target indices))))) ((symbolp target) (eshell-apply-indices (symbol-value target) indices quoted)) commit 6a8338a8bc85d891a42644354925ffb4a93d93a6 Author: Eli Zaretskii Date: Wed Jan 18 17:22:48 2023 +0200 ; Avoid byte-compiler warning in cc-fonts.el. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 405ffb9f1f3..c220d8d8789 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -85,6 +85,8 @@ (cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs only. +(declare-function cl-set-difference "cl-seq" (cl-list1 cl-list2 &rest cl-keys)) + ;; Need to declare these local symbols during compilation since ;; they're referenced from lambdas in `byte-compile' calls that are ;; executed at compile time. They don't need to have the proper commit 9186be20aeb99d157a558a4a437bd41377bcb9b7 Author: Eli Zaretskii Date: Wed Jan 18 16:19:10 2023 +0200 ; Clarify doc strings of some functions in files.el * lisp/files.el (file-name-sans-extension, file-name-extension) (file-name-sans-versions): Doc fixes. (Bug#60929) diff --git a/lisp/files.el b/lisp/files.el index a9a5baf1ba3..0d24852358e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5059,7 +5059,8 @@ file-name-sans-versions redefine it. If the optional argument KEEP-BACKUP-VERSION is non-nil, we do not remove backup version numbers, only true file version numbers. -See also `file-name-version-regexp'." +See `file-name-version-regexp' for what constitutes backup versions +and version strings." (let ((handler (find-file-name-handler name 'file-name-sans-versions))) (if handler (funcall handler 'file-name-sans-versions name keep-backup-version) @@ -5111,9 +5112,12 @@ file-ownership-preserved-p (file-attribute-group-id attributes))))))))))) (defun file-name-sans-extension (filename) - "Return FILENAME sans final \"extension\". + "Return FILENAME sans final \"extension\" and any backup version strings. The extension, in a file name, is the part that begins with the last `.', -except that a leading `.' of the file name, if there is one, doesn't count." +except that a leading `.' of the file name, if there is one, doesn't count. +Any extensions that indicate backup versions and version strings are +removed by calling `file-name-sans-versions', which see, before looking +for the \"real\" file extension." (save-match-data (let ((file (file-name-sans-versions (file-name-nondirectory filename))) directory) @@ -5127,12 +5131,14 @@ file-name-sans-extension filename)))) (defun file-name-extension (filename &optional period) - "Return FILENAME's final \"extension\". + "Return FILENAME's final \"extension\" sans any backup version strings. The extension, in a file name, is the part that begins with the last `.', -excluding version numbers and backup suffixes, except that a leading `.' -of the file name, if there is one, doesn't count. +except that a leading `.' of the file name, if there is one, doesn't count. +This function calls `file-name-sans-versions', which see, to remove from +the extension it returns any parts that indicate backup versions and +version strings. Return nil for extensionless file names such as `foo'. -Return the empty string for file names such as `foo.'. +Return the empty string for file names such as `foo.' that end in a period. By default, the returned value excludes the period that starts the extension, but if the optional argument PERIOD is non-nil, the period commit bd5ef3ef95e989fa7c2c4e9f24851d7e165abbdf Author: Eli Zaretskii Date: Wed Jan 18 16:01:12 2023 +0200 Improve the documentation of 'auto-mode-alist' search * doc/emacs/modes.texi (Choosing Modes): Expand the description of "recursive extension stripping" using 'auto-mode-alist'. (Bug#60930) diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi index d0eacce0842..06f9929092c 100644 --- a/doc/emacs/modes.texi +++ b/doc/emacs/modes.texi @@ -430,10 +430,15 @@ Choosing Modes mode for files whose names end in @file{.c}. (Note that @samp{\\} is needed in Lisp syntax to include a @samp{\} in the string, which must be used to suppress the special meaning of @samp{.} in regexps.) If -the element has the form @code{(@var{regexp} @var{mode-function} -@var{flag})} and @var{flag} is non-@code{nil}, then after calling -@var{mode-function}, Emacs discards the suffix that matched -@var{regexp} and searches the list again for another match. +the element has the form @w{@code{(@var{regexp} @var{mode-function} +@var{flag})}} and @var{flag} is non-@code{nil}, then after calling +@var{mode-function} (if it is non-@code{nil}), Emacs discards the +suffix that matched @var{regexp} and searches the list again for +another match. This ``recursive extension stripping'' is used for +files which have multiple extensions, and the ``outer'' extension +hides the ``inner'' one that actually specifies the right mode. For +example, backup files and GPG-encrypted files with @file{.gpg} +extension use this feature. @vindex auto-mode-case-fold On GNU/Linux and other systems with case-sensitive file names, Emacs commit 1798ff5a6636d6b34d23ab2dadb966e94cc57467 Author: Ikumi Keita Date: Wed Jan 18 14:28:59 2023 +0200 ; Fix minor mistakes in documentation * lisp/emacs-lisp/cl-macs.el (cl-letf): Correct Info reference. * doc/lispref/strings.texi (String Conversion): Fix typo. (Bug#60926) diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index ca18f0a9cc1..3d86a87516b 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -911,8 +911,8 @@ String Conversion @end defun @defun string-to-char string - This function returns the first character in @var{string}. This -mostly identical to @code{(aref string 0)}, except that it returns 0 + This function returns the first character in @var{string}. This is +mostly identical to @w{@code{(aref string 0)}}, except that it returns 0 if the string is empty. (The value is also 0 when the first character of @var{string} is the null character, @acronym{ASCII} code 0.) This function may be eliminated in the future if it does not seem useful diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 685ab99c26e..43207ce7026 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2810,7 +2810,7 @@ cl-letf As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', the PLACE is not modified before executing BODY. -See info node `(cl) Function Bindings' for details. +See info node `(cl) Modify Macros' for details. \(fn ((PLACE VALUE) ...) BODY...)" (declare (indent 1) (debug ((&rest [&or (symbolp form) commit faee7e1f1bd0167e455a0e1e5fe02e21d23fd77f Author: Yuan Fu Date: Tue Jan 17 22:52:22 2023 -0800 ; * lisp/treesit.el (treesit-font-lock-fontify-region): Minor fix. diff --git a/lisp/treesit.el b/lisp/treesit.el index 3dde304eb8b..34d288226fa 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -987,8 +987,7 @@ treesit-font-lock-fontify-region (end-time (current-time))) ;; If for any query the query time is strangely long, ;; switch to fast mode (see comments above). - (when (and (eq 'undecided treesit--font-lock-fast-mode) - (> (time-to-seconds + (when (and (> (time-to-seconds (time-subtract end-time start-time)) 0.01)) (if (> treesit--font-lock-fast-mode-grace-count 0) commit 24f0dfd3731dcbabab0932792462636870b7bcba Author: Yuan Fu Date: Tue Jan 17 22:30:09 2023 -0800 Revert "Revert "Add c-or-c++-ts-mode (bug#59613)"" This reverts commit d46f7f4edcce14e6cbd8e2d7091dbabbe08defc1. Aaaactually, we need this, otherwise we can't use tree-sitter based C mode for header files. diff --git a/etc/NEWS b/etc/NEWS index d1ddd0194c1..95dd4a24ec3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3235,6 +3235,11 @@ programs in the C language. An optional major mode based on the tree-sitter library for editing programs in the C++ language. ++++ +*** New command 'c-or-c++-ts-mode'. +A command that automatically guesses the language of a header file, +and enables either 'c-ts-mode' or 'c++-ts-mode' accordingly. + +++ *** New major mode 'java-ts-mode'. An optional major mode based on the tree-sitter library for editing diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 89a08a6fa9c..f9f75a0e452 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -972,6 +972,50 @@ c++-ts-mode (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'cpp)) (treesit-major-mode-setup))) +;; We could alternatively use parsers, but if this works well, I don't +;; see the need to change. This is copied verbatim from cc-guess.el. +(defconst c-ts-mode--c-or-c++-regexp + (eval-when-compile + (let ((id "[a-zA-Z_][a-zA-Z0-9_]*") (ws "[ \t]+") (ws-maybe "[ \t]*") + (headers '("string" "string_view" "iostream" "map" "unordered_map" + "set" "unordered_set" "vector" "tuple"))) + (concat "^" ws-maybe "\\(?:" + "using" ws "\\(?:namespace" ws + "\\|" id "::" + "\\|" id ws-maybe "=\\)" + "\\|" "\\(?:inline" ws "\\)?namespace" + "\\(:?" ws "\\(?:" id "::\\)*" id "\\)?" ws-maybe "{" + "\\|" "class" ws id + "\\(?:" ws "final" "\\)?" ws-maybe "[:{;\n]" + "\\|" "struct" ws id "\\(?:" ws "final" ws-maybe "[:{\n]" + "\\|" ws-maybe ":\\)" + "\\|" "template" ws-maybe "<.*?>" + "\\|" "#include" ws-maybe "<" (regexp-opt headers) ">" + "\\)"))) + "A regexp applied to C header files to check if they are really C++.") + +;;;###autoload +(defun c-or-c++-ts-mode () + "Analyze buffer and enable either C or C++ mode. + +Some people and projects use .h extension for C++ header files +which is also the one used for C header files. This makes +matching on file name insufficient for detecting major mode that +should be used. + +This function attempts to use file contents to determine whether +the code is C or C++ and based on that chooses whether to enable +`c-ts-mode' or `c++-ts-mode'." + (interactive) + (if (save-excursion + (save-restriction + (save-match-data ; Why `save-match-data'? + (widen) + (goto-char (point-min)) + (re-search-forward c-ts-mode--c-or-c++-regexp nil t)))) + (c++-ts-mode) + (c-ts-mode))) + (provide 'c-ts-mode) ;;; c-ts-mode.el ends here commit ac3bc775b6fd934c972d9e2542f384cdc92d2754 Author: Yuan Fu Date: Tue Jan 17 22:26:21 2023 -0800 Make it harder to misactivate tree-sitter font-lock fast mode This has been brought up in bug#60691 and bug#60223. I proposed a fix by testing the size of the tree rather than measuring the query time. But after some thought, I fear that just looking at the size will give us false-negatives. So I kept the time-based activation, just added a grace count to reduce false-positives. * lisp/treesit.el: (treesit--font-lock-fast-mode-grace-count): New variable. (treesit--font-lock-notifier): Only activate fast mode after 5 offenses. diff --git a/lisp/treesit.el b/lisp/treesit.el index 4c31ecb0d29..3dde304eb8b 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -905,6 +905,14 @@ treesit--font-lock-fast-mode See comments in `treesit-font-lock-fontify-region' for more detail.") +(defvar-local treesit--font-lock-fast-mode-grace-count 5 + "Grace counts before we turn on the fast mode. + +When query takes abnormally long time to execute, we turn on the +\"fast mode\", but just to be on the safe side, we only turn on +the fast mode after this number of offenses. See bug#60691, +bug#60223.") + ;; Some details worth explaining: ;; ;; 1. When we apply face to a node, we clip the face into the @@ -927,13 +935,13 @@ treesit--font-lock-fast-mode ;; parse it into a enormously tall tree (10k levels tall). In that ;; case querying the root node is very slow. So we try to get ;; top-level nodes and query them. This ensures that querying is fast -;; everywhere else, except for the problematic region. +;; everywhere else, except for the problematic region. (Bug#59415). ;; ;; Some other time the source file has a top-level node that contains -;; a huge number of children (say, 10k children), querying that node -;; is also very slow, so instead of getting the top-level node, we -;; recursively go down the tree to find nodes that cover the region -;; but are reasonably small. +;; a huge number of immediate children (say, 10k children), querying +;; that node is also very slow, so instead of getting the top-level +;; node, we recursively go down the tree to find nodes that cover the +;; region but are reasonably small. (Bug#59738). ;; ;; 3. It is possible to capture a node that's completely outside the ;; region between START and END: as long as the whole pattern @@ -941,8 +949,8 @@ treesit--font-lock-fast-mode ;; returned. If the node is outside of that region, (max node-start ;; start) and friends return bad values, so we filter them out. ;; However, we don't filter these nodes out if a function will process -;; the node, because could (and often do) fontify the relatives of the -;; captured node, not just the node itself. If we took out those +;; the node, because it could (and often do) fontify the relatives of +;; the captured node, not just the node itself. If we took out those ;; nodes author of those functions would be very confused. (defun treesit-font-lock-fontify-region (start end &optional loudly) "Fontify the region between START and END. @@ -979,9 +987,13 @@ treesit-font-lock-fontify-region (end-time (current-time))) ;; If for any query the query time is strangely long, ;; switch to fast mode (see comments above). - (when (> (time-to-seconds (time-subtract end-time start-time)) - 0.01) - (setq-local treesit--font-lock-fast-mode t)) + (when (and (eq 'undecided treesit--font-lock-fast-mode) + (> (time-to-seconds + (time-subtract end-time start-time)) + 0.01)) + (if (> treesit--font-lock-fast-mode-grace-count 0) + (cl-decf treesit--font-lock-fast-mode-grace-count) + (setq-local treesit--font-lock-fast-mode t))) ;; For each captured node, fontify that node. (with-silent-modifications commit bdd82fa7977570160523cdce907f1b5d2c786359 Author: Yuan Fu Date: Tue Jan 17 09:37:04 2023 -0800 ; * src/treesit.c: Remove unused boilerplate. These two functions are not used after 7c61a304104. diff --git a/src/treesit.c b/src/treesit.c index 644d323d5cb..917db582676 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -42,8 +42,6 @@ Copyright (C) 2021-2023 Free Software Foundation, Inc. #undef ts_node_end_byte #undef ts_node_eq #undef ts_node_field_name_for_child -#undef ts_node_first_child_for_byte -#undef ts_node_first_named_child_for_byte #undef ts_node_has_error #undef ts_node_is_extra #undef ts_node_is_missing @@ -99,8 +97,6 @@ DEF_DLL_FN (TSNode, ts_node_descendant_for_byte_range, DEF_DLL_FN (uint32_t, ts_node_end_byte, (TSNode)); DEF_DLL_FN (bool, ts_node_eq, (TSNode, TSNode)); DEF_DLL_FN (const char *, ts_node_field_name_for_child, (TSNode, uint32_t)); -DEF_DLL_FN (TSNode, ts_node_first_child_for_byte, (TSNode, uint32_t)); -DEF_DLL_FN (TSNode, ts_node_first_named_child_for_byte, (TSNode, uint32_t)); DEF_DLL_FN (bool, ts_node_has_error, (TSNode)); DEF_DLL_FN (bool, ts_node_is_extra, (TSNode)); DEF_DLL_FN (bool, ts_node_is_missing, (TSNode)); @@ -174,8 +170,6 @@ init_treesit_functions (void) LOAD_DLL_FN (library, ts_node_end_byte); LOAD_DLL_FN (library, ts_node_eq); LOAD_DLL_FN (library, ts_node_field_name_for_child); - LOAD_DLL_FN (library, ts_node_first_child_for_byte); - LOAD_DLL_FN (library, ts_node_first_named_child_for_byte); LOAD_DLL_FN (library, ts_node_has_error); LOAD_DLL_FN (library, ts_node_is_extra); LOAD_DLL_FN (library, ts_node_is_missing); @@ -232,8 +226,6 @@ #define ts_node_descendant_for_byte_range fn_ts_node_descendant_for_byte_range #define ts_node_end_byte fn_ts_node_end_byte #define ts_node_eq fn_ts_node_eq #define ts_node_field_name_for_child fn_ts_node_field_name_for_child -#define ts_node_first_child_for_byte fn_ts_node_first_child_for_byte -#define ts_node_first_named_child_for_byte fn_ts_node_first_named_child_for_byte #define ts_node_has_error fn_ts_node_has_error #define ts_node_is_extra fn_ts_node_is_extra #define ts_node_is_missing fn_ts_node_is_missing commit 343b9b3dfe370a7e65d499b499621f87e722ea71 Author: Dmitry Gutov Date: Wed Jan 18 03:21:32 2023 +0200 ruby-ts-mode: Obey the option ruby-method-call-indent * lisp/progmodes/ruby-ts-mode.el (ruby-ts--method-call-indent-p): New function. (ruby-ts--indent-rules): Use it. * test/lisp/progmodes/ruby-ts-mode-tests.el: Run indent test for ruby-method-call-indent.rb. * test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb: Add explicit value for ruby-method-call-indent. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 7e30ece1fd7..27e5d002881 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -640,6 +640,13 @@ ruby-ts--indent-rules ;; else the second query aligns ;; `ruby-indent-level' spaces in from the parent. ((and ruby-ts--align-chain-p (match "\\." "call")) ruby-ts--align-chain 0) + ;; Obery ruby-method-call-indent, whether the dot is on + ;; this line or the previous line. + ((and (not ruby-ts--method-call-indent-p) + (or + (match "\\." "call") + (query "(call \".\" (identifier) @indent)"))) + parent 0) ((match "\\." "call") parent ruby-indent-level) ;; ruby-indent-after-block-in-continued-expression @@ -797,6 +804,9 @@ ruby-ts--binary-indent-anchor (defun ruby-ts--after-op-indent-p (&rest _) ruby-after-operator-indent) +(defun ruby-ts--method-call-indent-p (&rest _) + ruby-method-call-indent) + (defun ruby-ts--class-or-module-p (node) "Predicate if NODE is a class or module." (string-match-p ruby-ts--class-or-module-regex (treesit-node-type node))) diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb index be98465881f..9959de4fe71 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb @@ -58,5 +58,6 @@ # mode: ruby-ts # ruby-after-operator-indent: t # ruby-block-indent: t +# ruby-method-call-indent: t # ruby-method-params-indent: t # End: diff --git a/test/lisp/progmodes/ruby-ts-mode-tests.el b/test/lisp/progmodes/ruby-ts-mode-tests.el index 1d686a2ac53..1d2cfbfb901 100644 --- a/test/lisp/progmodes/ruby-ts-mode-tests.el +++ b/test/lisp/progmodes/ruby-ts-mode-tests.el @@ -253,6 +253,7 @@ ruby-ts-deftest-indent (ruby-ts-deftest-indent "ruby-ts.rb") (ruby-ts-deftest-indent "ruby-after-operator-indent.rb") (ruby-ts-deftest-indent "ruby-block-indent.rb") +(ruby-ts-deftest-indent "ruby-method-call-indent.rb") (ruby-ts-deftest-indent "ruby-method-params-indent.rb") (provide 'ruby-ts-mode-tests) commit 045404d1aac1a9bd4ad2a3af8db577d7f05b9d03 Author: Dmitry Gutov Date: Wed Jan 18 02:55:09 2023 +0200 ruby-ts-mode: Obey the option ruby-after-operator-indent * lisp/progmodes/ruby-ts-mode.el (ruby-ts--after-op-indent-p): New function. (ruby-ts--indent-rules): Use it. * test/lisp/progmodes/ruby-ts-mode-tests.el: Run indent test for ruby-after-operator-indent.rb. * test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb: Make sure indentation vars are at their default values. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index e629ff19672..7e30ece1fd7 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -685,6 +685,10 @@ ruby-ts--indent-rules ;; Old... probably too simple ((parent-is "block_parameters") first-sibling 1) + ((and (not ruby-ts--after-op-indent-p) + (parent-is "binary\\|conditional")) + (ruby-ts--bol ruby-ts--statement-ancestor) ruby-indent-level) + ((parent-is "binary") ruby-ts--binary-indent-anchor 0) @@ -790,6 +794,9 @@ ruby-ts--binary-indent-anchor (forward-char ruby-indent-level)) (point))) +(defun ruby-ts--after-op-indent-p (&rest _) + ruby-after-operator-indent) + (defun ruby-ts--class-or-module-p (node) "Predicate if NODE is a class or module." (string-match-p ruby-ts--class-or-module-regex (treesit-node-type node))) diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb index 92d62f92e52..be98465881f 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb @@ -56,4 +56,7 @@ # Local Variables: # mode: ruby-ts +# ruby-after-operator-indent: t +# ruby-block-indent: t +# ruby-method-params-indent: t # End: diff --git a/test/lisp/progmodes/ruby-ts-mode-tests.el b/test/lisp/progmodes/ruby-ts-mode-tests.el index d7b6258385b..1d686a2ac53 100644 --- a/test/lisp/progmodes/ruby-ts-mode-tests.el +++ b/test/lisp/progmodes/ruby-ts-mode-tests.el @@ -251,8 +251,9 @@ ruby-ts-deftest-indent (kill-buffer buf))))) (ruby-ts-deftest-indent "ruby-ts.rb") -(ruby-ts-deftest-indent "ruby-method-params-indent.rb") +(ruby-ts-deftest-indent "ruby-after-operator-indent.rb") (ruby-ts-deftest-indent "ruby-block-indent.rb") +(ruby-ts-deftest-indent "ruby-method-params-indent.rb") (provide 'ruby-ts-mode-tests) commit 300ca6ac37250711b7d6484e0a870bf37e9e00cb Author: Dmitry Gutov Date: Wed Jan 18 02:40:00 2023 +0200 ruby-ts-mode: Fix indent after operator or conditional Make it match ruby-mode's indentation behavior. * lisp/progmodes/ruby-ts-mode.el (ruby-ts--binary-indent-anchor): New function. (ruby-ts--indent-rules): Use it instead of a composite matcher. Add a rule for 'conditional'. (ruby-ts--assignment-ancestor, ruby-ts--is-in-condition) (ruby-ts--endless-method): Remove. * test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb: Add examples. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index cbf86544bed..e629ff19672 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -512,10 +512,6 @@ ruby-ts--same-line-hash-array-p (first-child (ruby-ts--first-non-comment-child parent))) (= (ruby-ts--lineno open-brace) (ruby-ts--lineno first-child)))) -(defun ruby-ts--assignment-ancestor (node &rest _) - "Return the assignment ancestor of NODE if any." - (treesit-parent-until node (ruby-ts--type-pred "\\`assignment\\'"))) - (defun ruby-ts--statement-ancestor (node &rest _) "Return the statement ancestor of NODE if any. A statement is defined as a child of a statement container where @@ -531,26 +527,6 @@ ruby-ts--statement-ancestor parent (treesit-node-parent parent))) statement)) -(defun ruby-ts--is-in-condition (node &rest _) - "Return the condition node if NODE is within a condition." - (while (and node - (not (equal "condition" (treesit-node-field-name node))) - (not (string-match-p ruby-ts--statement-container-regexp - (treesit-node-type node)))) - (setq node (treesit-node-parent node))) - (and (equal "condition" (treesit-node-field-name node)) node)) - -(defun ruby-ts--endless-method (node &rest _) - "Return the expression node if NODE is in an endless method. -i.e. expr of def foo(args) = expr is returned." - (let* ((method node)) - (while (and method - (not (string-match-p ruby-ts--method-regex (treesit-node-type method)))) - (setq method (treesit-node-parent method))) - (when method - (if (equal "=" (treesit-node-type (treesit-node-child method 3 nil))) - (treesit-node-child method 4 nil))))) - ;; ;; end of functions that can be used for queries ;; @@ -709,11 +685,10 @@ ruby-ts--indent-rules ;; Old... probably too simple ((parent-is "block_parameters") first-sibling 1) - ((and (parent-is "binary") - (or ruby-ts--assignment-ancestor - ruby-ts--is-in-condition - ruby-ts--endless-method)) - first-sibling 0) + ((parent-is "binary") + ruby-ts--binary-indent-anchor 0) + + ((parent-is "conditional") parent ruby-indent-level) ;; ruby-mode does not touch these... ((match "bare_string" "string_array") no-indent 0) @@ -807,6 +782,14 @@ ruby-ts--block-indent-anchor (back-to-indentation) (point))))) +(defun ruby-ts--binary-indent-anchor (_node parent _bol &rest _) + (save-excursion + (goto-char (treesit-node-start parent)) + (when (string-match-p ruby-ts--statement-container-regexp + (treesit-node-type (treesit-node-parent parent))) + (forward-char ruby-indent-level)) + (point))) + (defun ruby-ts--class-or-module-p (node) "Predicate if NODE is a class or module." (string-match-p ruby-ts--class-or-module-regex (treesit-node-type node))) diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb index 1a07ababc46..92d62f92e52 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb @@ -41,6 +41,19 @@ 2 ) +foo > bar && + tee < qux + +1 .. 2 && + 3 + +a = foo(j, k) - + bar_tee + +qux = foo.fee ? + bar : + tee + # Local Variables: # mode: ruby-ts # End: commit ac5516bd7d568bbcea4fe46273d4f44c891a71ae Author: Dmitry Gutov Date: Wed Jan 18 00:55:09 2023 +0200 ruby-ts-mode: Fix/change indentation of a continuation method call * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules): Fix/change indentation of a continuation method call. * test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb: New examples. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 853c869a319..cbf86544bed 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -697,9 +697,9 @@ ruby-ts--indent-rules ;; 2) With paren, 1st arg on next line ((and (query "(argument_list \"(\" _ @indent)") (node-is ")")) - (ruby-ts--bol ruby-ts--grand-parent-node) 0) + parent-bol 0) ((query "(argument_list \"(\" _ @indent)") - (ruby-ts--bol ruby-ts--grand-parent-node) ruby-indent-level) + parent-bol ruby-indent-level) ;; 3) No paren, ruby-parenless-call-arguments-indent is t ((and ruby-ts--parenless-call-arguments-indent-p (parent-is "argument_list")) first-sibling 0) diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb index 7de94ceadec..1a07ababc46 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb @@ -28,6 +28,19 @@ dog = 99 end +foo1 = + subject.update( + 1 + ) + +foo2 = + subject. + update( + # Might make sense to indent this to 'subject' instead; but this + # style seems more popular. + 2 + ) + # Local Variables: # mode: ruby-ts # End: commit 5e2e68a0c2d7d4e06747ea9fc6112dae8d5e32b6 Author: Dmitry Gutov Date: Wed Jan 18 00:41:14 2023 +0200 ruby-ts-mode: Fix indent inside parenthesized_expr and else/end after unless * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules): Fix indentation for parenthesized_expression and else/end after 'unless'. * test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb: New examples. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 19b766ceadb..853c869a319 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -587,11 +587,11 @@ ruby-ts--indent-rules ;; ;; I'm using very restrictive patterns hoping to reduce rules ;; triggering unintentionally. - ((match "else" "if") + ((match "else" "if\\|unless") (ruby-ts--align-keywords ruby-ts--parent-node) 0) ((match "elsif" "if") (ruby-ts--align-keywords ruby-ts--parent-node) 0) - ((match "end" "if") + ((match "end" "if\\|unless") (ruby-ts--align-keywords ruby-ts--parent-node) 0) ((n-p-gp nil "then\\|else\\|elsif" "if\\|unless") (ruby-ts--align-keywords ruby-ts--grand-parent-node) ruby-indent-level) @@ -754,6 +754,9 @@ ruby-ts--indent-rules ((match "]" "array") parent-bol 0) ((parent-is "array") parent-bol ruby-indent-level) + ((match ")" "parenthesized_statements") parent-bol 0) + ((parent-is "parenthesized_statements") parent-bol ruby-indent-level) + ;; If the previous method isn't finished yet, this will get ;; the next method indented properly. ((n-p-gp ,ruby-ts--method-regex "body_statement" ,ruby-ts--class-or-module-regex) diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb index 6b4107ef97b..7de94ceadec 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb @@ -18,6 +18,16 @@ att = {a: 1, b: 2} +a = 1 ? 2 :( + 2 + 3 +) + +unless bismark + sink += 12 +else + dog = 99 +end + # Local Variables: # mode: ruby-ts # End: commit 9ed9ff4690a8b26ac9729a66aa22f2e14856cd0c Author: Dmitry Gutov Date: Tue Jan 17 23:46:41 2023 +0200 ruby-ts-mode: Fix the rules for hanging arrays and hashes * lisp/progmodes/ruby-ts-mode.el (ruby-ts--indent-rules): Fix the rules for hanging arrays and hashes (to line up to parent-bol instead of the opening brace). * test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb: New file with examples. * test/lisp/progmodes/ruby-ts-mode-tests.el: Use it here. diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 939c054b041..19b766ceadb 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -749,20 +749,10 @@ ruby-ts--indent-rules (not ruby-ts--same-line-hash-array-p)) grand-parent ruby-indent-level) - ((n-p-gp "}" "hash" "assignment") (ruby-ts--bol ruby-ts--grand-parent-node) 0) - ((n-p-gp nil "hash" "assignment") (ruby-ts--bol ruby-ts--grand-parent-node) ruby-indent-level) - ((n-p-gp "]" "array" "assignment") (ruby-ts--bol ruby-ts--grand-parent-node) 0) - ((n-p-gp nil "array" "assignment") (ruby-ts--bol ruby-ts--grand-parent-node) ruby-indent-level) - - ((n-p-gp "}" "hash" "argument_list") first-sibling 0) - ((n-p-gp nil "hash" "argument_list") first-sibling ruby-indent-level) - ((n-p-gp "]" "array" "argument_list") first-sibling 0) - ((n-p-gp nil "array" "argument_list") first-sibling ruby-indent-level) - - ((match "}" "hash") first-sibling 0) - ((parent-is "hash") first-sibling ruby-indent-level) - ((match "]" "array") first-sibling 0) - ((parent-is "array") first-sibling ruby-indent-level) + ((match "}" "hash") parent-bol 0) + ((parent-is "hash") parent-bol ruby-indent-level) + ((match "]" "array") parent-bol 0) + ((parent-is "array") parent-bol ruby-indent-level) ;; If the previous method isn't finished yet, this will get ;; the next method indented properly. diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb new file mode 100644 index 00000000000..6b4107ef97b --- /dev/null +++ b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb @@ -0,0 +1,23 @@ +variable = foo( + [ + qwe + ], [ + rty + ], { + a: 3 + } +) + +tee = [ + qwe +] + +qux = [1, + 2] + +att = {a: 1, + b: 2} + +# Local Variables: +# mode: ruby-ts +# End: diff --git a/test/lisp/progmodes/ruby-ts-mode-tests.el b/test/lisp/progmodes/ruby-ts-mode-tests.el index eaf6367a306..d7b6258385b 100644 --- a/test/lisp/progmodes/ruby-ts-mode-tests.el +++ b/test/lisp/progmodes/ruby-ts-mode-tests.el @@ -250,6 +250,7 @@ ruby-ts-deftest-indent (should (equal (buffer-string) orig)))) (kill-buffer buf))))) +(ruby-ts-deftest-indent "ruby-ts.rb") (ruby-ts-deftest-indent "ruby-method-params-indent.rb") (ruby-ts-deftest-indent "ruby-block-indent.rb") commit c4f0b6ccea128d52a7b4a9ddc1e81dcf13bb25ea Author: Jim Porter Date: Sun Jan 15 18:35:31 2023 -0800 Add more detail about how to invoke Eshell commands * doc/misc/eshell.texi (Variables): Move footnote explaining "REPL" from here... (Top): ... to its first use here. (Commands): Move explanation about kernel functions to here. (Invocation): Describe command form and Lisp form. Fix documentation about priority of commands in command form. (Arguments): Add a cross reference to the Invocation node. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 4ad1c3f74f6..1789cded9d3 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -64,10 +64,11 @@ Top Eshell is a shell-like command interpreter implemented in Emacs Lisp. It invokes no external processes except for those requested by the -user. It is intended to be an alternative to the IELM (@pxref{Lisp Interaction, Emacs Lisp Interaction, , emacs, The Emacs Editor}) -REPL for Emacs @emph{and} with an interface similar to command shells -such as @command{bash}, @command{zsh}, @command{rc}, or -@command{4dos}. +user. It is intended to be an alternative to the IELM (@pxref{Lisp +Interaction, Emacs Lisp Interaction, , emacs, The Emacs Editor}) +REPL@footnote{Short for ``Read-Eval-Print Loop''.} for Emacs +@emph{and} with an interface similar to command shells such as +@command{bash}, @command{zsh}, @command{rc}, or @command{4dos}. @c This manual is updated to release 2.4 of Eshell. @insertcopying @@ -193,6 +194,13 @@ Commands chapter covers command invocations in Eshell, including the command history and invoking commands in a script file. +Unlike regular system shells, Eshell never invokes kernel functions +directly, such as @code{exec(3)}. Instead, it uses the Lisp functions +available in the Emacs Lisp library. It does this by transforming the +input line into a callable Lisp form.@footnote{To see the Lisp form +that will be invoked, type this as the Eshell prompt: +@kbd{eshell-parse-command 'echo hello'}} + @menu * Invocation:: * Arguments:: @@ -207,23 +215,16 @@ Commands @node Invocation @section Invocation -Unlike regular system shells, Eshell never invokes kernel functions -directly, such as @code{exec(3)}. Instead, it uses the Lisp functions -available in the Emacs Lisp library. It does this by transforming the -input line into a callable Lisp form.@footnote{To see the Lisp form that will be invoked, type: @samp{eshell-parse-command "echo hello"}} +Eshell is both a command shell and an Emacs Lisp @acronym{REPL}. As a +result, you can invoke commands in two different ways: in @dfn{command +form} or in @dfn{lisp form}. -The command can be either an Elisp function or an external command. -Eshell looks first for an alias (@pxref{Aliases}) with the same name as the -command, then a built-in (@pxref{Built-ins}) or a function with the -same name; if there is no match, it then tries to execute it as an -external command. - -The semicolon (@code{;}) can be used to separate multiple command -invocations on a single line. You can also separate commands with -@code{&&} or @code{||}. When using @code{&&}, Eshell will execute the -second command only if the first succeeds (i.e.@: has an exit -status of 0); with @code{||}, Eshell will execute the second command -only if the first fails. +You can use the semicolon (@code{;}) to separate multiple command +invocations on a single line, executing each in turn. You can also +separate commands with @code{&&} or @code{||}. When using @code{&&}, +Eshell will execute the second command only if the first succeeds +(i.e.@: has an exit status of 0); with @code{||}, Eshell will execute +the second command only if the first fails. A command invocation followed by an ampersand (@code{&}) will be run in the background. Eshell has no job control, so you can not suspend @@ -232,12 +233,80 @@ Invocation can be controlled the same way as any other background process in Emacs. +@subsection Command form +Command form looks much the same as in other shells. A command +consists of arguments separated by spaces; the first argument is the +command to run, with any subsequent arguments being passed to that +command. + +@example +~ $ echo hello +hello +@end example + +@cindex order of looking for commands +@cindex command lookup order +The command can be either an Elisp function or an external command. +Eshell looks for the command in the following order: + +@enumerate +@item +As a command alias (@pxref{Aliases}) + +@item +As a built-in command (@pxref{Built-ins}) + +@item +As an external program + +@item +As an ordinary Lisp function +@end enumerate + +@vindex eshell-prefer-lisp-functions +If you would prefer to use ordinary Lisp functions over external +programs, set the option @code{eshell-prefer-lisp-functions} to +@code{t}. This will swap the lookup order of the last two items. + +You can also group command forms together into a subcommand with curly +braces (@code{@{@}}). This lets you use the output of a subcommand as +an argument to another command, or within control flow statements +(@pxref{Control Flow}). + +@example +~ $ echo @{echo hello; echo there@} +hellothere +@end example + +@subsection Lisp form +Lisp form looks like ordinary Emacs Lisp code, because that's what it +is. As a result, you can use any syntax normally available to an +Emacs Lisp program (@pxref{Top, , , elisp, The Emacs Lisp Reference +Manual}). + +@example +~ $ (format "hello, %s" user-login-name) +hello, user +@end example + +In addition, you can @emph{combine} command forms and Lisp forms +together into single statements, letting you use whatever form is the +most convenient for expressing your intentions. + +@example +~ $ ls *.patch > (format-time-string "%F.log") +@end example + +This command writes a list of all files matching the glob pattern +@code{*.patch} (@pxref{Globbing}) to a file named +@code{@var{current-date}.log} (@pxref{Redirection}). + @node Arguments @section Arguments -Ordinarily, command arguments are parsed by Eshell as either strings +Ordinarily, Eshell parses arguments in command form as either strings or numbers, depending on what the parser thinks they look like. To -specify an argument of some other data type, you can use an -@ref{Dollars Expansion, Elisp expression}: +specify an argument of some other data type, you can use a Lisp form +(@pxref{Invocation}): @example ~ $ echo (list 1 2 3) @@ -354,10 +423,6 @@ Built-ins sudo is an alias, defined as "*sudo $*" @end example -@vindex eshell-prefer-lisp-functions -If you would prefer to use the built-in commands instead of the external -commands, set @code{eshell-prefer-lisp-functions} to @code{t}. - Some of the built-in commands have different behavior from their external counterparts, and some have no external counterpart. Most of these will print a usage message when given the @code{--help} option. @@ -923,15 +988,14 @@ Built-ins @node Variables @section Variables @vindex eshell-prefer-lisp-variables -Since Eshell is a combination of an Emacs @acronym{REPL}@footnote{ -Short for ``Read-Eval-Print Loop''. -} and a command shell, it can refer to variables from two different -sources: ordinary Emacs Lisp variables, as well as environment -variables. By default, when using a variable in Eshell, it will first -look in the list of built-in variables, then in the list of -environment variables, and finally in the list of Lisp variables. If -you would prefer to use Lisp variables over environment variables, you -can set @code{eshell-prefer-lisp-variables} to @code{t}. +Since Eshell is a combination of an Emacs @acronym{REPL} and a command +shell, it can refer to variables from two different sources: ordinary +Emacs Lisp variables, as well as environment variables. By default, +when using a variable in Eshell, it will first look in the list of +built-in variables, then in the list of environment variables, and +finally in the list of Lisp variables. If you would prefer to use +Lisp variables over environment variables, you can set +@code{eshell-prefer-lisp-variables} to @code{t}. You can set variables in a few different ways. To set a Lisp variable, you can use the command @samp{setq @var{name} @var{value}}, commit dbac923b9df97706d3944c21edfc9117b408d80c Author: Alan Mackenzie Date: Tue Jan 17 18:15:45 2023 +0000 CC Mode: On removal of "typedef", remove pertinent types from c-found-types For this purpose, record the type names declared by typedef in a text property, c-typedef, on the typedef. On any change to that "typedef" or a type, remove the old identifier(s) from c-found-types. This should fix bug #59671. * lisp/progmodes/cc-defs.el (c-search-forward-non-nil-char-property): New macro. * lisp/progmodes/cc-engine.el (c-forward-decl-or-cast-1): Move the scope of identifier-start from the "inner" let form to the outer one. Amend the return value such that the middle element of the second element is now the position of the "typedef", not merely non-nil. * lisp/progmodes/cc-fonts.el (c-font-lock-declarators): Disregard the LIMIT parameter when fontifying the declarators of a typedef construct. Also in this case, set the c-typedef text property on the "typedef" to the list of declared types. Amend this list when these declared types change. (c-font-lock-single-decl): Massage the `types' argument given to c-font-lock-declarators. (c-font-lock-cut-off-declarators): Amend to work when the starting point of the fontification is inside a brace block. * lisp/progmodes/cc-mode.el (c-before-change-de-typedef) (c-after-change-de-typedef): New functions. (c-update-new-id): Replace the erroneous c-end-of-current-token with a clause containing c-forward-token-2. (c-before-change): Call c-before-change-de-typedef. (c-after-change): Call c-after-change-de-typedef. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 493035d38b4..bdbc03e7c94 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1361,6 +1361,28 @@ c-search-forward-char-property (search-forward-regexp "\\(\n\\|.\\)") ; to set the match-data. (point)))) +(defmacro c-search-forward-non-nil-char-property (property &optional limit) + "Search forward for a text-property PROPERTY value non-nil. +LIMIT bounds the search. + +Leave point just after the character. The match data remain +unchanged. Return the value of PROPERTY. If a non-nil value +isn't found, return nil; point is then left undefined." + (declare (debug t)) + `(let* ((-limit- (or ,limit (point-max))) + (value (c-get-char-property (point) ,property))) + (cond + ((>= (point) -limit-) + nil) + (value + (forward-char) + value) + (t (let ((place (c-next-single-property-change + (point) ,property nil -limit-))) + (when place + (goto-char (1+ place)) + (c-get-char-property place ,property))))))) + (defmacro c-search-backward-char-property (property value &optional limit) "Search backward for a text-property PROPERTY having value VALUE. LIMIT bounds the search. The comparison is done with `equal'. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 45d90ea2431..3fa407dd338 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -142,6 +142,10 @@ ;; Put on the brace which introduces a brace list and on the commas ;; which separate the elements within it. ;; +;; 'c-typedef This property is applied to the first character of a +;; "typedef" keyword. It's value is a list of the identifiers that +;; the "typedef" declares as types. +;; ;; 'c-<>-c-types-set ;; This property is set on an opening angle bracket, and indicates that ;; any "," separators within the template/generic expression have been @@ -10024,10 +10028,10 @@ c-fdoc-shift-type-backward ;; an identifier instead. (declare (debug nil)) `(progn + (setq identifier-start type-start) ,(unless short ;; These identifiers are bound only in the inner let. '(setq identifier-type at-type - identifier-start type-start got-parens nil got-identifier t got-suffix t @@ -10102,10 +10106,11 @@ c-forward-decl-or-cast-1 ;; The second element of the return value is non-nil when something ;; indicating the identifier is a type occurs in the declaration. ;; Specifically it is nil, or a three element list (A B C) where C is t - ;; when context is '<> and the "identifier" is a found type, B is t when a - ;; `c-typedef-kwds' ("typedef") is present, and A is t when some other - ;; `c-typedef-decl-kwds' (e.g. class, struct, enum) specifier is present. - ;; I.e., (some of) the declared identifier(s) are types. + ;; when context is '<> and the "identifier" is a found type, B is the + ;; position of the `c-typedef-kwds' keyword ("typedef") when such is + ;; present, and A is t when some other `c-typedef-decl-kwds' (e.g. class, + ;; struct, enum) specifier is present. I.e., (some of) the declared + ;; identifier(s) are types. ;; ;; The third element of the return value is non-nil when the declaration ;; parsed might be an expression. The fourth element is the position of @@ -10173,6 +10178,9 @@ c-forward-decl-or-cast-1 ;; `c-decl-hangon-kwds' and their associated clauses that ;; occurs after the type. id-start + ;; The earlier value of `type-start' if we've shifted the type + ;; backwards. + identifier-start ;; These store `at-type', `type-start' and `id-start' of the ;; identifier before the one in those variables. The previous ;; identifier might turn out to be the real type in a @@ -10183,7 +10191,8 @@ c-forward-decl-or-cast-1 ;; Set if we've found a specifier (apart from "typedef") that makes ;; the defined identifier(s) types. at-type-decl - ;; Set if we've a "typedef" keyword. + ;; If we've a "typedef" keyword (?or similar), the buffer position of + ;; its first character. at-typedef ;; Set if `context' is '<> and the identifier is definitely a type, or ;; has already been recorded as a found type. @@ -10266,7 +10275,7 @@ c-forward-decl-or-cast-1 (looking-at "@[A-Za-z0-9]+"))) (save-match-data (if (looking-at c-typedef-key) - (setq at-typedef t))) + (setq at-typedef (point)))) (setq kwd-sym (c-keyword-sym (match-string 1))) (save-excursion (c-forward-keyword-clause 1) @@ -10486,9 +10495,9 @@ c-forward-decl-or-cast-1 ;; True if we've parsed the type decl to a token that is ;; known to end declarations in this context. at-decl-end - ;; The earlier values of `at-type' and `type-start' if we've - ;; shifted the type backwards. - identifier-type identifier-start + ;; The earlier value of `at-type' if we've shifted the type + ;; backwards. + identifier-type ;; If `c-parse-and-markup-<>-arglists' is set we need to ;; turn it off during the name skipping below to avoid ;; getting `c-type' properties that might be bogus. That @@ -10530,6 +10539,10 @@ c-forward-decl-or-cast-1 (progn (setq got-identifier nil) t) ;; It turned out to be the real identifier, ;; so stop. + (save-excursion + (c-backward-syntactic-ws) + (c-simple-skip-symbol-backward) + (setq identifier-start (point))) nil)) t)) @@ -10555,6 +10568,10 @@ c-forward-decl-or-cast-1 (and (looking-at c-identifier-start) (setq pos (point)) (setq got-identifier (c-forward-name)) + (save-excursion + (c-backward-syntactic-ws) + (c-simple-skip-symbol-backward) + (setq identifier-start (point))) (setq name-start pos)) (when (looking-at "[0-9]") (setq got-number t)) ; We probably have an arithmetic expression. @@ -10573,7 +10590,8 @@ c-forward-decl-or-cast-1 (setq at-type nil name-start type-start id-start type-start - got-identifier t))) + got-identifier t) + (setq identifier-start type-start))) ;; Skip over type decl suffix operators and trailing noise macros. (while diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 4dcc3e0ade9..405ffb9f1f3 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1109,10 +1109,12 @@ c-font-lock-declarators ;; additionally, mark the commas with c-type property 'c-decl-id-start or ;; 'c-decl-type-start (according to TYPES). Stop at LIMIT. ;; - ;; If TYPES is t, fontify all identifiers as types, if it is nil fontify as - ;; either variables or functions, otherwise TYPES is a face to use. If - ;; NOT-TOP is non-nil, we are not at the top-level ("top-level" includes - ;; being directly inside a class or namespace, etc.). + ;; If TYPES is t, fontify all identifiers as types; if it is a number, a + ;; buffer position, additionally set the `c-deftype' text property on the + ;; keyword at that position; if it is nil fontify as either variables or + ;; functions, otherwise TYPES is a face to use. If NOT-TOP is non-nil, we + ;; are not at the top-level ("top-level" includes being directly inside a + ;; class or namespace, etc.). ;; ;; TEMPLATE-CLASS is non-nil when the declaration is in template delimiters ;; and was introduced by, e.g. "typename" or "class", such that if there is @@ -1129,17 +1131,28 @@ c-font-lock-declarators ;;(message "c-font-lock-declarators from %s to %s" (point) limit) (c-fontify-types-and-refs () + ;; If we're altering the declarators in a typedef, we need to scan ALL of + ;; them because of the way we check for changes. + (let ((c-do-decl-limit (if (numberp types) (point-max) limit)) + decl-ids) (c-do-declarators - limit list not-top - (cond ((eq types t) 'c-decl-type-start) + c-do-decl-limit + list not-top + (cond ((or (numberp types) + (eq types t)) + 'c-decl-type-start) ((null types) 'c-decl-id-start)) (lambda (id-start id-end end-pos _not-top is-function init-char) - (if (eq types t) + (if (or (numberp types) + (eq types t)) (when id-start ;; Register and fontify the identifier as a type. (let ((c-promote-possible-types t)) (goto-char id-start) - (c-forward-type))) + (c-forward-type)) + (when (numberp types) + (push (buffer-substring-no-properties id-start id-end) + decl-ids))) (when id-start (goto-char id-start) (when c-opt-identifier-prefix-key @@ -1147,7 +1160,7 @@ c-font-lock-declarators (eq (match-end 1) id-end)) (while (and (< (point) id-end) (re-search-forward c-opt-identifier-prefix-key id-end t)) - (c-forward-syntactic-ws limit)))) + (c-forward-syntactic-ws c-do-decl-limit)))) ;; Only apply the face when the text doesn't have one yet. ;; Exception: The "" in C++'s operator"" will already wrongly have ;; string face. @@ -1164,7 +1177,7 @@ c-font-lock-declarators (equal (buffer-substring-no-properties id-start id-end) "\"\"")) (goto-char id-end) - (c-forward-syntactic-ws limit) + (c-forward-syntactic-ws c-do-decl-limit) (when (c-on-identifier) (c-put-font-lock-face (point) @@ -1174,10 +1187,21 @@ c-font-lock-declarators (eq init-char ?=) ; C++ ""? (progn (goto-char end-pos) - (c-forward-token-2 1 nil limit) ; Over "=" + (c-forward-token-2 1 nil c-do-decl-limit) ; Over "=" (let ((c-promote-possible-types t)) (c-forward-type t))))) accept-anon) ; Last argument to c-do-declarators. + ;; If we've changed types declared by a "typedef", update the `c-typedef' + ;; text property. + (when (numberp types) + (let* ((old-decl-ids (c-get-char-property types 'c-typedef)) + (old-types (c--set-difference old-decl-ids decl-ids :test #'equal)) + (new-types (c--set-difference decl-ids old-decl-ids :test #'equal))) + (dolist (type old-types) + (c-unfind-type type)) + ;; The new types have already been added to `c-found-types', as needed. + (when (or old-types new-types) + (c-put-char-property types 'c-typedef decl-ids))))) nil)) (defun c-get-fontification-context (match-pos not-front-decl &optional toplev) @@ -1433,7 +1457,10 @@ c-font-lock-single-decl (c-font-lock-declarators (min limit (point-max)) decl-list - (not (null (cadr decl-or-cast))) + (cond ((null (cadr decl-or-cast)) + nil) + ((cadr (cadr decl-or-cast))) + (t t)) (not toplev) template-class (memq context '(decl <>)))) @@ -1749,12 +1776,21 @@ c-font-lock-cut-off-declarators ; speeds up lisp.h tremendously. (save-excursion (when (not (c-back-over-member-initializers decl-search-lim)) + (setq paren-state (c-parse-state)) (unless (or (eobp) (looking-at "\\s(\\|\\s)")) (forward-char)) (c-syntactic-skip-backward "^;{}" decl-search-lim t) - (when (eq (char-before) ?}) - (c-go-list-backward) ; brace block of struct, etc.? + ;; Do we have the brace block of a struct, etc.? + (when (cond + ((and (consp (car paren-state)) + (eq (char-before) ?})) + (goto-char (caar paren-state)) + t) + ((and (numberp (car paren-state)) + (eq (char-after (car paren-state)) ?{)) + (goto-char (car paren-state)) + t)) (c-syntactic-skip-backward "^;{}" decl-search-lim t)) (when (or (bobp) (memq (char-before) '(?\; ?{ ?}))) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index b04ed7584c4..330202bb5f9 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2077,6 +2077,37 @@ c-after-change-fix-comment-escapes (not (eobp)))) (forward-char)))))) +(defun c-before-change-de-typedef (beg end) + ;; For each "typedef" starting in (BEG END), remove the defined types from + ;; c-found-types + (let (prop) + (save-excursion + (goto-char beg) + (while (and (< (point) end) + (setq prop (c-search-forward-non-nil-char-property + 'c-typedef))) + (dolist (type prop) + (c-unfind-type type)))))) + +(defun c-after-change-de-typedef (beg end _old-len) + ;; For each former "typedef" in (BEG END), remove the defined types from + ;; those which are no longer typedefs. + (let (prop) + (save-excursion + (goto-char beg) + (c-backward-token-2 + 1 nil (- (point) 20)) + (while (and (< (point) end) + (setq prop (c-search-forward-non-nil-char-property + 'c-typedef end))) + (backward-char) + (when (or (not (looking-at c-typedef-key)) + (<= (match-end 1) beg)) + (dolist (type prop) + (c-unfind-type type)) + (c-clear-char-property (point) 'c-typedef)) + (forward-char))))) + (defun c-update-new-id (end) ;; Note the bounds of any identifier that END is in or just after, in ;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to @@ -2086,7 +2117,9 @@ c-update-new-id (let ((id-beg (c-on-identifier))) (setq c-new-id-start id-beg c-new-id-end (and id-beg - (progn (c-end-of-current-token) (point))) + (progn (goto-char id-beg) + (c-forward-token-2) + (point))) c-new-id-is-type nil)))) (defun c-post-command () @@ -2215,6 +2248,10 @@ c-before-change term-pos) (buffer-substring-no-properties beg end))))))) + ;; If we're about to delete "typedef"s, clear the identifiers from + ;; `c-found-types'. + (c-before-change-de-typedef beg end) + (if c-get-state-before-change-functions (mapc (lambda (fn) (funcall fn beg end)) @@ -2306,6 +2343,7 @@ c-after-change (c-update-new-id end) (c-trim-found-types beg end old-len) ; maybe we don't ; need all of these. + (c-after-change-de-typedef beg end old-len) (c-invalidate-sws-region-after beg end old-len) ;; (c-invalidate-state-cache beg) ; moved to ;; `c-before-change'. commit 56d69c2fc4782dc23bd79ddcbccfbae9b263ecac Author: F. Jason Park Date: Tue Jan 17 06:26:34 2023 -0800 ; Relax timeouts for failing ERC test * test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld: Bump timeouts to 10 seconds. * test/lisp/erc/resources/base/netid/bouncer/foonet-again.eld: Bump timeouts to 10 seconds. diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld b/test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld index e2fe1430283..a270c743d90 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld @@ -1,7 +1,7 @@ ;; -*- mode: lisp-data; -*- ((pass 10 "PASS :barnet:changeme")) -((nick 3 "NICK tester")) -((user 3 "USER user 0 * :tester") +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") (0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester") (0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version oragono-2.6.0-7481bf0385b95b16") (0 ":irc.barnet.org 003 tester :This server was created Wed, 12 May 2021 07:41:08 UTC") @@ -17,7 +17,7 @@ (0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3") (0 ":irc.barnet.org 422 tester :MOTD File is missing")) -((mode-user 10.2 "MODE tester +i") +((mode-user 10 "MODE tester +i") ;; No mode answer ^ (0 ":tester!~u@xrir8fpe4d7ak.irc JOIN #chan") @@ -36,9 +36,9 @@ (0 ":irc.znc.in 306 tester :You have been marked as being away") (0 ":irc.barnet.org 305 tester :You are no longer marked as being away")) -((~join 3 "JOIN #chan")) +((~join 10 "JOIN #chan")) -((mode 5 "MODE #chan") +((mode 10 "MODE #chan") (0 ":irc.barnet.org 324 tester #chan +nt") (0 ":irc.barnet.org 329 tester #chan 1620805269") (0.1 ":joe!~u@svpn88yjcdj42.irc PRIVMSG #chan :mike: But, in defense, by mercy, 'tis most just.") diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet-again.eld b/test/lisp/erc/resources/base/netid/bouncer/foonet-again.eld index bf8712305a4..a8c352daaa7 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/foonet-again.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/foonet-again.eld @@ -1,7 +1,7 @@ ;; -*- mode: lisp-data; -*- ((pass 10 "PASS :foonet:changeme")) -((nick 3 "NICK tester")) -((user 3 "USER user 0 * :tester") +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.0-7481bf0385b95b16") (0 ":irc.foonet.org 003 tester :This server was created Wed, 12 May 2021 07:41:09 UTC") @@ -17,7 +17,7 @@ (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") (0 ":irc.foonet.org 422 tester :MOTD File is missing")) -((mode-user 10.2 "MODE tester +i") +((mode-user 10 "MODE tester +i") ;; No mode answer ^ (0 ":tester!~u@nvfhxvqm92rm6.irc JOIN #chan") (0 ":irc.foonet.org 353 tester = #chan :alice @bob tester") @@ -36,9 +36,9 @@ (0 ":irc.foonet.org NOTICE tester :[07:00:32] 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.") (0 ":irc.foonet.org 305 tester :You are no longer marked as being away")) -((~join 3 "JOIN #chan")) +((~join 10 "JOIN #chan")) -((mode 8 "MODE #chan") +((mode 10 "MODE #chan") (0 ":irc.foonet.org 324 tester #chan +nt") (0 ":irc.foonet.org 329 tester #chan 1620805271") (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :bob: Grows, lives, and dies, in single blessedness.") commit 183e749270208ad7f63114ea8ab05e7612a645a1 Author: F. Jason Park Date: Fri Jan 13 06:03:15 2023 -0800 Don't preserve non-module minor modes in erc-open * lisp/erc/erc-common.el (define-erc-module): Add symbol property `erc-module' to minor modes defined as part of a module. * lisp/erc/erc.el (erc--merge-local-modes): Be more conservative when persisting local minor-mode state across ERC sessions. User and third-party modes that were not defined via `define-erc-modules' should be left alone. (erc-open): Run major-mode hooks and enable minor modes after prompt has been set up. This ensures that module-setup code can access a fully initialized `erc-input-marker'. * test/lisp/erc/erc-tests.el (erc--merge-local-modes): Add mocks for `erc-module' symbol property and a test case covering some foreign ERC mode. (define-erc-module--global, define-erc-module--local): Expect the `erc-module' symbol property to be defined for mode symbols and aliases. (Bug#60784.) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 9eb4f1a9000..994555acecf 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -202,12 +202,13 @@ define-erc-module (,disable))) ,(erc--assemble-toggle local-p name enable mode t enable-body) ,(erc--assemble-toggle local-p name disable mode nil disable-body) - ,(when (and alias (not (eq name alias))) - `(defalias - ',(intern - (format "erc-%s-mode" - (downcase (symbol-name alias)))) - #',mode)) + ,@(and-let* ((alias) + ((not (eq name alias))) + (aname (intern (format "erc-%s-mode" + (downcase (symbol-name alias)))))) + `((defalias ',aname #',mode) + (put ',aname 'erc-module ',(erc--normalize-module-symbol name)))) + (put ',mode 'erc-module ',(erc--normalize-module-symbol name)) ;; For find-function and find-variable. (put ',mode 'definition-name ',name) (put ',enable 'definition-name ',name) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e7f81f24ac4..7f51b7bfb2e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1958,7 +1958,8 @@ erc--merge-local-modes (let ((out (list (reverse new-modes)))) (pcase-dolist (`(,k . ,v) old-vars) (when (and (string-prefix-p "erc-" (symbol-name k)) - (string-suffix-p "-mode" (symbol-name k))) + (string-suffix-p "-mode" (symbol-name k)) + (get k 'erc-module)) (if v (cl-pushnew k (car out)) (setf (car out) (delq k (car out))) @@ -2082,9 +2083,7 @@ erc-open (erc-determine-parameters server port nick full-name user passwd) - (save-excursion (run-mode-hooks)) - (dolist (mod (car delayed-modules)) (funcall mod +1)) - (dolist (var (cdr delayed-modules)) (set var nil)) + ;; FIXME consolidate this prompt-setup logic with the pass above. ;; set up prompt (unless continued-session @@ -2097,6 +2096,10 @@ erc-open (erc-display-prompt) (goto-char (point-max))) + (save-excursion (run-mode-hooks) + (dolist (mod (car delayed-modules)) (funcall mod +1)) + (dolist (var (cdr delayed-modules)) (set var nil))) + ;; Saving log file on exit (run-hook-with-args 'erc-connect-pre-hook buffer) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 85506c3d27e..40a2d2de657 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1251,18 +1251,28 @@ erc--update-modules (setq calls nil))))) (ert-deftest erc--merge-local-modes () - - (ert-info ("No existing modes") - (let ((old '((a) (b . t))) - (new '(erc-c-mode erc-d-mode))) - (should (equal (erc--merge-local-modes new old) - '((erc-c-mode erc-d-mode)))))) - - (ert-info ("Active existing added, inactive existing removed, deduped") - (let ((old '((a) (erc-b-mode) (c . t) (erc-d-mode . t) (erc-e-mode . t))) - (new '(erc-b-mode erc-d-mode))) - (should (equal (erc--merge-local-modes new old) - '((erc-d-mode erc-e-mode) . (erc-b-mode))))))) + (cl-letf (((get 'erc-b-mode 'erc-module) 'b) + ((get 'erc-c-mode 'erc-module) 'c) + ((get 'erc-d-mode 'erc-module) 'd) + ((get 'erc-e-mode 'erc-module) 'e)) + + (ert-info ("No existing modes") + (let ((old '((a) (b . t))) + (new '(erc-c-mode erc-d-mode))) + (should (equal (erc--merge-local-modes new old) + '((erc-c-mode erc-d-mode)))))) + + (ert-info ("Active existing added, inactive existing removed, deduped") + (let ((old '((a) (erc-b-mode) (c . t) (erc-d-mode . t) (erc-e-mode . t))) + (new '(erc-b-mode erc-d-mode))) + (should (equal (erc--merge-local-modes new old) + '((erc-d-mode erc-e-mode) . (erc-b-mode)))))) + + (ert-info ("Non-module erc-prefixed mode ignored") + (let ((old '((erc-b-mode) (erc-f-mode . t) (erc-d-mode . t))) + (new '(erc-b-mode))) + (should (equal (erc--merge-local-modes new old) + '((erc-d-mode) . (erc-b-mode)))))))) (ert-deftest define-erc-module--global () (let ((global-module '(define-erc-module mname malias @@ -1300,13 +1310,15 @@ define-erc-module--global (ignore c) (ignore d)) (defalias 'erc-malias-mode #'erc-mname-mode) + (put 'erc-malias-mode 'erc-module 'mname) + (put 'erc-mname-mode 'erc-module 'mname) (put 'erc-mname-mode 'definition-name 'mname) (put 'erc-mname-enable 'definition-name 'mname) (put 'erc-mname-disable 'definition-name 'mname)))))) (ert-deftest define-erc-module--local () - (let* ((global-module '(define-erc-module mname malias + (let* ((global-module '(define-erc-module mname nil ; no alias "Some docstring" ((ignore a) (ignore b)) ((ignore c) (ignore d)) @@ -1353,8 +1365,7 @@ define-erc-module--local (setq erc-mname-mode nil) (ignore c) (ignore d)))) - (defalias 'erc-malias-mode #'erc-mname-mode) - + (put 'erc-mname-mode 'erc-module 'mname) (put 'erc-mname-mode 'definition-name 'mname) (put 'erc-mname-enable 'definition-name 'mname) (put 'erc-mname-disable 'definition-name 'mname)))))) commit 7b8322f6285702faf5da0824b9b195619da9c698 Author: F. Jason Park Date: Mon Jan 16 23:05:16 2023 -0800 Use correct buffer for local-module vars in erc-open * lisp/erc/erc.el (erc--target-priors): New internal variable to do for target buffers what `erc--server-reconnecting' does for server buffers. (erc-open): Source the state of a local module's mode variable from its actual buffer rather than its server buffer. Additionally, make all local variables from a prior session available to module-activation functions and `erc-mode' hooks, even when `erc-reuse-buffers' is nil. This bug arrived with the introduction of "local-modules" (bug#57955). * test/lisp/erc/erc-scenarios-base-local-modules.el (erc-scenarios-base-local-modules--toggle-helpers): Remove useless `with-current-buffer'. (erc-scenarios-base-local-modules--local-var, erc--phony-sblm--enable, erc--phony-sblm--disable, erc--phony-sblm--mode): Add fake local module and data var for test scenario. (erc-scenarios-base-local-modules--var-persistence) Add slightly hacky test case with promise to improve later when splitting the file. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ba7db15cf8c..e7f81f24ac4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1305,6 +1305,14 @@ erc-debug-log-file (defvar-local erc-dbuf nil) +;; See comments in `erc-scenarios-base-local-modules' explaining why +;; this is insufficient as a public interface. + +(defvar erc--target-priors nil + "Analogous to `erc--server-reconnecting' but for target buffers. +Bound to local variables from an existing (logical) session's +buffer during local-module setup and `erc-mode-hook' activation.") + (defun erc--target-from-string (string) "Construct an `erc--target' variant from STRING." (funcall (if (erc-channel-p string) @@ -1985,7 +1993,9 @@ erc-open (let* ((target (and channel (erc--target-from-string channel))) (buffer (erc-get-buffer-create server port nil target id)) (old-buffer (current-buffer)) - (old-vars (and target (buffer-local-variables))) + (erc--target-priors (and target ; buf from prior session + (buffer-local-value 'erc--target buffer) + (buffer-local-variables buffer))) (old-recon-count erc-server-reconnect-count) (old-point nil) (delayed-modules nil) @@ -1998,7 +2008,8 @@ erc-open (setq old-point (point)) (setq delayed-modules (erc--merge-local-modes (erc--update-modules) - (or erc--server-reconnecting old-vars))) + (or erc--server-reconnecting + erc--target-priors))) (delay-mode-hooks (erc-mode)) diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el index d4001df45de..916d105779a 100644 --- a/test/lisp/erc/erc-scenarios-base-local-modules.el +++ b/test/lisp/erc/erc-scenarios-base-local-modules.el @@ -19,8 +19,17 @@ ;;; Commentary: -;; These tests all use `sasl' because, as of ERC 5.5, it's the one -;; and only local module. +;; A local module doubles as a minor mode whose mode variable and +;; associated local data can withstand service disruptions. +;; Unfortunately, the current implementation is too unwieldy to be +;; made public because it doesn't perform any of the boiler plate +;; needed to save and restore buffer-local and "network-local" copies +;; of user options. Ultimately, a user-friendly framework must fill +;; this void if third-party local modules are ever to become +;; practical. +;; +;; The following tests all use `sasl' because, as of ERC 5.5, it's the +;; only local module. ;;; Code: @@ -206,7 +215,7 @@ erc-scenarios-base-local-modules--toggle-helpers (erc-cmd-QUIT "") (funcall expect 10 "finished"))) - (ert-info ("Disabling works from a target buffer.") + (ert-info ("Disabling works from a target buffer") (with-current-buffer "#chan" (should erc-sasl-mode) (call-interactively #'erc-sasl-disable) @@ -214,10 +223,9 @@ erc-scenarios-base-local-modules--toggle-helpers (should (local-variable-p 'erc-sasl-mode)) (should-not (buffer-local-value 'erc-sasl-mode (get-buffer "foonet"))) (erc-cmd-RECONNECT) - (with-current-buffer "#chan" - (funcall expect 10 "Some enigma, some riddle") - (should-not erc-sasl-mode) ; regression - (should (local-variable-p 'erc-sasl-mode)))) + (funcall expect 10 "Some enigma, some riddle") + (should-not erc-sasl-mode) ; regression + (should (local-variable-p 'erc-sasl-mode))) (with-current-buffer "foonet" (should (local-variable-p 'erc-sasl-mode)) @@ -239,4 +247,82 @@ erc-scenarios-base-local-modules--toggle-helpers (should erc-sasl-mode) (funcall expect 10 "User modes for tester"))))) +(defvar-local erc-scenarios-base-local-modules--local-var nil) + +(define-erc-module -phony-sblm- nil + "Test module for `erc-scenarios-base-local-modules--var-persistence'." + ((when-let ((vars (or erc--server-reconnecting erc--target-priors))) + (should (assq 'erc--phony-sblm--mode vars)) + (setq erc-scenarios-base-local-modules--local-var + (alist-get 'erc-scenarios-base-local-modules--local-var vars))) + (setq erc-scenarios-base-local-modules--local-var + (or erc-scenarios-base-local-modules--local-var + (if erc--target 100 0)))) + ((kill-local-variable 'erc-scenarios-base-local-modules--local-var)) + 'local) + +;; Note: this file has grown too expensive (time-wise) and must be +;; split up. When that happens, this test should be rewritten without +;; any time-saving hacks, namely, server-initiated JOINs and an +;; absence of QUITs. (That said, three connections in under 2 seconds +;; is pretty nice.) + +(ert-deftest erc-scenarios-base-local-modules--var-persistence () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/reconnect") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'options 'options 'options)) + (port (process-contact dumb-server :service)) + (erc-modules (cons '-phony-sblm- (remq 'autojoin erc-modules))) + (expect (erc-d-t-make-expecter)) + (server-buffer-name (format "127.0.0.1:%d" port))) + + (ert-info ("Initial authentication succeeds as expected") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester") + (should (string= (buffer-name) server-buffer-name))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "FooNet")) + (funcall expect 10 "This server is in debug mode") + (should erc--phony-sblm--mode) + (should (eql erc-scenarios-base-local-modules--local-var 0)) + (setq erc-scenarios-base-local-modules--local-var 1))) + + (ert-info ("Save module's local var in target buffer") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (should (eql erc-scenarios-base-local-modules--local-var 100)) + (setq erc-scenarios-base-local-modules--local-var 101) + (funcall expect 20 "welcome"))) + + (with-current-buffer "FooNet" (funcall expect 20 "terminated")) + + (ert-info ("Vars reused when mode was left enabled") + (with-current-buffer "#chan" + (erc-cmd-RECONNECT) + (funcall expect 20 "welcome") + (should (eql erc-scenarios-base-local-modules--local-var 101)) + (erc--phony-sblm--mode -1)) + + (with-current-buffer "FooNet" + (funcall expect 10 "User modes for tester") + (should (eql erc-scenarios-base-local-modules--local-var 1)))) + + (with-current-buffer "FooNet" (funcall expect 20 "terminated")) + + (ert-info ("Local binding gone when mode disabled in target") + (with-current-buffer "#chan" + (erc-cmd-RECONNECT) + (funcall expect 20 "welcome") + (should-not erc--phony-sblm--mode) + (should-not erc-scenarios-base-local-modules--local-var)) + + ;; But value retained in server buffer, where mode is active. + (with-current-buffer "FooNet" + (funcall expect 10 "User modes for tester") + (should (eql erc-scenarios-base-local-modules--local-var 1)))))) + ;;; erc-scenarios-local-modules.el ends here commit 7b13422298a2613c506d41f52fa0c0ca1588f870 Author: F. Jason Park Date: Tue Jan 10 11:59:57 2023 -0800 ; Avoid plist-get as generalized var in erc-compat * lisp/erc/erc-compat.el (erc-compat--29-auth-source-pass-search): The gv expander for `plist-get' was added in Emacs 28. But ERC still supports 27, as of this function's introduction, in Emacs 29. diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 73ce612a33d..5601ede27a5 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -260,8 +260,8 @@ erc-compat--29-auth-source-pass-search (dolist (e rv out) (when-let* ((s (plist-get e :secret)) (v (auth-source--obfuscate s))) - (setf (plist-get e :secret) - (apply-partially #'auth-source--deobfuscate v))) + (setq e (plist-put e :secret (apply-partially + #'auth-source--deobfuscate v)))) (push e out))) rv))) commit 09e9d7c749680fd3580e9b1795e39051e3709917 Author: Eli Zaretskii Date: Tue Jan 17 15:44:51 2023 +0200 Fix display of warnings on w32 console * lisp/emacs-lisp/warnings.el (warnings-suppress): Use alternative symbol for TTY frames on MS-Windows. diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 9505c935816..31b840d6c83 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -204,8 +204,12 @@ warning-suppress-p some-match)) (define-icon warnings-suppress button - '((emoji "⛔") - (symbol " ■ ") + `((emoji "⛔") + ;; Many MS-Windows console fonts don't have good glyphs for U+25A0. + (symbol ,(if (and (eq system-type 'windows-nt) + (null window-system)) + " » " + " ■ ")) (text " stop ")) "Suppress warnings." :version "29.1" commit bd094207c76c500f8a3bffe8231d8c6ae0fd0778 Author: Basil L. Contovounesios Date: Wed Jan 11 16:34:07 2023 +0000 Fix buffer-list-update-hook for indirect buffers Fmake_indirect_buffer can be told whether to run buffer hooks since bug#49160, but until now it ran buffer-list-update-hook irrespective of this. * src/buffer.c (Fmake_indirect_buffer): Don't run buffer-list-update-hook when called with a non-nil INHIBIT-BUFFER-HOOKS argument. (run_buffer_list_update_hook): Don't special-case NULL argument, as no such callers remain. * test/src/buffer-tests.el (buffer-tests-inhibit-buffer-hooks-indirect): Test whether indirect buffer hooks are run regardless of whether base buffer hooks are inhibited. Check that all three buffer hooks, not just kill-buffer-query-functions, are inhibited. diff --git a/src/buffer.c b/src/buffer.c index 100e42fc1f9..88ca69b0dd8 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -525,14 +525,14 @@ get_truename_buffer (register Lisp_Object filename) return Qnil; } -/* Run buffer-list-update-hook if Vrun_hooks is non-nil, and BUF is NULL - or does not have buffer hooks inhibited. BUF is NULL when called by - make-indirect-buffer, since it does not inhibit buffer hooks. */ +/* Run buffer-list-update-hook if Vrun_hooks is non-nil and BUF does + not have buffer hooks inhibited. */ static void run_buffer_list_update_hook (struct buffer *buf) { - if (! (NILP (Vrun_hooks) || (buf && buf->inhibit_buffer_hooks))) + eassert (buf); + if (! (NILP (Vrun_hooks) || buf->inhibit_buffer_hooks)) call1 (Vrun_hooks, Qbuffer_list_update_hook); } @@ -907,7 +907,7 @@ DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer, set_buffer_internal_1 (old_b); } - run_buffer_list_update_hook (NULL); + run_buffer_list_update_hook (b); return buf; } diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index e5de8f3464a..9d4bbf3e040 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -8315,29 +8315,35 @@ buffer-tests-inhibit-buffer-hooks (remove-hook 'buffer-list-update-hook bluh)))) (ert-deftest buffer-tests-inhibit-buffer-hooks-indirect () - "Indirect buffers do not call `get-buffer-create'." - (dolist (inhibit '(nil t)) - (let ((base (get-buffer-create "foo" inhibit))) + "Test `make-indirect-buffer' argument INHIBIT-BUFFER-HOOKS." + (let* ( base run-bluh run-kbh run-kbqf + (bluh (lambda () (setq run-bluh t))) + (kbh (lambda () (setq run-kbh t))) + (kbqf (lambda () (setq run-kbqf t)))) + (dolist (inhibit-base '(nil t)) (unwind-protect - (dotimes (_i 11) - (let* (flag* - (flag (lambda () (prog1 t (setq flag* t)))) - (indirect (make-indirect-buffer base "foo[indirect]" nil - inhibit))) - (unwind-protect - (progn - (with-current-buffer indirect - (add-hook 'kill-buffer-query-functions flag nil t)) - (kill-buffer indirect) - (if inhibit - (should-not flag*) - (should flag*))) - (let (kill-buffer-query-functions) + (let (indirect) + (setq base (generate-new-buffer " base" inhibit-base)) + (dolist (inhibit-indirect '(nil t)) + (dotimes (_ 11) + (unwind-protect + (let ((name (generate-new-buffer-name " indirect"))) + (setq run-bluh nil run-kbh nil run-kbqf nil) + (add-hook 'buffer-list-update-hook bluh) + (with-current-buffer + (setq indirect (make-indirect-buffer + base name nil inhibit-indirect)) + (add-hook 'kill-buffer-hook kbh nil t) + (add-hook 'kill-buffer-query-functions kbqf nil t) + (kill-buffer)) + (should (xor inhibit-indirect run-bluh)) + (should (xor inhibit-indirect run-kbh)) + (should (xor inhibit-indirect run-kbqf))) + (remove-hook 'buffer-list-update-hook bluh) (when (buffer-live-p indirect) (kill-buffer indirect)))))) - (let (kill-buffer-query-functions) - (when (buffer-live-p base) - (kill-buffer base))))))) + (when (buffer-live-p base) + (kill-buffer base)))))) (ert-deftest zero-length-overlays-and-not () (with-temp-buffer commit 9e7a5d58eea664b55e11f2ea5dc7da9ba26d500f Author: Yuan Fu Date: Tue Jan 17 01:20:51 2023 -0800 ; Fix tree-sitter indent anchor preset * lisp/treesit.el: (treesit-simple-indent-presets): Fix prev-adaptive-prefix. diff --git a/lisp/treesit.el b/lisp/treesit.el index 5e6f109531e..4c31ecb0d29 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1152,6 +1152,9 @@ treesit-simple-indent-presets (and (>= (point) comment-start-bol) adaptive-fill-regexp (looking-at adaptive-fill-regexp) + ;; If previous line is an empty line, don't + ;; indent. + (not (looking-at (rx (* whitespace) eol))) (match-end 0)))))) ;; TODO: Document. (cons 'grand-parent commit 7c61a304104fe3a35c47d412150d29b93a697c5e Author: Yuan Fu Date: Tue Jan 17 00:57:54 2023 -0800 Fix treesit-node-first-child-for-pos (bug#60127) The problem is due to a bug in ts_node_first_child_for_pos, but tree-sitter is moving pretty slowly right now so I reimplemented a correct version of it in treesit.c. * src/treesit.c (treesit_cursor_first_child_for_byte): New function. (Ftreesit_node_first_child_for_pos): Use the new function. diff --git a/src/treesit.c b/src/treesit.c index adbed1427be..644d323d5cb 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2095,6 +2095,41 @@ DEFUN ("treesit-node-prev-sibling", return make_treesit_node (XTS_NODE (node)->parser, sibling); } +/* Our reimplementation of ts_node_first_child_for_byte. The current + implementation of that function has problems (see bug#60127), so + before it's fixed upstream, we use our own reimplementation of it. + Return true if there is a valid sibling, return false otherwise. + If the return value is false, the position of the cursor is + undefined. (We use cursor because technically we can't make a null + node for ourselves, also, using cursor is more convenient.) + + TODO: Remove this function once tree-sitter fixed the bug. */ +static bool treesit_cursor_first_child_for_byte +(TSTreeCursor *cursor, ptrdiff_t pos, bool named) +{ + if (!ts_tree_cursor_goto_first_child (cursor)) + return false; + + TSNode node = ts_tree_cursor_current_node (cursor); + while (ts_node_end_byte (node) <= pos) + { + if (ts_tree_cursor_goto_next_sibling (cursor)) + node = ts_tree_cursor_current_node (cursor); + else + /* Reached the end and still can't find a valid sibling. */ + return false; + } + while (named && (!ts_node_is_named (node))) + { + if (ts_tree_cursor_goto_next_sibling (cursor)) + node = ts_tree_cursor_current_node (cursor); + else + /* Reached the end and still can't find a named sibling. */ + return false; + } + return true; +} + DEFUN ("treesit-node-first-child-for-pos", Ftreesit_node_first_child_for_pos, Streesit_node_first_child_for_pos, 2, 3, 0, @@ -2119,16 +2154,17 @@ DEFUN ("treesit-node-first-child-for-pos", ptrdiff_t byte_pos = buf_charpos_to_bytepos (buf, XFIXNUM (pos)); TSNode treesit_node = XTS_NODE (node)->node; - TSNode child; - if (NILP (named)) - child = ts_node_first_child_for_byte (treesit_node, byte_pos - visible_beg); - else - child = ts_node_first_named_child_for_byte (treesit_node, - byte_pos - visible_beg); - if (ts_node_is_null (child)) - return Qnil; + TSTreeCursor cursor = ts_tree_cursor_new (treesit_node); + ptrdiff_t treesit_pos = byte_pos - visible_beg; + bool success; + success = treesit_cursor_first_child_for_byte (&cursor, treesit_pos, + !NILP (named)); + TSNode child = ts_tree_cursor_current_node (&cursor); + ts_tree_cursor_delete (&cursor); + if (!success) + return Qnil; return make_treesit_node (XTS_NODE (node)->parser, child); } commit b36cc7e7bbb5a8d0c1b298b89a4cb562af746ecc Author: Yuan Fu Date: Mon Jan 16 20:32:15 2023 -0800 ; * src/treesit.c (Ftreesit_induce_sparse_tree): Minor change. diff --git a/src/treesit.c b/src/treesit.c index 3886fed346e..adbed1427be 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -3270,9 +3270,9 @@ DEFUN ("treesit-induce-sparse-tree", Lisp_Object parser = XTS_NODE (root)->parser; Lisp_Object parent = Fcons (Qnil, Qnil); - TSTreeCursor cursor; - if (!treesit_cursor_helper (&cursor, XTS_NODE (root)->node, parser)) - return Qnil; + /* In this function we never traverse above NODE, so we don't need + to use treesit_cursor_helper. */ + TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (root)->node); treesit_build_sparse_tree (&cursor, parent, predicate, process_fn, the_limit, parser);