mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00
Code Issues Projects Releases Wiki Activity

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

Browse source
This commit is contained in:
Po Lu 2023-04-03 08:12:03 +08:00
commit 8bca62d552
27 changed files with 541 additions and 296 deletions
Download patch file Download diff file Expand all files Collapse all files

10
CONTRIBUTE
View file

@ -110,7 +110,7 @@ admin/notes/bug-triage.
Any change that matters to end-users should have an entry in etc/NEWS.
Try to start each NEWS entry with a sentence that summarizes the entry
and takes just one line -- this will allow to read NEWS in Outline
and takes just one line -- this will allow reading NEWS in Outline
mode after hiding the body of each entry.
Doc-strings should be updated together with the code.
@ -123,7 +123,7 @@ Think about whether your change requires updating the manuals. If you
know it does not, mark the NEWS entry with "---". If you know
that *all* the necessary documentation updates have been made as part
of your changes or those by others, mark the entry with "+++".
Otherwise do not mark it.
Otherwise, do not mark it.
If your change requires updating the manuals to document new
functions/commands/variables/faces, then use the proper Texinfo
@ -400,7 +400,7 @@ the commit to master, by starting the commit message with "Backport:".
The gitmerge function excludes these commits from the merge to the master.
Some changes should not be merged to master at all, for whatever
reasons. These should be marked by including something like "Do not
reason. These should be marked by including something like "Do not
merge to master" or anything that matches gitmerge-skip-regexp (see
admin/gitmerge.el) in the commit message.
@ -449,8 +449,8 @@ files intended for use only with Emacs version 24.5 and later.
*** Useful files in the admin/ directory
See all the files in admin/notes/* . In particular, see
admin/notes/newfile, see admin/notes/repo.
See all the files in 'admin/notes/*'. In particular, see
'admin/notes/newfile' and 'admin/notes/repo'.
The file admin/MAINTAINERS records the areas of interest of frequent
Emacs contributors. If you are making changes in one of the files

2
doc/emacs/display.texi
View file

@ -154,7 +154,7 @@ the buffer will be momentarily unfontified.
@vindex redisplay-skip-fontification-on-input
Finally, a third alternative to these variables is
@code{redisplay-skip-fontification-on-input}. If this variable is
non-@code{nil}, skip some fontifications is there's input pending.
non-@code{nil}, skip some fontifications if there's input pending.
This usually does not affect the display because redisplay is
completely skipped anyway if input was pending, but it can make
scrolling smoother by avoiding unnecessary fontification.

9
doc/lispref/customize.texi
View file

@ -378,8 +378,15 @@ the option as a Lisp variable); preferably, though, it should not
modify its value argument destructively. The default for
@var{setfunction} is @code{set-default-toplevel-value}.
If defined, @var{setfunction} will also be called when evaluating a
@code{defcustom} form with @kbd{C-M-x} in Emacs Lisp mode and when the
@var{option}'s value is changed via the @code{setopt} macro
(@pxref{Setting Variables, setopt}).
If you specify this keyword, the variable's documentation string
should describe how to do the same job in hand-written Lisp code.
should describe how to do the same job in hand-written Lisp code,
either by invoking @var{setfunction} directly or by using
@code{setopt}.
@item :get @var{getfunction}
@kindex get@r{, @code{defcustom} keyword}

25
doc/lispref/text.texi
View file

@ -3765,18 +3765,19 @@ Consecutive characters with the same @code{field} property constitute a
@item cursor
@kindex cursor @r{(text property)}
Normally, the cursor is displayed at the beginning or the end of any
overlay and text property strings present at the current buffer
position. You can instead tell Emacs to place the cursor on any
desired character of these strings by giving that character a
non-@code{nil} @code{cursor} text property. In addition, if the value
of the @code{cursor} property is an integer, it specifies the number
of buffer's character positions, starting with the position where the
overlay or the @code{display} property begins, for which the cursor
should be displayed on that character. Specifically, if the value of
the @code{cursor} property of a character is the number @var{n}, the
cursor will be displayed on this character for any buffer position in
the range @code{[@var{ovpos}..@var{ovpos}+@var{n})}, where @var{ovpos}
is the overlay's starting position given by @code{overlay-start}
overlay and text property strings that ``hide'' (i.e., are displayed
instead of) the current buffer position. You can instead tell Emacs
to place the cursor on any desired character of these strings by
giving that character a non-@code{nil} @code{cursor} text property.
In addition, if the value of the @code{cursor} property is an integer,
it specifies the number of buffer's character positions, starting with
the position where the overlay or the @code{display} property begins,
for which the cursor should be displayed on that character.
Specifically, if the value of the @code{cursor} property of a
character is the number @var{n}, the cursor will be displayed on this
character for any buffer position in the range
@code{[@var{ovpos}..@var{ovpos}+@var{n})}, where @var{ovpos} is the
overlay's starting position given by @code{overlay-start}
(@pxref{Managing Overlays}), or the position where the @code{display}
text property begins in the buffer.

9
doc/misc/tramp.texi
View file

@ -2383,10 +2383,11 @@ This uses also the settings in @code{tramp-sh-extra-args}.
@vindex RemoteCommand@r{, ssh option}
@strong{Note}: If you use an @option{ssh}-based method for connection,
do @emph{not} set the @option{RemoteCommand} option in your
@command{ssh} configuration, for example to @command{screen}. On the
other hand, some @option{ssh}-based methods, like @option{sshx} or
@option{scpx}, silently overwrite a @option{RemoteCommand} option of
the configuration file.
@command{ssh} configuration to something like @command{screen}. If
used, @option{RemoteCommand} must open an interactive shell on the
remote host. On the other hand, some @option{ssh}-based methods, like
@option{sshx} or @option{scpx}, silently overwrite a
@option{RemoteCommand} option of the configuration file.
@subsection Other remote shell setup hints

48
etc/EGLOT-NEWS
View file

@ -17,6 +17,54 @@ This refers to https://github.com/joaotavora/eglot/issues/. That is,
to look up issue github#1234, go to
https://github.com/joaotavora/eglot/issues/1234.
* Changes in upcoming Eglot 1.14
** Faster, more responsive completion
Eglot takes advantage of LSP's "isIncomplete" flag in responses to
completion requests to drive new completion-caching mechanism for the
duration of each completion session. Once a full set of completions
is obtained for a given position, the server needn't be contacted in
many scenarios, resulting in significantly less communication
overhead. This works with the popular Company package and stock
completion-at-point interfaces.
A variable 'eglot-cache-session-completions', t by default, controls
this. The mechanism was tested with ccls, jdtls, pylsp, golsp and
clangd. Notably, the C/C++ language server Clangd version 15 has a
bug in its "isIcomplete" flag (it is fixed in later versions). If you
run into problems, disable this mechanism like so:
(add-hook 'c-common-mode-hook
(lambda () (setq-local eglot-cache-session-completions nil)))
** At-point documentation less obtrusive in echo area
Eglot takes advantage of new features of ElDoc to separate short
documentation strings from large ones, sending the former to be shown in
the ElDoc's echo area and the latter to be shown in other outlets,
such as the *eldoc* buffer obtainable with 'C-h .'.
** New variable 'eglot-prefer-plaintext'
Customize this to t to opt-in to docstrings in plain text instead of
Markdown.
(bug#61373)
** Progress indicators inhabit the mode-line by default
To switch to the echo area, customize 'eglot-report-progress' to
'messages'. To switch off progress reporting completely, set to nil.
** Snippet support is easier to enable
The user needn't manually activate 'yas-minor-mode' or
'yas-global-mode'. If YASnippet is installed and the server supports
snippets, it is used automatically, unless the symbol 'yasnippet' has
been added to 'eglot-stay-out-of'.
* Changes in Eglot 1.13 (15/03/2023)

2
etc/NEWS
View file

@ -356,6 +356,8 @@ The new functions 'touch-screen-track-tap' and
'touch-screen-track-drag' handle tracking common touch screen gestures
from within a command.
** New var 'inhibit-auto-fill' to temporarily prevent auto-fill.
** Functions and variables to transpose sexps
+++

4
lisp/custom.el
View file

@ -280,7 +280,9 @@ The following keywords are meaningful:
when using the Customize user interface. It takes two arguments,
the symbol to set and the value to give it. The function should
not modify its value argument destructively. The default choice
of function is `set-default-toplevel-value'.
of function is `set-default-toplevel-value'. If this keyword is
defined, modifying the value of SYMBOL via `setopt' will call the
function specified by VALUE to install the new value.
:get VALUE should be a function to extract the value of symbol.
The function takes one argument, a symbol, and should return
the current value for that symbol. The default choice of function

41
lisp/emacs-lisp/comp.el
View file

@ -1764,27 +1764,32 @@ Return value is the fall-through block name."
(_ (signal 'native-ice
'("missing previous setimm while creating a switch")))))
(defun comp--func-arity (subr-name)
"Like `func-arity' but invariant against primitive redefinitions.
SUBR-NAME is the name of function."
(or (gethash subr-name comp-subr-arities-h)
(func-arity subr-name)))
(defun comp-emit-set-call-subr (subr-name sp-delta)
"Emit a call for SUBR-NAME.
SP-DELTA is the stack adjustment."
(let ((subr (symbol-function subr-name))
(nargs (1+ (- sp-delta))))
(let* ((arity (func-arity subr))
(minarg (car arity))
(maxarg (cdr arity)))
(when (eq maxarg 'unevalled)
(signal 'native-ice (list "subr contains unevalled args" subr-name)))
(if (eq maxarg 'many)
;; callref case.
(comp-emit-set-call (comp-callref subr-name nargs (comp-sp)))
;; Normal call.
(unless (and (>= maxarg nargs) (<= minarg nargs))
(signal 'native-ice
(list "incoherent stack adjustment" nargs maxarg minarg)))
(let* ((subr-name subr-name)
(slots (cl-loop for i from 0 below maxarg
collect (comp-slot-n (+ i (comp-sp))))))
(comp-emit-set-call (apply #'comp-call (cons subr-name slots))))))))
(let* ((nargs (1+ (- sp-delta)))
(arity (comp--func-arity subr-name))
(minarg (car arity))
(maxarg (cdr arity)))
(when (eq maxarg 'unevalled)
(signal 'native-ice (list "subr contains unevalled args" subr-name)))
(if (eq maxarg 'many)
;; callref case.
(comp-emit-set-call (comp-callref subr-name nargs (comp-sp)))
;; Normal call.
(unless (and (>= maxarg nargs) (<= minarg nargs))
(signal 'native-ice
(list "incoherent stack adjustment" nargs maxarg minarg)))
(let* ((subr-name subr-name)
(slots (cl-loop for i from 0 below maxarg
collect (comp-slot-n (+ i (comp-sp))))))
(comp-emit-set-call (apply #'comp-call (cons subr-name slots)))))))
(eval-when-compile
(defun comp-op-to-fun (x)

12
lisp/emacs-lisp/eldoc.el
View file

@ -5,7 +5,7 @@
;; Author: Noah Friedman <friedman@splode.com>
;; Keywords: extensions
;; Created: 1995-10-06
;; Version: 1.13.0
;; Version: 1.14.0
;; Package-Requires: ((emacs "26.3"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@ -448,17 +448,17 @@ documentation-displaying frontends. For example, KEY can be:
`eldoc-display-in-echo-area' and `eldoc-display-in-buffer' will
use when displaying `:thing''s value.
* `:origin', VALUE being the member of
`eldoc-documentation-functions' where DOCSTRING
originated. `eldoc-display-in-buffer' may use this organize the
documentation buffer accordingly.
* `:echo', controlling how `eldoc-display-in-echo-area' should
present this documentation item in the echo area, to save
space. If VALUE is a string, echo it instead of DOCSTRING. If
a number, only echo DOCSTRING up to that character position.
If `skip', don't echo DOCSTRING at all.
The additional KEY `:origin' is always added by ElDoc, its VALUE
being the member of `eldoc-documentation-functions' where
DOCSTRING originated. `eldoc-display-functions' may use this
information to organize display of multiple docstrings.
Finally, major modes should modify this hook locally, for
example:
(add-hook \\='eldoc-documentation-functions #\\='foo-mode-eldoc nil t)

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

@ -41,9 +41,6 @@
;; - Allow maintaining patches that are ported back onto regular
;; packages and maintained between versions.
;;
;; - Add a heuristic for guessing a `:lisp-dir' when cloning directly
;; from a URL.
;;; Code:
@ -58,7 +55,7 @@
(defgroup package-vc nil
"Manage packages from VC checkouts."
:group 'package
:link '(custom-manual "(emacs) Package from Source")
:link '(custom-manual "(emacs) Fetching Package Sources")
:prefix "package-vc-"
:version "29.1")

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

@ -421,7 +421,8 @@ hooks should be run before and after the command."
(string= (car eshell--sep-terms) ";"))
(eshell-parse-pipeline cmd)
`(eshell-do-subjob
(list ,(eshell-parse-pipeline cmd)))))
(cons :eshell-background
,(eshell-parse-pipeline cmd)))))
(setq eshell--sep-terms (cdr eshell--sep-terms))
(if eshell-in-pipeline-p
cmd
@ -893,7 +894,7 @@ This is used on systems where async subprocesses are not supported."
(set headproc nil)
(set tailproc nil)
(progn
,(if (fboundp 'make-process)
,(if eshell-supports-asynchronous-processes
`(eshell-do-pipelines ,pipeline)
`(let ((tail-handles (eshell-duplicate-handles
eshell-current-handles)))
@ -1036,7 +1037,12 @@ produced by `eshell-parse-command'."
(cadr result)))
(defun eshell-eval-command (command &optional input)
"Evaluate the given COMMAND iteratively."
"Evaluate the given COMMAND iteratively.
Return the process (or head and tail processes) created by
COMMAND, if any. If COMMAND is a background command, return the
process(es) in a cons cell like:
(:eshell-background . PROCESS)"
(if eshell-current-command
;; We can just stick the new command at the end of the current
;; one, and everything will happen as it should.
@ -1052,20 +1058,12 @@ produced by `eshell-parse-command'."
(erase-buffer)
(insert "command: \"" input "\"\n")))
(setq eshell-current-command command)
(let* ((delim (catch 'eshell-incomplete
(eshell-resume-eval)))
(val (car-safe delim)))
;; If the return value of `eshell-resume-eval' is wrapped in a
;; list, it indicates that the command was run asynchronously.
;; In that case, unwrap the value before checking the delimiter
;; value.
(if (and val
(not (eshell-processp val))
(not (eq val t)))
(error "Unmatched delimiter: %S" val)
;; Eshell-command expect a list like (<process>) to know if the
;; command should be async or not.
(or (and (eshell-processp val) delim) val)))))
(let* (result
(delim (catch 'eshell-incomplete
(ignore (setq result (eshell-resume-eval))))))
(when delim
(error "Unmatched delimiter: %S" delim))
result)))
(defun eshell-resume-command (proc status)
"Resume the current command when a process ends."

11
lisp/eshell/esh-proc.el
View file

@ -97,6 +97,9 @@ information, for example."
;;; Internal Variables:
(defvar eshell-supports-asynchronous-processes (fboundp 'make-process)
"Non-nil if Eshell can create asynchronous processes.")
(defvar eshell-current-subjob-p nil)
(defvar eshell-process-list nil
@ -296,7 +299,7 @@ Used only on systems which do not support async subprocesses.")
(coding-system-change-eol-conversion locale-coding-system
'unix))))
(cond
((fboundp 'make-process)
(eshell-supports-asynchronous-processes
(unless (or ;; FIXME: It's not currently possible to use a
;; stderr process for remote files.
(file-remote-p default-directory)
@ -367,6 +370,8 @@ Used only on systems which do not support async subprocesses.")
(erase-buffer)
(set-buffer oldbuf)
(run-hook-with-args 'eshell-exec-hook command)
;; XXX: This doesn't support sending stdout and stderr to
;; separate places.
(setq exit-status
(apply #'call-process-region
(append (list eshell-last-sync-output-start (point)
@ -392,10 +397,6 @@ Used only on systems which do not support async subprocesses.")
(setq lbeg lend)
(set-buffer proc-buf))
(set-buffer oldbuf))
(require 'esh-mode)
(declare-function eshell-update-markers "esh-mode" (pmark))
(defvar eshell-last-output-end) ;Defined in esh-mode.el.
(eshell-update-markers eshell-last-output-end)
;; Simulate the effect of eshell-sentinel.
(eshell-close-handles
(if (numberp exit-status) exit-status -1)

53
lisp/eshell/eshell.el
View file

@ -272,43 +272,38 @@ information on Eshell, see Info node `(eshell)Top'."
(declare-function eshell-add-input-to-history "em-hist" (input))
;;;###autoload
(defun eshell-command (&optional command arg)
"Execute the Eshell command string COMMAND.
With prefix ARG, insert output into the current buffer at point."
(interactive)
(unless arg
(setq arg current-prefix-arg))
(let ((eshell-non-interactive-p t))
(defun eshell-read-command (&optional prompt)
"Read an Eshell command from the minibuffer, prompting with PROMPT."
(let ((prompt (or prompt "Emacs shell command: "))
(eshell-non-interactive-p t))
;; Enable `eshell-mode' only in this minibuffer.
(minibuffer-with-setup-hook (lambda ()
(eshell-mode)
(eshell-command-mode +1))
(unless command
(setq command (read-from-minibuffer "Emacs shell command: "))
(if (eshell-using-module 'eshell-hist)
(eshell-add-input-to-history command)))))
(unless command
(error "No command specified!"))
;; redirection into the current buffer is achieved by adding an
;; output redirection to the end of the command, of the form
;; 'COMMAND >>> #<buffer BUFFER>'. This will not interfere with
;; other redirections, since multiple redirections merely cause the
;; output to be copied to multiple target locations
(if arg
(setq command
(concat command
(format " >>> #<buffer %s>"
(buffer-name (current-buffer))))))
(let ((command (read-from-minibuffer prompt)))
(when (eshell-using-module 'eshell-hist)
(eshell-add-input-to-history command))
command))))
;;;###autoload
(defun eshell-command (command &optional to-current-buffer)
"Execute the Eshell command string COMMAND.
If TO-CURRENT-BUFFER is non-nil (interactively, with the prefix
argument), then insert output into the current buffer at point."
(interactive (list (eshell-read-command)
current-prefix-arg))
(save-excursion
(let ((buf (set-buffer (generate-new-buffer " *eshell cmd*")))
(let ((stdout (if to-current-buffer (current-buffer) t))
(buf (set-buffer (generate-new-buffer " *eshell cmd*")))
(eshell-non-interactive-p t))
(eshell-mode)
(let* ((proc (eshell-eval-command
(list 'eshell-commands
(eshell-parse-command command))))
`(let ((eshell-current-handles
(eshell-create-handles ,stdout 'insert))
(eshell-current-subjob-p))
,(eshell-parse-command command))))
intr
(bufname (if (and proc (listp proc))
(bufname (if (eq (car-safe proc) :eshell-background)
"*Eshell Async Command Output*"
(setq intr t)
"*Eshell Command Output*")))
@ -326,7 +321,7 @@ With prefix ARG, insert output into the current buffer at point."
(while (and (bolp) (not (bobp)))
(delete-char -1)))
(cl-assert (and buf (buffer-live-p buf)))
(unless arg
(unless to-current-buffer
(let ((len (if (not intr) 2
(count-lines (point-min) (point-max)))))
(cond

4
lisp/help.el
View file

@ -689,6 +689,10 @@ To record all your input, use `open-dribble-file'."
(with-current-buffer standard-output
(goto-char (point-min))
(let ((comment-start ";; ")
;; Prevent 'comment-indent' from handling a single
;; semicolon as the beginning of a comment.
(comment-start-skip ";; ")
(comment-use-syntax nil)
(comment-column 24))
(while (not (eobp))
(comment-indent)

6
lisp/loadup.el
View file

@ -496,7 +496,13 @@ lost after dumping")))
;; At this point, we're ready to resume undo recording for scratch.
(buffer-enable-undo "*scratch*")
(defvar comp-subr-arities-h)
(when (featurep 'native-compile)
;; Save the arity for all primitives so the compiler can always
;; retrive it even in case of redefinition.
(mapatoms (lambda (f)
(when (subr-primitive-p (symbol-function f))
(puthash f (func-arity f) comp-subr-arities-h))))
;; Fix the compilation unit filename to have it working when
;; installed or if the source directory got moved. This is set to be
;; a pair in the form of:

13
lisp/net/eww.el
View file

@ -64,22 +64,23 @@ The action to be taken can be further customized via
:version "28.1"
:type 'regexp)
(defcustom eww-download-directory "~/Downloads/"
"Default directory where `eww' saves downloaded files."
(defcustom eww-default-download-directory "~/Downloads/"
"Default directory where `eww' saves downloaded files.
Used by `eww--download-directory', which see."
:version "29.1"
:group 'eww
:type 'directory)
(defun eww--download-directory ()
"Return the name of the EWW download directory.
The default is specified by `eww-download-directory'; however,
The default is specified by `eww-default-download-directory'; however,
if that directory doesn't exist and the DOWNLOAD XDG user directory
is defined, use the latter instead."
(or (and (file-exists-p eww-download-directory)
eww-download-directory)
(or (and (file-exists-p eww-default-download-directory)
eww-default-download-directory)
(when-let ((dir (xdg-user-dir "DOWNLOAD")))
(file-name-as-directory dir))
eww-download-directory))
eww-default-download-directory))
(defcustom eww-download-directory 'eww--download-directory
"Directory where files will downloaded.

364
lisp/progmodes/eglot.el
View file

@ -97,34 +97,29 @@
(require 'imenu)
(require 'cl-lib)
(require 'project)
(require 'url-parse)
(require 'url-util)
(require 'pcase)
(require 'compile) ; for some faces
(require 'warnings)
(require 'flymake)
(require 'xref)
(eval-when-compile
(require 'subr-x))
(require 'jsonrpc)
(require 'filenotify)
(require 'ert)
(require 'array)
(require 'external-completion)
;; ElDoc is preloaded in Emacs, so `require'-ing won't guarantee we are
;; using the latest version from GNU Elpa when we load eglot.el. Use an
;; heuristic to see if we need to `load' it in Emacs < 28.
(if (and (< emacs-major-version 28)
(not (boundp 'eldoc-documentation-strategy)))
(load "eldoc")
(require 'eldoc))
;; Similar issue as above for Emacs 26.3 and seq.el.
(if (< emacs-major-version 27)
(load "seq")
(require 'seq))
;; These dependencies are also GNU ELPA core packages. Because of
;; bug#62576, since there is a risk that M-x package-install, despite
;; having installed them, didn't correctly re-load them over the
;; built-in versions.
(eval-and-compile
(load "project")
(load "eldoc")
(load "seq")
(load "flymake")
(load "xref")
(load "jsonrpc")
(load "external-completion"))
;; forward-declare, but don't require (Emacs 28 doesn't seem to care)
(defvar markdown-fontify-code-blocks-natively)
@ -452,6 +447,10 @@ This can be useful when using docker to run a language server.")
(if (>= emacs-major-version 27) (executable-find command remote)
(executable-find command)))
(defun eglot--accepted-formats ()
(if (and (not eglot-prefer-plaintext) (fboundp 'gfm-view-mode))
["markdown" "plaintext"] ["plaintext"]))
;;; Message verification helpers
;;;
@ -782,15 +781,12 @@ treated as in `eglot--dbind'."
:tagSupport (:valueSet [1]))
:contextSupport t)
:hover (list :dynamicRegistration :json-false
:contentFormat
(if (and (not eglot-prefer-plaintext)
(fboundp 'gfm-view-mode))
["markdown" "plaintext"]
["plaintext"]))
:contentFormat (eglot--accepted-formats))
:signatureHelp (list :dynamicRegistration :json-false
:signatureInformation
`(:parameterInformation
(:labelOffsetSupport t)
:documentationFormat ,(eglot--accepted-formats)
:activeParameterSupport t))
:references `(:dynamicRegistration :json-false)
:definition (list :dynamicRegistration :json-false
@ -916,7 +912,7 @@ SERVER."
(unwind-protect
(progn
(setf (eglot--shutdown-requested server) t)
(jsonrpc-request server :shutdown nil :timeout (or timeout 1.5))
(eglot--request server :shutdown nil :timeout (or timeout 1.5))
(jsonrpc-notify server :exit nil))
;; Now ask jsonrpc.el to shut down the server.
(jsonrpc-shutdown server (not preserve-buffers))
@ -1469,6 +1465,18 @@ CONNECT-ARGS are passed as additional arguments to
(line-beginning-position n))))
"Return position of first character in current line.")
(cl-defun eglot--request (server method params &key
immediate
timeout cancel-on-input
cancel-on-input-retval)
"Like `jsonrpc-request', but for Eglot LSP requests.
Unless IMMEDIATE, send pending changes before making request."
(unless immediate (eglot--signal-textDocument/didChange))
(jsonrpc-request server method params
:timeout timeout
:cancel-on-input cancel-on-input
:cancel-on-input-retval cancel-on-input-retval))
;;; Encoding fever
;;;
@ -1633,10 +1641,9 @@ If optional MARKER, return a marker instead"
(normalized (if (and (not remote-prefix)
(eq system-type 'windows-nt)
(cl-plusp (length retval)))
(substring retval 1)
(w32-long-file-name (substring retval 1))
retval)))
(concat remote-prefix normalized))
uri)))
(defun eglot--snippet-expansion-fn ()
@ -1767,9 +1774,9 @@ and just return it. PROMPT shouldn't end with a question mark."
(defun eglot--plist-keys (plist) "Get keys of a plist."
(cl-loop for (k _v) on plist by #'cddr collect k))
(defun eglot--ensure-list (x) (if (listp x) x (list x)))
(when (fboundp 'ensure-list) ; Emacs 28 or later
(define-obsolete-function-alias 'eglot--ensure-list #'ensure-list "29.1"))
(defalias 'eglot--ensure-list
(if (fboundp 'ensure-list) #'ensure-list
(lambda (x) (if (listp x) x (list x)))))
;;; Minor modes
@ -1850,6 +1857,8 @@ Use `eglot-managed-p' to determine if current buffer is managed.")
(unless (eglot--stay-out-of-p 'xref)
(add-hook 'xref-backend-functions 'eglot-xref-backend nil t))
(add-hook 'completion-at-point-functions #'eglot-completion-at-point nil t)
(add-hook 'completion-in-region-mode-hook #'eglot--capf-session-flush nil t)
(add-hook 'company-after-completion-hook #'eglot--capf-session-flush nil t)
(add-hook 'change-major-mode-hook #'eglot--managed-mode-off nil t)
(add-hook 'post-self-insert-hook 'eglot--post-self-insert-hook nil t)
(add-hook 'pre-command-hook 'eglot--pre-command-hook nil t)
@ -1881,6 +1890,8 @@ Use `eglot-managed-p' to determine if current buffer is managed.")
(remove-hook 'after-save-hook 'eglot--signal-textDocument/didSave t)
(remove-hook 'xref-backend-functions 'eglot-xref-backend t)
(remove-hook 'completion-at-point-functions #'eglot-completion-at-point t)
(remove-hook 'completion-in-region-mode-hook #'eglot--capf-session-flush t)
(remove-hook 'company-after-completion-hook #'eglot--capf-session-flush t)
(remove-hook 'change-major-mode-hook #'eglot--managed-mode-off t)
(remove-hook 'post-self-insert-hook 'eglot--post-self-insert-hook t)
(remove-hook 'pre-command-hook 'eglot--pre-command-hook t)
@ -1904,6 +1915,7 @@ Use `eglot-managed-p' to determine if current buffer is managed.")
(defun eglot--managed-mode-off ()
"Turn off `eglot--managed-mode' unconditionally."
(remove-overlays nil nil 'eglot--overlay t)
(eglot-inlay-hints-mode -1)
(eglot--managed-mode -1))
(defun eglot-current-server ()
@ -2148,8 +2160,8 @@ still unanswered LSP requests to the server\n")))
(server command arguments)
"Execute COMMAND on SERVER with `:workspace/executeCommand'.
COMMAND is a symbol naming the command."
(jsonrpc-request server :workspace/executeCommand
`(:command ,(format "%s" command) :arguments ,arguments)))
(eglot--request server :workspace/executeCommand
`(:command ,(format "%s" command) :arguments ,arguments)))
(cl-defmethod eglot-handle-notification
(_server (_method (eql window/showMessage)) &key type message)
@ -2453,16 +2465,6 @@ Records BEG, END and PRE-CHANGE-LENGTH locally."
(run-hooks 'eglot--document-changed-hook)
(setq eglot--change-idle-timer nil))))))))
;; HACK! Launching a deferred sync request with outstanding changes is a
;; bad idea, since that might lead to the request never having a
;; chance to run, because `jsonrpc-connection-ready-p'.
(advice-add #'jsonrpc-request :before
(cl-function (lambda (_proc _method _params &key
deferred &allow-other-keys)
(when (and eglot--managed-mode deferred)
(eglot--signal-textDocument/didChange))))
'((name . eglot--signal-textDocument/didChange)))
(defvar-local eglot-workspace-configuration ()
"Configure LSP servers specifically for a given project.
@ -2615,8 +2617,8 @@ When called interactively, use the currently active server"
(when (eglot--server-capable :textDocumentSync :willSaveWaitUntil)
(ignore-errors
(eglot--apply-text-edits
(jsonrpc-request server :textDocument/willSaveWaitUntil params
:timeout 0.5))))))
(eglot--request server :textDocument/willSaveWaitUntil params
:timeout 0.5))))))
(defun eglot--signal-textDocument/didSave ()
"Maybe send textDocument/didSave to server."
@ -2728,8 +2730,8 @@ If BUFFER, switch to it before."
(propertize (alist-get kind eglot--symbol-kind-names "Unknown")
'face 'shadow))
'eglot--lsp-workspaceSymbol wss)))
(jsonrpc-request (eglot--current-server-or-lose) :workspace/symbol
`(:query ,pat)))))
(eglot--request (eglot--current-server-or-lose) :workspace/symbol
`(:query ,pat)))))
(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot)))
"Yet another tricky connection between LSP and Elisp completion semantics."
@ -2785,7 +2787,7 @@ If BUFFER, switch to it before."
(cadr (split-string (symbol-name method)
"/"))))))
(let ((response
(jsonrpc-request
(eglot--request
(eglot--current-server-or-lose)
method (append (eglot--TextDocumentPositionParams) extra-params))))
(eglot--collecting-xrefs (collect)
@ -2848,9 +2850,9 @@ If BUFFER, switch to it before."
(eglot--lambda ((SymbolInformation) name location)
(eglot--dbind ((Location) uri range) location
(collect (eglot--xref-make-match name uri range))))
(jsonrpc-request (eglot--current-server-or-lose)
:workspace/symbol
`(:query ,pattern))))))
(eglot--request (eglot--current-server-or-lose)
:workspace/symbol
`(:query ,pattern))))))
(defun eglot-format-buffer ()
"Format contents of current buffer."
@ -2882,7 +2884,7 @@ for which LSP on-type-formatting should be requested."
'(:textDocument/formatting :documentFormattingProvider nil)))))
(eglot--server-capable-or-lose cap)
(eglot--apply-text-edits
(jsonrpc-request
(eglot--request
(eglot--current-server-or-lose)
method
(cl-list*
@ -2891,8 +2893,14 @@ for which LSP on-type-formatting should be requested."
:insertSpaces (if indent-tabs-mode :json-false t)
:insertFinalNewline (if require-final-newline t :json-false)
:trimFinalNewlines (if delete-trailing-lines t :json-false))
args)
:deferred method))))
args)))))
(defvar eglot-cache-session-completions t
"If non-nil Eglot caches data during completion sessions.")
(defvar eglot--capf-session :none "A cache used by `eglot-completion-at-point'.")
(defun eglot--capf-session-flush (&optional _) (setq eglot--capf-session :none))
(defun eglot-completion-at-point ()
"Eglot's `completion-at-point' function."
@ -2909,41 +2917,50 @@ for which LSP on-type-formatting should be requested."
:sortText)))))
(metadata `(metadata (category . eglot)
(display-sort-function . ,sort-completions)))
resp items (cached-proxies :none)
(local-cache :none)
(bounds (bounds-of-thing-at-point 'symbol))
(orig-pos (point))
(resolved (make-hash-table))
(proxies
(lambda ()
(if (listp cached-proxies) cached-proxies
(setq resp
(jsonrpc-request server
:textDocument/completion
(eglot--CompletionParams)
:deferred :textDocument/completion
:cancel-on-input t))
(setq items (append
(if (vectorp resp) resp (plist-get resp :items))
nil))
(setq cached-proxies
(mapcar
(jsonrpc-lambda
(&rest item &key label insertText insertTextFormat
textEdit &allow-other-keys)
(let ((proxy
;; Snippet or textEdit, it's safe to
;; display/insert the label since
;; it'll be adjusted. If no usable
;; insertText at all, label is best,
;; too.
(cond ((or (eql insertTextFormat 2)
textEdit
(null insertText)
(string-empty-p insertText))
(string-trim-left label))
(t insertText))))
(unless (zerop (length proxy))
(put-text-property 0 1 'eglot--lsp-item item proxy))
proxy))
items)))))
(resolved (make-hash-table))
(if (listp local-cache) local-cache
(let* ((resp (eglot--request server
:textDocument/completion
(eglot--CompletionParams)
:cancel-on-input t))
(items (append
(if (vectorp resp) resp (plist-get resp :items))
nil))
(cachep (and (listp resp) items
eglot-cache-session-completions
(eq (plist-get resp :isIncomplete) :json-false)))
(bounds (or bounds
(cons (point) (point))))
(proxies
(mapcar
(jsonrpc-lambda
(&rest item &key label insertText insertTextFormat
textEdit &allow-other-keys)
(let ((proxy
;; Snippet or textEdit, it's safe to
;; display/insert the label since
;; it'll be adjusted. If no usable
;; insertText at all, label is best,
;; too.
(cond ((or (eql insertTextFormat 2)
textEdit
(null insertText)
(string-empty-p insertText))
(string-trim-left label))
(t insertText))))
(unless (zerop (length proxy))
(put-text-property 0 1 'eglot--lsp-item item proxy))
proxy))
items)))
;; (trace-values "Requested" (length proxies) cachep bounds)
(setq eglot--capf-session
(if cachep (list bounds proxies resolved orig-pos) :none))
(setq local-cache proxies)))))
(resolve-maybe
;; Maybe completion/resolve JSON object `lsp-comp' into
;; another JSON object, if at all possible. Otherwise,
@ -2954,13 +2971,21 @@ for which LSP on-type-formatting should be requested."
(if (and (eglot--server-capable :completionProvider
:resolveProvider)
(plist-get lsp-comp :data))
(jsonrpc-request server :completionItem/resolve
lsp-comp :cancel-on-input t)
lsp-comp)))))
(bounds (bounds-of-thing-at-point 'symbol)))
(eglot--request server :completionItem/resolve
lsp-comp :cancel-on-input t)
lsp-comp))))))
(unless bounds (setq bounds (cons (point) (point))))
(when (and (consp eglot--capf-session)
(= (car bounds) (car (nth 0 eglot--capf-session)))
(>= (cdr bounds) (cdr (nth 0 eglot--capf-session))))
(setq local-cache (nth 1 eglot--capf-session)
resolved (nth 2 eglot--capf-session)
orig-pos (nth 3 eglot--capf-session))
;; (trace-values "Recalling cache" (length local-cache) bounds orig-pos)
)
(list
(or (car bounds) (point))
(or (cdr bounds) (point))
(car bounds)
(cdr bounds)
(lambda (probe pred action)
(cond
((eq action 'metadata) metadata) ; metadata
@ -3031,7 +3056,7 @@ for which LSP on-type-formatting should be requested."
:company-require-match 'never
:company-prefix-length
(save-excursion
(when (car bounds) (goto-char (car bounds)))
(goto-char (car bounds))
(when (listp completion-capability)
(looking-back
(regexp-opt
@ -3039,6 +3064,7 @@ for which LSP on-type-formatting should be requested."
(eglot--bol))))
:exit-function
(lambda (proxy status)
(eglot--capf-session-flush)
(when (memq status '(finished exact))
;; To assist in using this whole `completion-at-point'
;; function inside `completion-in-region', ensure the exit
@ -3062,17 +3088,12 @@ for which LSP on-type-formatting should be requested."
(let ((snippet-fn (and (eql insertTextFormat 2)
(eglot--snippet-expansion-fn))))
(cond (textEdit
;; Undo (yes, undo) the newly inserted completion.
;; If before completion the buffer was "foo.b" and
;; now is "foo.bar", `proxy' will be "bar". We
;; want to delete only "ar" (`proxy' minus the
;; symbol whose bounds we've calculated before)
;; (github#160).
(delete-region (+ (- (point) (length proxy))
(if bounds
(- (cdr bounds) (car bounds))
0))
(point))
;; Revert buffer back to state when the edit
;; was obtained from server. If a `proxy'
;; "bar" was obtained from a buffer with
;; "foo.b", the LSP edit applies to that'
;; state, _not_ the current "foo.bar".
(delete-region orig-pos (point))
(eglot--dbind ((TextEdit) range newText) textEdit
(pcase-let ((`(,beg . ,end)
(eglot--range-region range)))
@ -3095,62 +3116,57 @@ for which LSP on-type-formatting should be requested."
(mapconcat #'eglot--format-markup
(if (vectorp contents) contents (list contents)) "\n"))
(defun eglot--sig-info (sigs active-sig sig-help-active-param)
(cl-loop
for (sig . moresigs) on (append sigs nil) for i from 0
concat
(eglot--dbind ((SignatureInformation) label documentation parameters activeParameter) sig
(with-temp-buffer
(save-excursion (insert label))
(let ((active-param (or activeParameter sig-help-active-param))
params-start params-end)
;; Ad-hoc attempt to parse label as <name>(<params>)
(when (looking-at "\\([^(]*\\)(\\([^)]+\\))")
(setq params-start (match-beginning 2) params-end (match-end 2))
(add-face-text-property (match-beginning 1) (match-end 1)
'font-lock-function-name-face))
(when (eql i active-sig)
;; Decide whether to add one-line-summary to signature line
(when (and (stringp documentation)
(string-match "[[:space:]]*\\([^.\r\n]+[.]?\\)"
documentation))
(setq documentation (match-string 1 documentation))
(unless (string-prefix-p (string-trim documentation) label)
(goto-char (point-max))
(insert ": " (eglot--format-markup documentation))))
;; Decide what to do with the active parameter...
(when (and (eql i active-sig) active-param
(< -1 active-param (length parameters)))
(eglot--dbind ((ParameterInformation) label documentation)
(aref parameters active-param)
;; ...perhaps highlight it in the formals list
(when params-start
(goto-char params-start)
(pcase-let
((`(,beg ,end)
(defun eglot--sig-info (sig &optional _activep sig-help-active-param)
(eglot--dbind ((SignatureInformation) label documentation parameters activeParameter)
sig
(with-temp-buffer
(save-excursion (insert label))
(let ((active-param (or activeParameter sig-help-active-param))
params-start params-end)
;; Ad-hoc attempt to parse label as <name>(<params>)
(when (looking-at "\\([^(]*\\)(\\([^)]+\\))")
(setq params-start (match-beginning 2) params-end (match-end 2))
(add-face-text-property (match-beginning 1) (match-end 1)
'font-lock-function-name-face))
;; Decide whether to add one-line-summary to signature line
(when (and (stringp documentation)
(string-match "[[:space:]]*\\([^.\r\n]+[.]?\\)"
documentation))
(setq documentation (match-string 1 documentation))
(unless (string-prefix-p (string-trim documentation) label)
(goto-char (point-max))
(insert ": " (eglot--format-markup documentation))))
;; Decide what to do with the active parameter...
(when (and active-param (< -1 active-param (length parameters)))
(eglot--dbind ((ParameterInformation) label documentation)
(aref parameters active-param)
;; ...perhaps highlight it in the formals list
(when params-start
(goto-char params-start)
(pcase-let
((`(,beg ,end)
(if (stringp label)
(let ((case-fold-search nil))
(and (re-search-forward
(concat "\\<" (regexp-quote label) "\\>")
params-end t)
(list (match-beginning 0) (match-end 0))))
(mapcar #'1+ (append label nil)))))
(if (and beg end)
(add-face-text-property
beg end
'eldoc-highlight-function-argument))))
;; ...and/or maybe add its doc on a line by its own.
(when documentation
(goto-char (point-max))
(insert "\n"
(propertize
(if (stringp label)
(let ((case-fold-search nil))
(and (re-search-forward
(concat "\\<" (regexp-quote label) "\\>")
params-end t)
(list (match-beginning 0) (match-end 0))))
(mapcar #'1+ (append label nil)))))
(if (and beg end)
(add-face-text-property
beg end
'eldoc-highlight-function-argument))))
;; ...and/or maybe add its doc on a line by its own.
(when documentation
(goto-char (point-max))
(insert "\n"
(propertize
(if (stringp label)
label
(apply #'buffer-substring (mapcar #'1+ label)))
'face 'eldoc-highlight-function-argument)
": " (eglot--format-markup documentation))))))
(buffer-string))))
when moresigs concat "\n"))
label
(apply #'buffer-substring (mapcar #'1+ label)))
'face 'eldoc-highlight-function-argument)
": " (eglot--format-markup documentation))))))
(buffer-string))))
(defun eglot-signature-eldoc-function (cb)
"A member of `eldoc-documentation-functions', for signatures."
@ -3163,11 +3179,12 @@ for which LSP on-type-formatting should be requested."
(eglot--lambda ((SignatureHelp)
signatures activeSignature activeParameter)
(eglot--when-buffer-window buf
(funcall cb
(unless (seq-empty-p signatures)
(eglot--sig-info signatures
activeSignature
activeParameter)))))
(let ((active-sig (and (cl-plusp (length signatures))
(aref signatures (or activeSignature 0)))))
(if (not active-sig) (funcall cb nil)
(funcall cb
(mapconcat #'eglot--sig-info signatures "\n")
:echo (eglot--sig-info active-sig t activeParameter))))))
:deferred :textDocument/signatureHelp))
t))
@ -3255,11 +3272,11 @@ Returns a list as described in docstring of `imenu--index-alist'."
(seq-group-by
(lambda (obj) (plist-get obj :kind))
(mapcan #'unfurl
(jsonrpc-request (eglot--current-server-or-lose)
:textDocument/documentSymbol
`(:textDocument
,(eglot--TextDocumentIdentifier))
:cancel-on-input non-essential))))))
(eglot--request (eglot--current-server-or-lose)
:textDocument/documentSymbol
`(:textDocument
,(eglot--TextDocumentIdentifier))
:cancel-on-input non-essential))))))
(cl-defun eglot--apply-text-edits (edits &optional version)
"Apply EDITS for current buffer if at VERSION, or if it's nil."
@ -3330,9 +3347,9 @@ Returns a list as described in docstring of `imenu--index-alist'."
(symbol-name (symbol-at-point)))))
(eglot--server-capable-or-lose :renameProvider)
(eglot--apply-workspace-edit
(jsonrpc-request (eglot--current-server-or-lose)
:textDocument/rename `(,@(eglot--TextDocumentPositionParams)
:newName ,newname))
(eglot--request (eglot--current-server-or-lose)
:textDocument/rename `(,@(eglot--TextDocumentPositionParams)
:newName ,newname))
current-prefix-arg))
(defun eglot--region-bounds ()
@ -3358,7 +3375,7 @@ at point. With prefix argument, prompt for ACTION-KIND."
(eglot--server-capable-or-lose :codeActionProvider)
(let* ((server (eglot--current-server-or-lose))
(actions
(jsonrpc-request
(eglot--request
server
:textDocument/codeAction
(list :textDocument (eglot--TextDocumentIdentifier)
@ -3370,8 +3387,7 @@ at point. With prefix argument, prompt for ACTION-KIND."
when (cdr (assoc 'eglot-lsp-diag
(eglot--diag-data diag)))
collect it)]
,@(when action-kind `(:only [,action-kind]))))
:deferred t))
,@(when action-kind `(:only [,action-kind]))))))
;; Redo filtering, in case the `:only' didn't go through.
(actions (cl-loop for a across actions
when (or (not action-kind)

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

@ -41,6 +41,16 @@
:safe 'integerp
:group 'typescript)
(defface typescript-ts-jsx-tag-face
'((t . (:inherit font-lock-function-call-face)))
"Face for HTML tags like <div> and <p> in JSX."
:group 'typescript)
(defface typescript-ts-jsx-attribute-face
'((t . (:inherit font-lock-constant-face)))
"Face for HTML attributes like name and id in JSX."
:group 'typescript)
(defvar typescript-ts-mode--syntax-table
(let ((table (make-syntax-table)))
;; Taken from the cc-langs version
@ -284,17 +294,17 @@ Argument LANGUAGE is either `typescript' or `tsx'."
:feature 'jsx
`((jsx_opening_element
[(nested_identifier (identifier)) (identifier)]
@font-lock-function-call-face)
@typescript-ts-jsx-tag-face)
(jsx_closing_element
[(nested_identifier (identifier)) (identifier)]
@font-lock-function-call-face)
@typescript-ts-jsx-tag-face)
(jsx_self_closing_element
[(nested_identifier (identifier)) (identifier)]
@font-lock-function-call-face)
@typescript-ts-jsx-tag-face)
(jsx_attribute (property_identifier) @font-lock-constant-face))
(jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face))
:language language
:feature 'number
@ -438,7 +448,12 @@ See `treesit-sexp-type-regexp' for more information.")
;;;###autoload
(define-derived-mode tsx-ts-mode typescript-ts-base-mode "TypeScript[TSX]"
"Major mode for editing TypeScript."
"Major mode for editing TSX and JSX documents.
This major mode defines two additional JSX-specific faces:
`typescript-ts-jsx-attribute-face' and
`typescript-ts-jsx-attribute-face' that are used for HTML tags
and attributes, respectively."
:group 'typescript
:syntax-table typescript-ts-mode--syntax-table

12
lisp/simple.el
View file

@ -623,7 +623,7 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
(beforepos (point))
(last-command-event ?\n)
;; Don't auto-fill if we have a prefix argument.
(auto-fill-function (if arg nil auto-fill-function))
(inhibit-auto-fill (or inhibit-auto-fill arg))
(arg (prefix-numeric-value arg))
(procsym (make-symbol "newline-postproc")) ;(bug#46326)
(postproc
@ -8919,11 +8919,15 @@ unless optional argument SOFT is non-nil."
;; If we're not inside a comment, just try to indent.
(t (indent-according-to-mode))))))
(defvar inhibit-auto-fill nil
"Non-nil means to do as if `auto-fill-mode' was disabled.")
(defun internal-auto-fill ()
"The function called by `self-insert-command' to perform auto-filling."
(when (or (not comment-start)
(not comment-auto-fill-only-comments)
(nth 4 (syntax-ppss)))
(unless (or inhibit-auto-fill
(and comment-start
comment-auto-fill-only-comments
(not (nth 4 (syntax-ppss)))))
(funcall auto-fill-function)))
(defvar normal-auto-fill-function 'do-auto-fill

8
src/comp.c
View file

@ -5910,6 +5910,14 @@ For internal use. */);
Vcomp_loaded_comp_units_h =
CALLN (Fmake_hash_table, QCweakness, Qvalue, QCtest, Qequal);
DEFVAR_LISP ("comp-subr-arities-h", Vcomp_subr_arities_h,
doc: /* Hash table recording the arity of Lisp primitives.
This is in case they are redefined so the compiler still knows how to
compile calls to them.
subr-name -> arity
For internal use. */);
Vcomp_subr_arities_h = CALLN (Fmake_hash_table, QCtest, Qequal);
Fprovide (intern_c_string ("native-compile"), Qnil);
#endif /* #ifdef HAVE_NATIVE_COMP */

