[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android 8acab739083 5/5: Merge remote-tracking branch 'origin/ma
|
From: |
Po Lu |
|
Subject: |
feature/android 8acab739083 5/5: Merge remote-tracking branch 'origin/master' into feature/android |
|
Date: |
Mon, 23 Jan 2023 21:39:40 -0500 (EST) |
branch: feature/android
commit 8acab739083cd0501b20546800eb8d91269484ce
Merge: 47d731d2140 29a8a1885d9
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
doc/emacs/custom.texi | 49 ++-
doc/emacs/mini.texi | 10 +-
doc/lispref/keymaps.texi | 18 +-
doc/lispref/minibuf.texi | 10 +-
doc/lispref/parsing.texi | 51 ++-
doc/misc/org.org | 4 +-
etc/NEWS | 14 +
etc/NEWS.29 | 62 ++--
lisp/calendar/appt.el | 2 +-
lisp/cus-start.el | 1 +
lisp/emacs-lisp/package-vc.el | 2 +-
lisp/erc/erc.el | 3 +-
lisp/eshell/esh-arg.el | 5 +-
lisp/find-dired.el | 2 +-
lisp/frame.el | 2 +-
lisp/international/mule.el | 4 +
lisp/keymap.el | 15 +-
lisp/mh-e/mh-e.el | 5 +-
lisp/net/tramp-compat.el | 1 -
lisp/net/tramp-sh.el | 156 +++------
lisp/net/tramp-smb.el | 58 +---
lisp/net/tramp-sudoedit.el | 71 +---
lisp/net/tramp.el | 135 ++++++--
lisp/org/ob-core.el | 2 +-
lisp/org/ob-ruby.el | 5 +-
lisp/org/org-agenda.el | 17 +-
lisp/org/org-clock.el | 30 +-
lisp/org/org-element.el | 4 +-
lisp/org/org-fold-core.el | 21 +-
lisp/org/org-persist.el | 5 +-
lisp/org/org-table.el | 10 +-
lisp/org/org-version.el | 2 +-
lisp/org/org.el | 2 +-
lisp/org/ox-odt.el | 2 +-
lisp/org/ox.el | 4 +-
lisp/progmodes/c-ts-common.el | 247 ++++++++++++++
lisp/progmodes/c-ts-mode.el | 356 ++++++++-------------
lisp/progmodes/cc-engine.el | 302 ++++++++++-------
lisp/progmodes/cmake-ts-mode.el | 8 +-
lisp/progmodes/csharp-mode.el | 15 +-
lisp/progmodes/dockerfile-ts-mode.el | 12 +-
lisp/progmodes/go-ts-mode.el | 45 ++-
lisp/progmodes/java-ts-mode.el | 13 +-
lisp/progmodes/js.el | 39 ++-
lisp/progmodes/json-ts-mode.el | 4 +
lisp/progmodes/project.el | 15 +-
lisp/progmodes/python.el | 5 +-
lisp/progmodes/ruby-mode.el | 178 ++++++-----
lisp/progmodes/ruby-ts-mode.el | 56 +++-
lisp/progmodes/rust-ts-mode.el | 14 +-
lisp/progmodes/typescript-ts-mode.el | 50 ++-
lisp/simple.el | 2 +-
lisp/textmodes/css-mode.el | 4 +-
lisp/textmodes/html-ts-mode.el | 7 +-
lisp/textmodes/toml-ts-mode.el | 5 +-
lisp/textmodes/yaml-ts-mode.el | 6 +-
lisp/treesit.el | 62 ++--
lisp/vc/vc-git.el | 19 --
lisp/vc/vc.el | 17 +-
src/fns.c | 16 +-
src/w32.c | 45 ++-
src/w32fns.c | 28 +-
test/lisp/international/mule-tests.el | 66 ++++
test/lisp/net/tramp-archive-tests.el | 3 +
test/lisp/net/tramp-tests.el | 60 +++-
.../progmodes/c-ts-mode-resources/indent-bsd.erts | 93 ++++++
.../lisp/progmodes/c-ts-mode-resources/indent.erts | 13 +
test/lisp/progmodes/c-ts-mode-tests.el | 4 +
.../ruby-mode-resources/ruby-method-call-indent.rb | 9 +
test/src/keymap-tests.el | 33 ++
70 files changed, 1679 insertions(+), 956 deletions(-)
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index 91df15a21d7..ee818a74b57 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -1887,23 +1887,31 @@ command is less work to invoke when you really want to.
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
+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)
@end example
+@cindex key sequence syntax
@noindent
-The single-quote before the command name, @code{shell}, marks it as a
+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 probably
-causes an error; it certainly isn't what you want.
+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:
@@ -1920,6 +1928,27 @@ and mouse events:
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, using these low-level
+functions, 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 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
As described in @ref{Local Keymaps}, major modes and minor modes can
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 @@ File ‘foo.el’ exists; overwrite? (y or n)
@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/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 @@ Binding Conventions}).
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 @@ The only keys that have a special shorthand syntax are
@kbd{NUL},
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 @@ the menu. To put it elsewhere in the menu, use
@code{keymap-set-after}:
@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:
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 @@ minibuffer. It returns @code{t} if the user enters
@samp{yes},
@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/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 @@ integration for a major mode.
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 @@ language grammar for @var{language} is available on the
system
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.
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/etc/NEWS b/etc/NEWS
index cfb1f82706f..3a52492fd19 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -56,6 +56,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
@@ -193,6 +199,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/etc/NEWS.29 b/etc/NEWS.29
index 38f2db26a1a..64c26f93c50 100644
--- a/etc/NEWS.29
+++ b/etc/NEWS.29
@@ -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,11 @@ 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 +3288,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/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 @@ displayed in a window:
'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
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 @@ Leaving \"Default\" unchecked is equivalent with specifying
a default of
(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/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 @@ how to fetch and build the package. See
`package-vc--archive-spec-alist'
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))
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 @@ Customize `erc-url-connect-function' to override this."
(provide 'erc)
+;; FIXME this is a temporary stopgap for Emacs 29.
+(require 'erc-goodies)
;;; erc.el ends here
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 @@ and if found, returns a grouped list like:
((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)
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 @@ it finishes, type \\[kill-find]."
" . \\( \\) "
(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.
diff --git a/lisp/frame.el b/lisp/frame.el
index f8ef17325ec..a88af24a152 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -2216,7 +2216,7 @@ frame's display)."
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/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 @@ This function is intended to be added to
`auto-coding-functions'."
(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
diff --git a/lisp/keymap.el b/lisp/keymap.el
index 315eaab7560..791221f2459 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -186,10 +186,17 @@ a menu, so this function is not useful for non-menu
keymaps."
(declare (indent defun)
(compiler-macro (lambda (form) (keymap--compile-check key) form)))
(keymap--check key)
- (when after
- (keymap--check after))
+ (when (eq after t) (setq after nil)) ; nil and t are treated the same
+ (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.
@@ -404,7 +411,7 @@ specified buffer position instead of point are used."
(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/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 @@ This assumes that a temporary buffer is set up."
;; 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 @@ This assumes that a temporary buffer is set up."
(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
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 @@ Operations not mentioned here will be handled by the
normal Emacs functions.")
(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 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(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 @@ the result will be a local, non-Tramp, file name."
(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 @@ the result will be a local, non-Tramp, file name."
(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 fab1962d2b7..dcc6f05979f 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3529,6 +3529,35 @@ BODY is the backend specific code."
;; 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 @@ BODY is the backend specific code."
,@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}'.
@@ -4045,9 +4117,15 @@ Let-bind it when necessary.")
"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."
@@ -4085,13 +4163,8 @@ Let-bind it when necessary.")
(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
@@ -4101,31 +4174,21 @@ Let-bind it when necessary.")
;; 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."
@@ -6340,6 +6403,7 @@ It always returns a return code. The Lisp error raised
when
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)))
@@ -6372,6 +6436,7 @@ It always returns a return code. The Lisp error raised
when
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/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 @@ Emacs shutdown.")
(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/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:
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 @@ Custom commands can set this variable in the options
section."
"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 @@ This check for agenda markers in all agenda buffers
currently active."
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 @@ Optional argument N tells to change by that many units."
(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 @@ Assume point is at the beginning of the fixed-width area."
(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 @@ If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold
everything in the 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 @@ This function is intended to be used as
`isearch-filter-predicate'."
"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 @@ FORMAT and ARGS are passed to `message'."
(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 @@ Return t when the line exists, nil if it does not exist."
(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 @@ In particular, this does handle wide and invisible
characters."
(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 @@ Inserted by installing Org mode or when a release is made."
(defun org-git-version ()
"The Git version of Org mode.
Inserted by installing Org or when a release is made."
- (let ((org-git-version "release_9.6.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 <bzg@gnu.org>
;; 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 @@ contextual information."
(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 @@ Return code as a string."
;; 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 @@ them."
("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 "Содержание")
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) <casouri@gmail.com>
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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 348d027af19..58f0ac6c069 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -24,14 +24,58 @@
;;; 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 modes by default, assuming you have the respective
+;; tree-sitter grammars available, do one of the following:
+;;
+;; - If you have both C and C++ grammars installed, add
+;;
+;; (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.
+;;
+;; - 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")
@@ -115,18 +159,18 @@ delimiters < and >'s."
"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)
((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'.
- ((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-looking-at-star' has to come before
+ ;; `c-ts-common-comment-2nd-line-matcher'.
+ ((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
1)
((parent-is "comment") prev-adaptive-prefix 0)
@@ -193,6 +237,10 @@ MODE is either `c' or `cpp'."
((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)
@@ -257,7 +305,18 @@ PARENT is NODE's parent."
(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))))))
@@ -270,60 +329,6 @@ PARENT is NODE's parent."
(- (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
@@ -719,156 +724,6 @@ the semicolon. This function skips the semicolon."
(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
@@ -896,6 +751,37 @@ Set up:
(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)
@@ -905,7 +791,7 @@ Set up:
(setq-local indent-tabs-mode t))
;; Comment
- (c-ts-mode-comment-setup)
+ (c-ts-common-comment-setup)
;; Electric
(setq-local electric-indent-chars
@@ -936,7 +822,16 @@ Set up:
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)
@@ -953,7 +848,20 @@ This mode is independent from the classic cc-mode.el based
;;;###autoload
(define-derived-mode c++-ts-mode c-ts-base-mode "C++"
- "Major mode for editing C++, powered by tree-sitter."
+ "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."
:group 'c++
(when (treesit-ready-p 'cpp)
@@ -1019,6 +927,22 @@ the code is C or C++ and based on that chooses whether to
enable
(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/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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
;;
;; 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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
;; 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 @@ multi-line strings (but not C++, for example)."
(/= (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<Y<class A<int>::B, BIT_MAX >> b>, ::operator<> ::
@@ -8853,7 +8904,7 @@ multi-line strings (but not C++, for example)."
;;
;; 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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
;; 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 @@ multi-line strings (but not C++, for example)."
;; 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 @@ multi-line strings (but not C++, for example)."
;; `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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
)))))
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(>= (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 @@ multi-line strings (but not C++, for example)."
;; 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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
((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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
(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 @@ multi-line strings (but not C++, for example)."
;; `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 @@ point unchanged and return nil."
;; (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 @@ point unchanged and return nil."
(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 @@ point unchanged and return nil."
;; 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 @@ point unchanged and return nil."
(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 @@ This function might do hidden buffer changes."
(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 @@ This function might do hidden buffer changes."
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 @@ This function might do hidden buffer changes."
(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)
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 @@ the subtrees."
(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 @@ the subtrees."
(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 870e6c84b40..063cfffe1da 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 @@ compilation and evaluation time conflicts."
((node-is "}") parent-bol 0)
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
- ((and (parent-is "comment") c-ts-mode--looking-at-star)
- c-ts-mode--comment-start-after-first-star -1)
+ ((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)
@@ -883,9 +883,6 @@ Return nil if there is no name or if NODE is not a defun
node."
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.
@@ -911,7 +908,7 @@ Key bindings:
(treesit-parser-create 'c-sharp)
;; Comments.
- (c-ts-mode-comment-setup)
+ (c-ts-common-comment-setup)
(setq-local treesit-text-type-regexp
(regexp-opt '("comment"
@@ -946,7 +943,9 @@ Key bindings:
("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 1b91681f085..23ac48a6117 100644
--- a/lisp/progmodes/dockerfile-ts-mode.el
+++ b/lisp/progmodes/dockerfile-ts-mode.el
@@ -132,12 +132,6 @@ the subtrees."
(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."
@@ -176,6 +170,12 @@ the subtrees."
(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..44f141217bc 100644
--- a/lisp/progmodes/go-ts-mode.el
+++ b/lisp/progmodes/go-ts-mode.el
@@ -174,12 +174,16 @@
'((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))
+(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
@@ -226,6 +230,9 @@
(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."
@@ -274,6 +281,32 @@ Return nil if there is no name or if NODE is not a defun
node."
(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
@@ -345,9 +378,6 @@ what the parent of the node would be if it were a node."
'((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 +406,9 @@ what the parent of the node would be if it were a node."
(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 03093e09805..08929c0aead 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")
@@ -69,12 +69,12 @@
(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)
- ((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 @@ Return nil if there is no name or if NODE is not a defun
node."
(treesit-parser-create 'java)
;; Comments.
- (c-ts-mode-comment-setup)
+ (c-ts-common-comment-setup)
(setq-local treesit-text-type-regexp
(regexp-opt '("line_comment"
@@ -359,6 +359,9 @@ Return nil if there is no name or if NODE is not a defun
node."
("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 28305a0b39b..dca93c856fc 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 @@ This function is intended for use in
`after-change-functions'."
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
((node-is ">") parent-bol 0)
- ((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)
@@ -3817,6 +3817,29 @@ Currently there are `js-mode' and `js-ts-mode'."
"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.
@@ -3831,7 +3854,7 @@ See `treesit-sentence-type-regexp' for more information.")
;; 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)
(setq-local treesit-text-type-regexp
@@ -3860,6 +3883,9 @@ See `treesit-sentence-type-regexp' for more information.")
(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
@@ -3877,7 +3903,10 @@ See `treesit-sentence-type-regexp' for more
information.")
"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 f6a303290a8..6bd9d30328e 100644
--- a/lisp/progmodes/json-ts-mode.el
+++ b/lisp/progmodes/json-ts-mode.el
@@ -162,6 +162,10 @@ Return nil if there is no name or if NODE is not a defun
node."
(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/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 backend implementation of
`project-external-roots'.")
(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
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 @@ implementations: `python-mode' and `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-mode.el b/lisp/progmodes/ruby-mode.el
index 2de7395f765..dba9ff0a846 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -141,6 +141,81 @@ This should only be called after matching against
`ruby-here-doc-beg-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")
@@ -261,7 +336,15 @@ Only has effect when `ruby-use-smie' is t."
"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
@@ -271,12 +354,26 @@ Only has effect when `ruby-use-smie' is t."
(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)
@@ -2292,84 +2389,13 @@ It will be properly highlighted even when the call
omits parens.")
;; 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 f0337775d51..a81b5f10549 100644
--- a/lisp/progmodes/ruby-ts-mode.el
+++ b/lisp/progmodes/ruby-ts-mode.el
@@ -5,6 +5,7 @@
;; Author: Perry Smith <pedz@easesoftware.com>
;; Created: December 2022
;; Keywords: ruby languages tree-sitter
+;; Version: 0.2
;; This file is part of GNU Emacs.
@@ -50,11 +51,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
@@ -71,6 +72,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
@@ -114,21 +117,30 @@
"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))))
+ "$0" "$1" "$2" "$3" "$4" "$5" "$6" "$7" "$8" "$9")
+ 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")
@@ -197,6 +209,9 @@ values of OVERRIDE"
(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
@@ -322,6 +337,11 @@ values of OVERRIDE"
(in_clause
pattern: (identifier) @font-lock-variable-name-face))
+ :language language
+ :feature 'builtin-function
+ `((((identifier) @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
;; just use separate categories for them -- dgutov.
@@ -535,7 +555,7 @@ a statement container is a node that matches
(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.
@@ -645,7 +665,7 @@ a statement container is a node that matches
(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:
@@ -1034,14 +1054,28 @@ leading double colon is not added."
(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-function
delimiter escape-sequence
- global instance
+ constant global instance
interpolation literal symbol assignment)
( bracket error function operator punctuation)))
(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..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 @@
((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)
@@ -275,9 +275,6 @@ Return nil if there is no name or if NODE is not a defun
node."
(treesit-node-text
(treesit-node-child-by-field-name node "name") t))))
-;;;###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."
@@ -288,7 +285,7 @@ Return nil if there is no name or if NODE is not a defun
node."
(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)
@@ -322,6 +319,9 @@ Return nil if there is no name or if NODE is not a defun
node."
(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 f7bf7ed7e42..48f9ac806c1 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")
@@ -69,13 +69,13 @@
"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)
((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)
@@ -338,11 +338,27 @@ Argument LANGUAGE is either `typescript' or `tsx'."
"Nodes that designate sentences in TypeScript.
See `treesit-sentence-type-regexp' for more information.")
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode))
-
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.tsx\\'" . tsx-ts-mode))
+(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
(define-derived-mode typescript-ts-base-mode prog-mode "TypeScript"
@@ -351,7 +367,7 @@ See `treesit-sentence-type-regexp' for more information.")
:syntax-table typescript-ts-mode--syntax-table
;; Comments.
- (c-ts-mode-comment-setup)
+ (c-ts-common-comment-setup)
(setq-local treesit-defun-prefer-top-level t)
(setq-local treesit-text-type-regexp
@@ -373,6 +389,9 @@ See `treesit-sentence-type-regexp' for more information.")
(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)
@@ -407,6 +426,9 @@ See `treesit-sentence-type-regexp' for more information.")
(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."
@@ -438,6 +460,11 @@ See `treesit-sentence-type-regexp' for more information.")
'("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))
@@ -449,6 +476,9 @@ See `treesit-sentence-type-regexp' for more information.")
(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/simple.el b/lisp/simple.el
index 844cfa68b08..561c7b568ab 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10416,7 +10416,7 @@ call `normal-erase-is-backspace-mode' (which see)
instead."
(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))
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 @@ can also be used to fill comments.
(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/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el
index 7e4360747a3..58dcc7d8cad 100644
--- a/lisp/textmodes/html-ts-mode.el
+++ b/lisp/textmodes/html-ts-mode.el
@@ -106,13 +106,10 @@ Return nil if there is no name or if NODE is not a defun
node."
(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 "tag")
(setq-local treesit-sexp-type-regexp
- (regexp-opt '("tag"
+ (regexp-opt '("element"
"text"
"attribute"
"value")))
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 @@ Return nil if there is no name or if NODE is not a defun
node."
(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 @@ Return nil if there is no name or if NODE is not a defun
node."
(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 @@
'((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 @@
(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
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 9d622de5580..5fad6b21fae 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -987,7 +987,8 @@ If LOUDLY is non-nil, display some debugging information."
(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)
@@ -2702,6 +2703,11 @@ leaves point at the end of the last line of 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'."
@@ -2713,30 +2719,46 @@ Pops up a window showing the syntax tree of the source
in the
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
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 7689d5f879f..d5e42f49825 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1303,25 +1303,6 @@ Normally, this runs \"git push\". If PROMPT is non-nil,
prompt
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 13124509c27..0890b63d417 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3071,9 +3071,20 @@ It also signals an error in a Bazaar bound branch."
(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.
diff --git a/src/fns.c b/src/fns.c
index 4ecd950b818..b356a069bda 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 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is
non-nil. */)
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);
@@ -6269,9 +6269,15 @@ When non-nil, `yes-or-no-p' will use `y-or-n-p' to read
the answer.
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);
diff --git a/src/w32.c b/src/w32.c
index 47d79abc5b0..8d344d2e6da 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,31 @@ 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);
+ }
+ 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. */
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 <emacs-PID>\" and\n"
- "\"continue\" inside GDB before clicking YES.)"
+ "\n\n(Before clicking YES, type\n"
+ "\"gdb -p <emacs-PID>\", 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:
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 @@
;; 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 "<!doctype html><html><head>"
+ "The beginning of a minimal HTML document.")
+
+(defconst sgml-html-meta-post "</head></html>"
+ "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 '<meta>'
+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 "<meta charset='%s'>" 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 '</head>', 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"
+ "<meta charset='utf-8'>"))))))
+
+(ert-deftest sgml-html-meta-no-post-10lines ()
+ "No '</head>', 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"
+ "<meta charset='utf-8'>"))))))
+
+(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.
diff --git a/test/lisp/net/tramp-archive-tests.el
b/test/lisp/net/tramp-archive-tests.el
index 8fe1dbd8d0b..94ef40a1116 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -685,6 +685,7 @@ This tests also `access-file', `file-readable-p' and
`file-regular-p'."
;; 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)))
@@ -775,12 +776,14 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
(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 0932a53f4b1..59e160c9d71 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -165,6 +165,9 @@ A resource file is in the resource directory as per
;; 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)))))
@@ -3513,6 +3516,9 @@ This tests also `access-file', `file-readable-p',
(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
@@ -3597,7 +3603,7 @@ This tests also `access-file', `file-readable-p',
(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))
@@ -3936,7 +3942,10 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(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
@@ -3987,6 +3996,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(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)
@@ -4000,6 +4011,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(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)))
@@ -4061,9 +4074,11 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(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)))
@@ -4073,6 +4088,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(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)))
@@ -4087,6 +4103,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(funcall (if quoted #'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)
@@ -4096,6 +4113,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(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.
@@ -4124,6 +4142,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(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)
@@ -4154,6 +4174,12 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(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))
+ (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.
@@ -4161,9 +4187,15 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(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.
@@ -4900,13 +4932,10 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(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 <CR><NUL> 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 <CR><NUL> 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.
@@ -5190,14 +5219,10 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(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 <CR><NUL> 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 <CR><NUL> 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.
@@ -7043,6 +7068,9 @@ This requires restrictions of file name syntax."
;; 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))
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-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)
=-=
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 @@
(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")))
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 @@ foo3 =
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:
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index b7715a280a6..aa710519825 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -226,6 +226,7 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046."
(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 ()
@@ -430,6 +431,38 @@ g .. h foo
(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. <sigh>
+ (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-set-after-menus ()
+ (let ((map (make-sparse-keymap)))
+ (keymap-set map "<cmd1>"
+ '(menu-item "Run Command 1" keymap-tests--command-1
+ :help "Command 1 Help"))
+ (keymap-set-after map "<cmd2>"
+ '(menu-item "Run Command 2" keymap-tests--command-2
+ :help "Command 2 Help"))
+ (keymap-set-after map "<cmd3>"
+ '(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