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-02-02 10:11:32 +08:00
commit 7b43566a28
17 changed files with 416 additions and 86 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
doc/misc/transient.texi
View file

@ -64,6 +64,15 @@ reading a new value in the minibuffer.
Calling a suffix command usually causes the transient to be exited
but suffix commands can also be configured to not exit the transient.
@quotation
The second part of this manual, which describes how to modify existing
transients and create new transients from scratch, can be hard to
digest if you are just getting started. A useful resource to get over
that hurdle is Psionic K's interactive tutorial, available at
@uref{https://github.com/positron-solutions/transient-showcase}.
@end quotation
@noindent
This manual is for Transient version 0.3.7.50.
@ -893,7 +902,16 @@ same customization.
To an extent, transients can be customized interactively, see
@ref{Enabling and Disabling Suffixes}. This section explains how existing
transients can be further modified non-interactively.
transients can be further modified non-interactively. Let's begin
with an example:
@lisp
(transient-append-suffix 'magit-patch-apply "-3"
'("-R" "Apply in reverse" "--reverse"))
@end lisp
This inserts a new infix argument to toggle the @code{--reverse} argument
after the infix argument that toggles @code{-3} in @code{magit-patch-apply}.
The following functions share a few arguments:

58
lisp/eshell/em-cmpl.el
View file

@ -306,6 +306,12 @@ to writing a completion function."
(insert-and-inherit "\t")
(throw 'pcompleted t)))
(defun eshell-complete--eval-argument-form (arg)
"Evaluate a single Eshell argument form ARG for the purposes of completion."
(let ((result (eshell-do-eval `(eshell-commands ,arg) t)))
(cl-assert (eq (car result) 'quote))
(cadr result)))
(defun eshell-complete-parse-arguments ()
"Parse the command line arguments for `pcomplete-argument'."
(when (and eshell-no-completion-during-jobs
@ -344,11 +350,6 @@ to writing a completion function."
(cl-assert (= (length args) (length posns)))
(let ((a args) (i 0) new-start)
(while a
;; Remove any top-level `eshell-splice-args' sigils. These
;; are meant to be rewritten and can't actually be called.
(when (and (consp (car a))
(eq (caar a) 'eshell-splice-args))
(setcar a (cadar a)))
;; If there's an unreplaced `eshell-operator' sigil, consider
;; the token after it the new start of our arguments.
(when (and (consp (car a))
@ -364,23 +365,40 @@ to writing a completion function."
(not (eq (char-before (1- end)) ?\\)))
(nconc args (list ""))
(nconc posns (list (point))))
;; Evaluate and expand Eshell forms.
(let (evaled-args evaled-posns)
(cl-mapc
(lambda (arg posn)
(pcase arg
(`(eshell-splice-args ,val)
(dolist (subarg (eshell-complete--eval-argument-form val))
(push subarg evaled-args)
(push posn evaled-posns)))
((pred listp)
(push (eshell-complete--eval-argument-form arg) evaled-args)
(push posn evaled-posns))
(_
(push arg evaled-args)
(push posn evaled-posns))))
args posns)
(setq args (nreverse evaled-args)
posns (nreverse evaled-posns)))
;; Convert arguments to forms that Pcomplete can understand.
(cons (mapcar
(lambda (arg)
(let ((val
(if (listp arg)
(let ((result
(eshell-do-eval
(list 'eshell-commands arg) t)))
(cl-assert (eq (car result) 'quote))
(cadr result))
arg)))
(cond ((numberp val)
(setq val (number-to-string val)))
;; expand .../ etc that only eshell understands to
;; standard ../../
((and (stringp val)) (string-match "\\.\\.\\.+/" val)
(setq val (eshell-expand-multiple-dots val))))
(or val "")))
(pcase arg
;; Expand ".../" etc that only Eshell understands to
;; the standard "../../".
((rx ".." (+ ".") "/")
(propertize (eshell-expand-multiple-dots arg)
'pcomplete-arg-value arg))
((pred stringp)
arg)
('nil
(propertize "" 'pcomplete-arg-value arg))
(_
(propertize (eshell-stringify arg)
'pcomplete-arg-value arg))))
args)
posns)))

2
lisp/eshell/esh-cmd.el
View file

@ -343,7 +343,7 @@ This only returns external (non-Lisp) processes."
#'eshell-complete-lisp-symbols nil t)))
(defun eshell-complete-lisp-symbols ()
"If there is a user reference, complete it."
"If there is a Lisp symbol, complete it."
(let ((arg (pcomplete-actual-arg)))
(when (string-match (concat "\\`" eshell-lisp-regexp) arg)
(setq pcomplete-stub (substring arg (match-end 0))

7
lisp/gnus/gnus-search.el
View file

@ -1330,9 +1330,10 @@ elements are present."
(1- nyear)
nyear))
(setq dmonth 1))))
(format-time-string
"%e-%b-%Y"
(encode-time 0 0 0 dday dmonth dyear))))
(with-locale-environment "C"
(format-time-string
"%e-%b-%Y"
(encode-time 0 0 0 dday dmonth dyear)))))
(cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap)
(str string))

9
lisp/isearch.el
View file

@ -2784,6 +2784,7 @@ With argument, add COUNT copies of the character."
(mapconcat 'isearch-text-char-description
string ""))))))))
(defvar emoji--derived)
(defun isearch-emoji-by-name (&optional count)
"Read an Emoji name and add it to the search string COUNT times.
COUNT (interactively, the prefix argument) defaults to 1.
@ -2792,7 +2793,13 @@ The command accepts Unicode names like \"smiling face\" or
(interactive "p")
(with-isearch-suspended
(let ((emoji (with-temp-buffer
(emoji-search)
;; Derived emoji not supported yet (bug#60740).
;; So first load `emoji--labels', then `emoji--init'
;; will not fill `emoji--derived' that is set
;; to an empty hash table below.
(ignore-errors (require 'emoji-labels))
(let ((emoji--derived (make-hash-table :test #'equal)))
(emoji-search))
(if (and (integerp count) (> count 1))
(apply 'concat (make-list count (buffer-string)))
(buffer-string)))))

2
lisp/keymap.el
View file

@ -107,7 +107,7 @@ If REMOVE (interactively, the prefix arg), remove the binding
instead of unsetting it. See `keymap-unset' for details."
(declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
(interactive
(list (key-description (read-key-sequence "Set key locally: "))
(list (key-description (read-key-sequence "Unset key globally: "))
current-prefix-arg))
(keymap-unset (current-global-map) key remove))

76
lisp/ldefs-boot.el
View file

@ -2918,13 +2918,18 @@ and corresponding effects.
(register-definition-prefixes "semantic/bovine/c" '("semantic"))
;;; Generated autoloads from progmodes/c-ts-common.el
(register-definition-prefixes "c-ts-common" '("c-ts-"))
;;; Generated autoloads from progmodes/c-ts-mode.el
(autoload 'c-ts-base-mode "c-ts-mode" "\
Major mode for editing C, powered by tree-sitter.
\\{c-ts-mode-map}
\\{c-ts-base-mode-map}
(fn)" t)
(autoload 'c-ts-mode "c-ts-mode" "\
@ -2932,14 +2937,47 @@ 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.
`c-basic-offset', doesn't affect this mode.
To use tree-sitter C/C++ modes by default, evaluate
(add-to-list \\='major-mode-remap-alist \\='(c-mode . c-ts-mode))
(add-to-list \\='major-mode-remap-alist \\='(c++-mode . c++-ts-mode))
(add-to-list \\='major-mode-remap-alist
\\='(c-or-c++-mode . c-or-c++-ts-mode))
in your configuration.
(fn)" t)
(autoload 'c++-ts-mode "c-ts-mode" "\
Major mode for editing C++, powered by tree-sitter.
This mode is independent from the classic cc-mode.el based
`c++-mode', so configuration variables of that mode, like
`c-basic-offset', don't affect this mode.
To use tree-sitter C/C++ modes by default, evaluate
(add-to-list \\='major-mode-remap-alist \\='(c-mode . c-ts-mode))
(add-to-list \\='major-mode-remap-alist \\='(c++-mode . c++-ts-mode))
(add-to-list \\='major-mode-remap-alist
\\='(c-or-c++-mode . c-or-c++-ts-mode))
in your configuration.
(fn)" t)
(register-definition-prefixes "c-ts-mode" '("c-ts-mode-"))
(autoload 'c-or-c++-ts-mode "c-ts-mode" "\
Analyze buffer and enable either C or C++ mode.
Some people and projects use .h extension for C++ header files
which is also the one used for C header files. This makes
matching on file name insufficient for detecting major mode that
should be used.
This function attempts to use file contents to determine whether
the code is C or C++ and based on that chooses whether to enable
`c-ts-mode' or `c++-ts-mode'." t)
(register-definition-prefixes "c-ts-mode" '("c-ts-"))
;;; Generated autoloads from calendar/cal-bahai.el
@ -4652,7 +4690,6 @@ For use inside Lisp programs, see also `c-macro-expansion'.
;;; Generated autoloads from progmodes/cmake-ts-mode.el
(add-to-list 'auto-mode-alist '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode))
(autoload 'cmake-ts-mode "cmake-ts-mode" "\
Major mode for editing CMake files, powered by tree-sitter.
@ -5635,7 +5672,6 @@ with empty strings removed.
;;; Generated autoloads from progmodes/csharp-mode.el
(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode))
(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode))
(autoload 'csharp-mode "csharp-mode" "\
Major mode for editing Csharp code.
@ -8011,7 +8047,6 @@ it is disabled.
;;; Generated autoloads from progmodes/dockerfile-ts-mode.el
(add-to-list 'auto-mode-alist '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . dockerfile-ts-mode))
(autoload 'dockerfile-ts-mode "dockerfile-ts-mode" "\
Major mode for editing Dockerfiles, powered by tree-sitter.
@ -9157,7 +9192,7 @@ Turn on EDT Emulation." t)
;;; Generated autoloads from progmodes/eglot.el
(push (purecopy '(eglot 1 10)) package--builtin-versions)
(push (purecopy '(eglot 1 11)) package--builtin-versions)
(autoload 'eglot "eglot" "\
Start LSP server in support of PROJECT's buffers under MANAGED-MAJOR-MODE.
@ -9195,7 +9230,7 @@ described in `eglot-server-programs', which see.
LANGUAGE-ID is the language ID string to send to the server for
MANAGED-MAJOR-MODE, which matters to a minority of servers.
INTERACTIVE is t if called interactively.
INTERACTIVE is ignored and provided for backward compatibility.
(fn MANAGED-MAJOR-MODE PROJECT CLASS CONTACT LANGUAGE-ID &optional INTERACTIVE)" t)
(autoload 'eglot-ensure "eglot" "\
@ -14368,12 +14403,12 @@ Add the window configuration CONF to `gnus-buffer-configuration'.
;;; Generated autoloads from progmodes/go-ts-mode.el
(add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode))
(autoload 'go-ts-mode "go-ts-mode" "\
Major mode for editing Go, powered by tree-sitter.
\\{go-ts-mode-map}
(fn)" t)
(add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode))
(autoload 'go-mod-ts-mode "go-ts-mode" "\
Major mode for editing go.mod files, powered by tree-sitter.
@ -16204,6 +16239,15 @@ values.
(register-definition-prefixes "semantic/html" '("semantic-"))
;;; Generated autoloads from textmodes/html-ts-mode.el
(autoload 'html-ts-mode "html-ts-mode" "\
Major mode for editing Html, powered by tree-sitter.
(fn)" t)
(register-definition-prefixes "html-ts-mode" '("html-ts-mode-"))
;;; Generated autoloads from htmlfontify.el
@ -25121,7 +25165,7 @@ Open profile FILENAME.
;;; Generated autoloads from progmodes/project.el
(push (purecopy '(project 0 9 4)) package--builtin-versions)
(push (purecopy '(project 0 9 6)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@ -27362,6 +27406,7 @@ Major mode for editing Ruby code.
;;; Generated autoloads from progmodes/ruby-ts-mode.el
(push (purecopy '(ruby-ts-mode 0 2)) package--builtin-versions)
(autoload 'ruby-ts-mode "ruby-ts-mode" "\
Major mode for editing Ruby, powered by tree-sitter.
@ -27397,7 +27442,6 @@ it is disabled.
;;; Generated autoloads from progmodes/rust-ts-mode.el
(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode))
(autoload 'rust-ts-mode "rust-ts-mode" "\
Major mode for editing Rust, powered by tree-sitter.
@ -33066,8 +33110,6 @@ FRAC should be the inverse of the fractional value; for example, a value of
;;; Generated autoloads from progmodes/typescript-ts-mode.el
(add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode))
(add-to-list 'auto-mode-alist '("\\.tsx\\'" . tsx-ts-mode))
(autoload 'typescript-ts-base-mode "typescript-ts-mode" "\
Major mode for editing TypeScript.
@ -33808,7 +33850,7 @@ is \"www.fsf.co.uk\".
;;; Generated autoloads from use-package/use-package.el
(push (purecopy '(use-package 2 4 4)) package--builtin-versions)
(push (purecopy '(use-package 2 4 5)) package--builtin-versions)
;;; Generated autoloads from use-package/use-package-bind-key.el
@ -34415,7 +34457,8 @@ On a distributed version control system, this runs a \"pull\"
operation on the current branch, prompting for the precise
command if required. Optional prefix ARG non-nil forces a prompt
for the VCS command to run. If this is successful, a \"push\"
operation will then be done.
operation will then be done. This is supported only in backends
where the pull operation returns a process.
On a non-distributed version control system, this signals an error.
It also signals an error in a Bazaar bound branch.
@ -37012,7 +37055,6 @@ a new xwidget-webkit session, otherwise use an existing session.
;;; Generated autoloads from textmodes/yaml-ts-mode.el
(add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode))
(autoload 'yaml-ts-mode "yaml-ts-mode" "\
Major mode for editing YAML, powered by tree-sitter.

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

@ -3003,13 +3003,21 @@ implementation will be used."
(process-put p 'remote-pid pid)
(tramp-set-connection-property
p "remote-pid" pid))
;; Disable carriage return to newline
;; translation. This does not work on
;; macOS, see Bug#50748.
(when (and (memq connection-type '(nil pipe))
(not
(tramp-check-remote-uname v "Darwin")))
(tramp-send-command v "stty -icrnl"))
(when (memq connection-type '(nil pipe))
;; Disable carriage return to newline
;; translation. This does not work on
;; macOS, see Bug#50748.
;; We must also disable buffering,
;; otherwise strings larger than 4096
;; bytes, sent by the process, could
;; block, see termios(3) and
;; <https://github.com/emacs-lsp/lsp-mode/issues/2375#issuecomment-1407272718>.
;; FIXME: Shall we rather use "stty raw"?
(if (tramp-check-remote-uname v "Darwin")
(tramp-send-command
v "stty -icanon min 1 time 0")
(tramp-send-command
v "stty -icrnl -icanon min 1 time 0")))
;; `tramp-maybe-open-connection' and
;; `tramp-send-command-and-read' could
;; have trashed the connection buffer.

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

@ -697,8 +697,8 @@ the semicolon. This function skips the semicolon."
;;; Modes
(defvar-keymap c-ts-mode-map
:doc "Keymap for the C language with tree-sitter"
(defvar-keymap c-ts-base-mode-map
:doc "Keymap for C and C-like languages with tree-sitter"
:parent prog-mode-map
"C-c C-q" #'c-ts-mode-indent-defun
"C-c ." #'c-ts-mode-set-style)
@ -707,7 +707,7 @@ the semicolon. This function skips the semicolon."
(define-derived-mode c-ts-base-mode prog-mode "C"
"Major mode for editing C, powered by tree-sitter.
\\{c-ts-mode-map}"
\\{c-ts-base-mode-map}"
:syntax-table c-ts-mode--syntax-table
;; Navigation.

7
lisp/progmodes/cc-defs.el
View file

@ -1994,7 +1994,7 @@ when it's needed. The default is the current language taken from
;; doesn't occur in any word in LIST. Append it to all
;; the alternatives where we want to add \>. Run through
;; `regexp-opt' and then replace it with \>.
(let ((unique "") pos)
(let ((unique "") (list1 (copy-tree list)) pos)
(while (let (found)
(setq unique (concat unique "@")
pos list)
@ -2005,13 +2005,12 @@ when it's needed. The default is the current language taken from
t))
(setq pos (cdr pos)))
found))
(setq pos (copy-tree list)
)
(setq pos list1)
(while pos
(if (string-match "\\w\\'" (car pos))
(setcar pos (concat (car pos) unique)))
(setq pos (cdr pos)))
(setq re (regexp-opt list))
(setq re (regexp-opt list1))
(setq pos 0)
(while (string-match unique re pos)
(setq pos (+ (match-beginning 0) 2)

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

@ -1042,9 +1042,12 @@ leading double colon is not added."
"parenthesized_statements"
"if"
"case"
"when"
"block"
"do_block"
"begin")))
"begin"
"binary"
"assignment")))
;; AFAIK, Ruby can not nest methods
(setq-local treesit-defun-prefer-top-level nil)

40
lisp/transient.el
View file

@ -798,8 +798,8 @@ They become the value of this argument.")
(defclass transient-columns (transient-group) ()
"Group class that displays elements organized in columns.
Direct elements have to be groups whose elements have to be
commands or string. Each subgroup represents a column. This
class takes care of inserting the subgroups' elements.")
commands or strings. Each subgroup represents a column.
This class takes care of inserting the subgroups' elements.")
(defclass transient-subgroups (transient-group) ()
"Group class that wraps other groups.
@ -860,7 +860,7 @@ to the setup function:
(indent defun)
(doc-string 3))
(pcase-let ((`(,class ,slots ,suffixes ,docstr ,body)
(transient--expand-define-args args)))
(transient--expand-define-args args arglist)))
`(progn
(defalias ',name
,(if body
@ -913,7 +913,7 @@ ARGLIST. The infix arguments are usually accessed by using
(indent defun)
(doc-string 3))
(pcase-let ((`(,class ,slots ,_ ,docstr ,body)
(transient--expand-define-args args)))
(transient--expand-define-args args arglist)))
`(progn
(defalias ',name (lambda ,arglist ,@body))
(put ',name 'interactive-only t)
@ -921,7 +921,7 @@ ARGLIST. The infix arguments are usually accessed by using
(put ',name 'transient--suffix
(,(or class 'transient-suffix) :command ',name ,@slots)))))
(defmacro transient-define-infix (name _arglist &rest args)
(defmacro transient-define-infix (name arglist &rest args)
"Define NAME as a transient infix command.
ARGLIST is always ignored and reserved for future use.
@ -962,7 +962,7 @@ keyword.
(indent defun)
(doc-string 3))
(pcase-let ((`(,class ,slots ,_ ,docstr ,_)
(transient--expand-define-args args)))
(transient--expand-define-args args arglist)))
`(progn
(defalias ',name ,(transient--default-infix-command))
(put ',name 'interactive-only t)
@ -980,7 +980,9 @@ example, sets a variable use `transient-define-infix' instead.
\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)")
(defun transient--expand-define-args (args)
(defun transient--expand-define-args (args &optional arglist)
(unless (listp arglist)
(error "Mandatory ARGLIST is missing"))
(let (class keys suffixes docstr)
(when (stringp (car args))
(setq docstr (pop args)))
@ -1150,7 +1152,7 @@ example, sets a variable use `transient-define-infix' instead.
PREFIX is a prefix command, a symbol.
SUFFIX is a suffix command or a group specification (of
the same forms as expected by `transient-define-prefix').
Intended for use in PREFIX's `:setup-children' function."
Intended for use in a group's `:setup-children' function."
(eval (car (transient--parse-child prefix suffix))))
(defun transient-parse-suffixes (prefix suffixes)
@ -1158,7 +1160,7 @@ Intended for use in PREFIX's `:setup-children' function."
PREFIX is a prefix command, a symbol.
SUFFIXES is a list of suffix command or a group specification
(of the same forms as expected by `transient-define-prefix').
Intended for use in PREFIX's `:setup-children' function."
Intended for use in a group's `:setup-children' function."
(mapcar (apply-partially #'transient-parse-suffix prefix) suffixes))
;;; Edit
@ -1469,14 +1471,24 @@ probably use this instead:
(cl-check-type command command))
(if (or transient--prefix
transient-current-prefix)
(cl-find-if (lambda (obj)
(eq (transient--suffix-command obj)
(let ((suffixes
(cl-remove-if-not
(lambda (obj)
(eq (transient--suffix-command obj)
(or command
;; When `this-command' is `transient-set-level',
;; its reader needs to know what command is being
;; configured.
(or command this-original-command)))
(or transient--suffixes
transient-current-suffixes))
this-original-command)))
(or transient--suffixes
transient-current-suffixes))))
(or (and (cdr suffixes)
(cl-find-if
(lambda (obj)
(equal (listify-key-sequence (transient--kbd (oref obj key)))
(listify-key-sequence (this-command-keys))))
suffixes))
(car suffixes)))
(when-let* ((obj (get (or command this-command) 'transient--suffix))
(obj (clone obj)))
;; Cannot use and-let* because of debbugs#31840.

15
lisp/treesit.el
View file

@ -86,7 +86,6 @@
(declare-function treesit-search-subtree "treesit.c")
(declare-function treesit-search-forward "treesit.c")
(declare-function treesit-subtree-stat "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-subtree-stat "treesit.c")
@ -267,14 +266,12 @@ If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED."
Use the first parser in the parser list if LANGUAGE is omitted.
If LANGUAGE is non-nil, use the first parser for LANGUAGE in the
parser list, or create one if none exists."
;; Otherwise the incremental build is broken without tree-sitter.
(when (treesit-available-p)
(if-let ((parser
(if language
(treesit-parser-create language)
(or (car (treesit-parser-list))
(signal 'treesit-no-parser (list (current-buffer)))))))
(treesit-parser-root-node parser))))
(if-let ((parser
(if language
(treesit-parser-create language)
(or (car (treesit-parser-list))
(signal 'treesit-no-parser (list (current-buffer)))))))
(treesit-parser-root-node parser)))
(defun treesit-filter-child (node pred &optional named)
"Return children of NODE that satisfies predicate PRED.

4
src/dispnew.c
View file

@ -5016,6 +5016,10 @@ update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p,
}
while (row > top && col == 0);
/* We exit the loop with COL at the glyph _after_ the last one. */
if (col > 0)
col--;
/* Make sure COL is not out of range. */
if (col >= FRAME_CURSOR_X_LIMIT (f))
{

12
src/treesit.c
View file

@ -2720,8 +2720,10 @@ the query. */)
every for loop and nconc it to RESULT every time. That is indeed
the initial implementation in which Yoav found nconc being the
bottleneck (98.4% of the running time spent on nconc). */
uint32_t patterns_count = ts_query_pattern_count (treesit_query);
Lisp_Object result = Qnil;
Lisp_Object prev_result = result;
Lisp_Object predicates_table = make_vector (patterns_count, Qt);
while (ts_query_cursor_next_match (cursor, &match))
{
/* Record the checkpoint that we may roll back to. */
@ -2750,9 +2752,13 @@ the query. */)
result = Fcons (cap, result);
}
/* Get predicates. */
Lisp_Object predicates
= treesit_predicates_for_pattern (treesit_query,
match.pattern_index);
Lisp_Object predicates = AREF (predicates_table, match.pattern_index);
if (EQ (predicates, Qt))
{
predicates = treesit_predicates_for_pattern (treesit_query,
match.pattern_index);
ASET (predicates_table, match.pattern_index, predicates);
}
/* captures_lisp = Fnreverse (captures_lisp); */
struct capture_range captures_range = { result, prev_result };

208
test/lisp/eshell/em-cmpl-tests.el Normal file
View file

@ -0,0 +1,208 @@
;;; em-cmpl-tests.el --- em-cmpl test suite -*- lexical-binding:t -*-
;; Copyright (C) 2023 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Tests for Eshell's interactive completion.
;;; Code:
(require 'ert)
(require 'eshell)
(require 'em-cmpl)
(require 'em-dirs)
(require 'em-hist)
(require 'em-tramp)
(require 'em-unix)
(require 'eshell-tests-helpers
(expand-file-name "eshell-tests-helpers"
(file-name-directory (or load-file-name
default-directory))))
(defvar eshell-test-value nil)
(defun eshell-insert-and-complete (input)
"Insert INPUT and invoke completion, returning the result."
(insert input)
(completion-at-point)
(eshell-get-old-input))
(defun eshell-arguments-equal (actual expected)
"Return t if ACTUAL and EXPECTED are equal, including properties of strings.
ACTUAL and EXPECTED should both be lists of strings."
(when (length= actual (length expected))
(catch 'not-equal
(cl-mapc (lambda (i j)
(unless (equal-including-properties i j)
(throw 'not-equal nil)))
actual expected)
t)))
(defun eshell-arguments-equal--equal-explainer (actual expected)
"Explain the result of `eshell-arguments-equal'."
`(nonequal-result
(actual ,actual)
(expected ,expected)))
(put 'eshell-arguments-equal 'ert-explainer
#'eshell-arguments-equal--equal-explainer)
;;; Tests:
(ert-deftest em-cmpl-test/parse-arguments/pipeline ()
"Test that parsing arguments for completion discards earlier commands."
(with-temp-eshell
(let ((eshell-test-value '("foo" "bar")))
(insert "echo hi | cat")
(should (eshell-arguments-equal
(car (eshell-complete-parse-arguments))
'("cat"))))))
(ert-deftest em-cmpl-test/parse-arguments/multiple-dots ()
"Test parsing arguments with multiple dots like \".../\"."
(with-temp-eshell
(insert "echo .../file.txt")
(should (eshell-arguments-equal
(car (eshell-complete-parse-arguments))
`("echo" ,(propertize "../../file.txt"
'pcomplete-arg-value
".../file.txt"))))))
(ert-deftest em-cmpl-test/parse-arguments/variable/numeric ()
"Test parsing arguments with a numeric variable interpolation."
(with-temp-eshell
(let ((eshell-test-value 42))
(insert "echo $eshell-test-value")
(should (eshell-arguments-equal
(car (eshell-complete-parse-arguments))
`("echo" ,(propertize "42" 'pcomplete-arg-value 42)))))))
(ert-deftest em-cmpl-test/parse-arguments/variable/nil ()
"Test parsing arguments with a nil variable interpolation."
(with-temp-eshell
(let ((eshell-test-value nil))
(insert "echo $eshell-test-value")
(should (eshell-arguments-equal
(car (eshell-complete-parse-arguments))
`("echo" ,(propertize "" 'pcomplete-arg-value nil)))))))
(ert-deftest em-cmpl-test/parse-arguments/variable/list ()
"Test parsing arguments with a list variable interpolation."
(with-temp-eshell
(let ((eshell-test-value '("foo" "bar")))
(insert "echo $eshell-test-value")
(should (eshell-arguments-equal
(car (eshell-complete-parse-arguments))
`("echo" ,(propertize "(\"foo\" \"bar\")"
'pcomplete-arg-value
eshell-test-value)))))))
(ert-deftest em-cmpl-test/parse-arguments/variable/splice ()
"Test parsing arguments with a spliced variable interpolation."
(with-temp-eshell
(let ((eshell-test-value '("foo" "bar")))
(insert "echo $@eshell-test-value")
(should (eshell-arguments-equal
(car (eshell-complete-parse-arguments))
'("echo" "foo" "bar"))))))
(ert-deftest em-cmpl-test/file-completion/unique ()
"Test completion of file names when there's a unique result."
(with-temp-eshell
(ert-with-temp-directory default-directory
(write-region nil nil (expand-file-name "file.txt"))
(should (equal (eshell-insert-and-complete "echo fi")
"echo file.txt ")))))
(ert-deftest em-cmpl-test/file-completion/non-unique ()
"Test completion of file names when there are multiple results."
(with-temp-eshell
(ert-with-temp-directory default-directory
(write-region nil nil (expand-file-name "file.txt"))
(write-region nil nil (expand-file-name "file.el"))
(should (equal (eshell-insert-and-complete "echo fi")
"echo file."))
;; Now try completing again.
(let ((minibuffer-message-timeout 0)
(inhibit-message t))
(completion-at-point))
;; FIXME: We can't use `current-message' here.
(with-current-buffer (messages-buffer)
(save-excursion
(goto-char (point-max))
(forward-line -1)
(should (looking-at "Complete, but not unique")))))))
(ert-deftest em-cmpl-test/file-completion/after-list ()
"Test completion of file names after previous list arguments.
See bug#59956."
(with-temp-eshell
(ert-with-temp-directory default-directory
(write-region nil nil (expand-file-name "file.txt"))
(should (equal (eshell-insert-and-complete "echo (list 1 2) fi")
"echo (list 1 2) file.txt ")))))
(ert-deftest em-cmpl-test/lisp-symbol-completion ()
"Test completion of Lisp forms like \"#'symbol\" and \"`symbol\".
See <lisp/eshell/esh-cmd.el>."
(with-temp-eshell
(should (equal (eshell-insert-and-complete "echo #'system-nam")
"echo #'system-name ")))
(with-temp-eshell
(should (equal (eshell-insert-and-complete "echo `system-nam")
"echo `system-name "))))
(ert-deftest em-cmpl-test/lisp-function-completion ()
"Test completion of Lisp forms like \"(func)\".
See <lisp/eshell/esh-cmd.el>."
(with-temp-eshell
(should (equal (eshell-insert-and-complete "echo (eshell/ech")
"echo (eshell/echo"))))
(ert-deftest em-cmpl-test/variable-ref-completion ()
"Test completion of variable references like \"$var\".
See <lisp/eshell/esh-var.el>."
(with-temp-eshell
(should (equal (eshell-insert-and-complete "echo $system-nam")
"echo $system-name "))))
(ert-deftest em-cmpl-test/variable-assign-completion ()
"Test completion of variable assignments like \"var=value\".
See <lisp/eshell/esh-var.el>."
(with-temp-eshell
(ert-with-temp-directory default-directory
(write-region nil nil (expand-file-name "file.txt"))
(should (equal (eshell-insert-and-complete "VAR=f")
"VAR=file.txt ")))))
(ert-deftest em-cmpl-test/user-ref-completion ()
"Test completeion of user references like \"~user\".
See <lisp/eshell/em-dirs.el>."
(unwind-protect
(with-temp-eshell
(cl-letf (((symbol-function 'eshell-read-user-names)
(lambda () (setq eshell-user-names '((1234 . "user"))))))
;; FIXME: Should this really add a space at the end?
(should (equal (eshell-insert-and-complete "echo ~us")
"echo ~user/ "))))
;; Clear the cached user names we set above.
(setq eshell-user-names nil)))
;;; em-cmpl-tests.el ends here

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

@ -4923,6 +4923,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
;; Give the pipe process a chance to start.
(when (memq process-connection-type '(nil pipe))
(sit-for 0.1 'nodisp))
(process-send-string proc "foo\r\n")
(process-send-eof proc)
;; Read output.
@ -5194,7 +5197,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; `process-connection-type' is taken when
;; `:connection-type' is nil.
(dolist (process-connection-type
(unless connection-type '(nil pipe t pty)))
(if connection-type '(nil pipe t pty) '(nil)))
(unwind-protect
(with-temp-buffer
(setq command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
@ -5210,6 +5213,10 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(should (processp proc))
(should (equal (process-status proc) 'run))
(should (equal (process-get proc 'remote-command) command))
;; Give the pipe process a chance to start.
(when (or (eq connection-type 'pipe)
(memq process-connection-type '(nil pipe)))
(sit-for 0.1 'nodisp))
(process-send-string proc "foo\r\n")
(process-send-eof proc)
;; Read output.