procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'origin/master' into feature/android

Browse source
This commit is contained in:
Po Lu 2023-01-24 10:38:07 +08:00
commit 8acab73908
70 changed files with 1676 additions and 953 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

49
doc/emacs/custom.texi
View file

@ -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

10
doc/emacs/mini.texi
View file

@ -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)

18
doc/lispref/keymaps.texi
View file

@ -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:

10
doc/lispref/minibuf.texi
View file

@ -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.

51
doc/lispref/parsing.texi
View file

@ -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.

4
doc/misc/org.org
View file

@ -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.

14
etc/NEWS
View file

@ -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

62
etc/NEWS.29
View file

@ -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'.

2
lisp/calendar/appt.el
View file

@ -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

1
lisp/cus-start.el
View file

@ -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

2
lisp/emacs-lisp/package-vc.el
View file

@ -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))

3
lisp/erc/erc.el
View file

@ -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

5
lisp/eshell/esh-arg.el
View file

@ -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)

2
lisp/find-dired.el
View file

@ -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.

2
lisp/frame.el
View file

@ -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)))))

4
lisp/international/mule.el
View file

@ -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

15
lisp/keymap.el
View file

@ -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.

5
lisp/mh-e/mh-e.el
View file

@ -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

1
lisp/net/tramp-compat.el
View file

@ -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)

150
lisp/net/tramp-sh.el
View file

@ -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))))
"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."))))
;; 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))))))))))
(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))))
(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))))
;; 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)))))))
;; Do it yourself.
(t (tramp-file-local-name
(tramp-handle-file-truename filename))))))
;; Basic functions.

58
lisp/net/tramp-smb.el
View file

@ -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)))))
(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")))
;; 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)))
(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)

71
lisp/net/tramp-sudoedit.el
View file

@ -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)

135
lisp/net/tramp.el
View file

@ -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)

2
lisp/org/ob-core.el
View file

@ -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.

5
lisp/org/ob-ruby.el
View file

@ -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:

17
lisp/org/org-agenda.el
View file

@ -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

30
lisp/org/org-clock.el
View file

@ -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 ()

4
lisp/org/org-element.el
View file

@ -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

21
lisp/org/org-fold-core.el
View file

@ -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.

5
lisp/org/org-persist.el
View file

@ -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)

10
lisp/org/org-table.el
View file

@ -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))

2
lisp/org/org-version.el
View file

@ -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)

2
lisp/org/org.el
View file

@ -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

2
lisp/org/ox-odt.el
View file

@ -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.

4
lisp/org/ox.el
View file

@ -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&#x015b;ci")
("pt_BR" :html "&Iacute;ndice" :utf8 "Índice" :ascii "Indice")
("pt_BR" :html "&Iacute;ndice" :utf-8 "Índice" :ascii "Indice")
("ro" :default "Cuprins")
("ru" :html "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;"
:utf-8 "Содержание")

247
lisp/progmodes/c-ts-common.el Normal file
View file

@ -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

356
lisp/progmodes/c-ts-mode.el
View file

@ -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)

302
lisp/progmodes/cc-engine.el
View file

@ -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)

8
lisp/progmodes/cmake-ts-mode.el
View file

@ -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

15
lisp/progmodes/csharp-mode.el
View file

@ -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)

12
lisp/progmodes/dockerfile-ts-mode.el
View file

@ -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

45
lisp/progmodes/go-ts-mode.el
View file

@ -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

13
lisp/progmodes/java-ts-mode.el
View file

@ -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

39
lisp/progmodes/js.el
View file

@ -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"

4
lisp/progmodes/json-ts-mode.el
View file

@ -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

15
lisp/progmodes/project.el
View file

@ -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

5
lisp/progmodes/python.el
View file

@ -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

178
lisp/progmodes/ruby-mode.el
View file

@ -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

56
lisp/progmodes/ruby-ts-mode.el
View file

@ -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

14
lisp/progmodes/rust-ts-mode.el
View file

@ -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

50
lisp/progmodes/typescript-ts-mode.el
View file

@ -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

2
lisp/simple.el
View file

@ -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))

4
lisp/textmodes/css-mode.el
View file

@ -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"

7
lisp/textmodes/html-ts-mode.el
View file

@ -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")))

5
lisp/textmodes/toml-ts-mode.el
View file

@ -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

6
lisp/textmodes/yaml-ts-mode.el
View file

@ -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

62
lisp/treesit.el
View file

@ -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

19
lisp/vc/vc-git.el
View file

@ -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."

17
lisp/vc/vc.el
View file

@ -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.

16
src/fns.c
View file

@ -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);

45
src/w32.c
View file

@ -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. */

28
src/w32fns.c
View file

@ -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:

66
test/lisp/international/mule-tests.el
View file

@ -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.

3
test/lisp/net/tramp-archive-tests.el
View file

@ -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".

60
test/lisp/net/tramp-tests.el
View file

@ -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))

93
test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts Normal file
View file

@ -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;
}
}
=-=-=

13
test/lisp/progmodes/c-ts-mode-resources/indent.erts
View file

@ -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)
=-=

4
test/lisp/progmodes/c-ts-mode-tests.el
View file

@ -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")))

9
test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb
View file

@ -1,3 +1,8 @@
foo = subject
.update(
1
)
foo2 =
subject.
update(
@ -10,6 +15,10 @@
2
)
my_array.select { |str| str.size > 5 }
.map { |str| str.downcase }
# Local Variables:
# ruby-method-call-indent: nil
# ruby-align-chained-calls: nil
# End:

33
test/src/keymap-tests.el
View file

@ -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