3
src/eval.c
View file

@ -3400,7 +3400,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
return object;
}
/* Return true if SYMBOL currently has a let-binding
/* Return true if SYMBOL's default currently has a let-binding
which was made in the buffer that is now current. */
bool
@ -3415,6 +3415,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p));
eassert (let_bound_symbol->u.s.redirect != SYMBOL_VARALIAS);
if (symbol == let_bound_symbol
&& p->kind != SPECPDL_LET_LOCAL /* bug#62419 */
&& EQ (specpdl_where (p), buf))
return 1;
}

5
src/xdisp.c
View file

@ -18593,8 +18593,9 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
start_display (&it, w, startp);
if (arg_scroll_conservatively)
amount_to_scroll = max (dy, frame_line_height
* max (scroll_step, temp_scroll_step));
amount_to_scroll
= min (max (dy, frame_line_height),
frame_line_height * arg_scroll_conservatively);
else if (scroll_step || temp_scroll_step)
amount_to_scroll = scroll_max;
else

53
test/lisp/eshell/esh-proc-tests.el
View file

@ -191,6 +191,59 @@ pipeline."
(unless (eq system-type 'windows-nt)
"stdout\nstderr\n"))))
;; Synchronous processes
;; These tests check that synchronous subprocesses (only used on
;; MS-DOS by default) work correctly. To help them run on MS-DOS as
;; well, we use the Emacs executable as our subprocess to test
;; against; that way, users don't need to have GNU coreutils (or
;; similar) installed.
(defsubst esh-proc-test/emacs-command (command)
"Evaluate COMMAND in a new Emacs batch instance."
(mapconcat #'shell-quote-argument
`(,(expand-file-name invocation-name invocation-directory)
"-Q" "--batch" "--eval" ,(prin1-to-string command))
" "))
(defvar esh-proc-test/emacs-echo
(esh-proc-test/emacs-command '(princ "hello\n"))
"A command that prints \"hello\" to stdout using Emacs.")
(defvar esh-proc-test/emacs-upcase
(esh-proc-test/emacs-command
'(princ (upcase (concat (read-string "") "\n"))))
"A command that upcases the text from stdin using Emacs.")
(ert-deftest esh-proc-test/synchronous-proc/simple/interactive ()
"Test that synchronous processes work in an interactive shell."
(let ((eshell-supports-asynchronous-processes nil))
(with-temp-eshell
(eshell-match-command-output esh-proc-test/emacs-echo
"\\`hello\n"))))
(ert-deftest esh-proc-test/synchronous-proc/simple/command-result ()
"Test that synchronous processes work via `eshell-command-result'."
(let ((eshell-supports-asynchronous-processes nil))
(eshell-command-result-equal esh-proc-test/emacs-echo
"hello\n")))
(ert-deftest esh-proc-test/synchronous-proc/pipeline/interactive ()
"Test that synchronous pipelines work in an interactive shell."
(let ((eshell-supports-asynchronous-processes nil))
(with-temp-eshell
(eshell-match-command-output (concat esh-proc-test/emacs-echo " | "
esh-proc-test/emacs-upcase)
"\\`HELLO\n"))))
(ert-deftest esh-proc-test/synchronous-proc/pipeline/command-result ()
"Test that synchronous pipelines work via `eshell-command-result'."
(let ((eshell-supports-asynchronous-processes nil))
(eshell-command-result-equal (concat esh-proc-test/emacs-echo " | "
esh-proc-test/emacs-upcase)
"HELLO\n")))
;; Killing processes

44
test/lisp/eshell/eshell-tests.el
View file

@ -107,6 +107,50 @@
(format template "format \"%s\" eshell-in-pipeline-p")
"nil")))
(ert-deftest eshell-test/eshell-command/simple ()
"Test that the `eshell-command' function writes to the current buffer."
(skip-unless (executable-find "echo"))
(ert-with-temp-directory eshell-directory-name
(let ((eshell-history-file-name nil))
(with-temp-buffer
(eshell-command "*echo hi" t)
(should (equal (buffer-string) "hi\n"))))))
(ert-deftest eshell-test/eshell-command/pipeline ()
"Test that the `eshell-command' function writes to the current buffer.
This test uses a pipeline for the command."
(skip-unless (and (executable-find "echo")
(executable-find "cat")))
(ert-with-temp-directory eshell-directory-name
(let ((eshell-history-file-name nil))
(with-temp-buffer
(eshell-command "*echo hi | *cat" t)
(should (equal (buffer-string) "hi\n"))))))
(ert-deftest eshell-test/eshell-command/background ()
"Test that `eshell-command' works for background commands."
(skip-unless (executable-find "echo"))
(ert-with-temp-directory eshell-directory-name
(let ((orig-processes (process-list))
(eshell-history-file-name nil))
(with-temp-buffer
(eshell-command "*echo hi &" t)
(eshell-wait-for (lambda () (equal (process-list) orig-processes)))
(should (equal (buffer-string) "hi\n"))))))
(ert-deftest eshell-test/eshell-command/background-pipeline ()
"Test that `eshell-command' works for background commands.
This test uses a pipeline for the command."
(skip-unless (and (executable-find "echo")
(executable-find "cat")))
(ert-with-temp-directory eshell-directory-name
(let ((orig-processes (copy-tree (process-list)))
(eshell-history-file-name nil))
(with-temp-buffer
(eshell-command "*echo hi | *cat &" t)
(eshell-wait-for (lambda () (equal (process-list) orig-processes)))
(should (equal (buffer-string) "hi\n"))))))
(ert-deftest eshell-test/command-running-p ()
"Modeline should show no command running"
(with-temp-eshell

18
test/src/comp-tests.el
View file

@ -446,7 +446,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
(should (equal comp-test-primitive-advice '(3 4))))
(advice-remove #'+ f))))
(defvar comp-test-primitive-redefine-args)
(defvar comp-test-primitive-redefine-args nil)
(comp-deftest primitive-redefine ()
"Test effectiveness of primitive redefinition."
(cl-letf ((comp-test-primitive-redefine-args nil)
@ -532,6 +532,22 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
(should (subr-native-elisp-p
(symbol-function 'comp-test-48029-nonascii-žžž-f))))
(comp-deftest 61917-1 ()
"Verify we can compile calls to redefined primitives with
dedicated byte-op code."
(let (x
(f (lambda (fn &rest args)
(setq comp-test-primitive-redefine-args args))))
(advice-add #'delete-region :around f)
(unwind-protect
(setf x (native-compile
'(lambda ()
(delete-region 1 2))))
(should (subr-native-elisp-p x))
(funcall x)
(advice-remove #'delete-region f)
(should (equal comp-test-primitive-redefine-args '(1 2))))))
;;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests. ;;

19
test/src/eval-tests.el
View file

@ -247,4 +247,23 @@ expressions works for identifiers starting with period."
(should (equal (string-trim (buffer-string))
expected-messages))))))))
(defvar-local eval-test--local-var 'global)
(ert-deftest eval-test--bug62419 ()
(with-temp-buffer
(setq eval-test--local-var 'first-local)
(let ((eval-test--local-var t))
(kill-local-variable 'eval-test--local-var)
(setq eval-test--local-var 'second-local)
(should (eq eval-test--local-var 'second-local)))
;; FIXME: It's not completely clear if exiting the above `let'
;; should restore the buffer-local binding to `first-local'
;; (i.e. reset the value of the second buffer-local binding to the
;; first's initial value) or should do nothing (on the principle that
;; the first buffer-local binding doesn't exists any more so there's
;; nothing to restore). I think both semantics make sense.
;;(should (eq eval-test--local-var 'first-local))
)
(should (eq eval-test--local-var 'global)))
;;; eval-tests.el ends here