[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master fcd0b377e0: Merge from origin/emacs-29
|
From: |
Stefan Kangas |
|
Subject: |
master fcd0b377e0: Merge from origin/emacs-29 |
|
Date: |
Mon, 12 Dec 2022 03:06:15 -0500 (EST) |
branch: master
commit fcd0b377e0e25b7b68bd51229098edb30972352b
Merge: b889eced44 06ef030f93
Author: Stefan Kangas <stefankangas@gmail.com>
Commit: Stefan Kangas <stefankangas@gmail.com>
Merge from origin/emacs-29
06ef030f936 use-package.texi: New section "Manual installation"
f4ce6fa7d3e Revert "Revert "Improve last change to xfaces.c" (05ece1e...
b8d2ec920f3 Revert "Improve last change to xfaces.c" (05ece1eb8b)
24c8c28ae61 Do not pare arguments unnecessarily.
9c0d7bb73bb Add automated tests for Eglot
d3669cfe156 Eglot: allow skipping compile-time warnings about LSP int...
04b7e01885d ; project.el: Bump version.
f2876014adb Add customizale faces for tree-sitter explorer
3e349ee1198 Fix error message when installing non-existent package
733cdeabfb9 Don't use diff-mode buffer as a patch when it's visiting ...
87475f4af21 Fix pcase rx patterns using rx-let bindings (bug#59814)
4893a156317 Fix use-package-defaults defcustom type (bug#59941)
074b7e6f4d1 ; * lisp/use-package/bind-key.el: Remove ineffective back...
864ed9dfa1f ; * lisp/progmodes/dockerfile-ts-mode.el: use \' instead ...
9f7e5584a4f * lisp/language/indian.el: Improve Brahmi composition rul...
78ad33bb05f ; Minor cleanup of last change in xfaces.c.
2024ade271d ; Improve docs of relaxing face-font attribute match (bug...
---
doc/misc/use-package.texi | 78 +-
lisp/emacs-lisp/package.el | 6 +-
lisp/emacs-lisp/rx.el | 14 +-
lisp/language/indian.el | 42 +-
lisp/pcomplete.el | 2 +-
lisp/progmodes/dockerfile-ts-mode.el | 2 +-
lisp/progmodes/eglot.el | 9 +-
lisp/progmodes/project.el | 2 +-
lisp/treesit.el | 19 +-
lisp/use-package/bind-key.el | 6 +-
lisp/use-package/use-package-core.el | 4 +-
lisp/vc/vc.el | 2 +-
src/xfaces.c | 86 +--
test/lisp/emacs-lisp/rx-tests.el | 6 +
test/lisp/progmodes/eglot-tests.el | 1308 ++++++++++++++++++++++++++++++++++
15 files changed, 1475 insertions(+), 111 deletions(-)
diff --git a/doc/misc/use-package.texi b/doc/misc/use-package.texi
index 0aa8975f30..c587d23d74 100644
--- a/doc/misc/use-package.texi
+++ b/doc/misc/use-package.texi
@@ -248,10 +248,6 @@ packages using the built-in @code{install-package}
command, it will do
this automatically for you. Packages shipped with Emacs (built-in
packages) are always available.
-If you install packages manually, you must make sure they are
-available on your @code{load-path}. @xref{Lisp Libraries,,, emacs,
-GNU Emacs Manual}, for details.
-
Some packages have more than one library. In those cases, you might
need more than one @code{use-package} declaration to make sure the
package is properly loaded. For complex configurations, you might
@@ -267,8 +263,7 @@ on Emacs start. @xref{Installing packages}, for details.
* Conditional loading:: Loading packages conditionally.
* Loading sequentially:: Loading packages in sequence.
* Load dependencies:: Don't load without dependencies.
-* Load path:: Using a custom @code{load-path}.
-* Manual autoloads:: Setting up autoloads manually.
+* Manual installation:: Loading manually installed packages.
@end menu
@node Loading basics
@@ -623,36 +618,54 @@ As a convenience, a list of such packages may be
specified:
For more complex logic, such as that supported by @code{:after},
simply use @code{:if} and the appropriate Lisp expression.
+@node Manual installation
+@section Manually installed package
+
+When installing packages manually, without Emacs' built-in package
+manager (@file{package.el}), it will obviously not help you set up
+autoloads or add it to your @code{load-path}. You must do it
+yourself. However, use-package makes this more convenient.
+
+@menu
+* Load path:: Using a custom @code{load-path}.
+* Manual autoloads:: Setting up autoloads manually.
+@end menu
+
@node Load path
-@section Setting a custom @code{load-path}
+@subsection Setting a custom @code{load-path}
@cindex custom @code{load-path} for loading a package
@cindex @code{load-path}, add directories for loading a package
+When installing packages manually, you must make sure its libraries
+are available on your @code{load-path}. @xref{Lisp Libraries,,,
+emacs, GNU Emacs Manual}, for more details about package loading.
+
@findex :load-path
-If a package resides in some directory that is not in your
-@code{load-path}, use the @code{:load-path} keyword to add it. It
-takes as argument a symbol, a function, a string or a list of strings.
-If a directory is specified as a relative file name, it is expanded
-relative to @code{user-emacs-directory}.
+The @code{:load-path} keyword provides a convenient way to add
+directories to your load path. It takes as argument a symbol, a
+function, a string or a list of strings. If a directory is specified
+as a relative file name, it is expanded relative to
+@code{user-emacs-directory}.
For example:
@lisp
@group
-(use-package ess-site
- :load-path "site-lisp/ess/lisp/"
- :commands R)
+(use-package org
+ :load-path "site-lisp/org/lisp/"
+ :commands org-mode)
@end group
@end lisp
-Note that when using a symbol or a function to provide a dynamically
-generated list of directories, you must inform the byte-compiler of this
-definition so that the value is available at byte-compilation time.
+When using a symbol or a function to provide a dynamically generated
+list of directories, you must inform the byte-compiler of this
+definition, so that the value is available at byte-compilation time.
This is done by using the special form @code{eval-and-compile} (as
opposed to @code{eval-when-compile}, @pxref{Eval During Compile,,,
-elisp, GNU Emacs Lisp Reference Manual}). Further, this value is fixed at
-whatever was determined during compilation, to avoid looking up the
-same information again on each startup. For example:
+elisp, GNU Emacs Lisp Reference Manual}). Furthermore, this value is
+fixed to the value it had during compilation. If the operation is
+costly, you do not have to repeat it again on each startup. For
+example:
@lisp
@group
@@ -669,20 +682,25 @@ same information again on each startup. For example:
@end lisp
@node Manual autoloads
-@section Setting up autoloads manually
+@subsection Setting up autoloads manually
+
+Packages often document how to set up its autoloads when it is being
+manually installed. If it does, follow those instructions.
+Otherwise, you might want to set them up manually.
+
@cindex autoloads for packages, setting up manually
@cindex package autoloads, setting up manually
@findex :commands
@findex :autoload
-To autoload an interactive command, use the @code{:commands} keyword.
-When you use the @code{:commands} keyword, it creates autoloads for
-those commands (which defers loading of the module until those commands are
-used). The @code{:commands} keyword takes either a symbol or a list
-of symbols as its argument.
-
-The @code{:autoload} keyword works like @code{:commands}, but is used
-to autoload non-interactive functions. Here is an example:
+To autoload an interactive command, use the @code{:commands} keyword,
+which takes either a symbol or a list of symbols as its argument. It
+creates autoloads for those commands (which defers loading of the
+module until those commands are used).
+
+The @code{:autoload} keyword takes the same arguments as
+@code{:commands}, but is used to autoload non-interactive functions.
+Here is an example:
@lisp
@group
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index a9fd8c741e..4d33311cb7 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1949,8 +1949,10 @@ SEEN is used internally to detect infinite recursion."
(if (eq next-pkg 'emacs)
(error "This package requires Emacs version %s"
(package-version-join next-version))
- (error "Package `%s-%s' is unavailable"
- next-pkg (package-version-join next-version))))))
+ (error (if (not next-version)
+ (format "Package `%s' is unavailable" next-pkg)
+ (format "Package `%s' (version %s) is unavailable"
+ next-pkg (package-version-join
next-version))))))))
(setq packages
(package-compute-transaction (cons found packages)
(package-desc-reqs found)
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index ec51146484..f2a0dc5483 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1152,7 +1152,12 @@ For extending the `rx' notation in FORM, use `rx-define'
or `rx-let-eval'."
(defun rx--to-expr (form)
"Translate the rx-expression FORM to a Lisp expression yielding a regexp."
- (let* ((rx--delayed-evaluation t)
+ (let* ((rx--local-definitions
+ ;; Retrieve local definitions from the macroexpansion environment.
+ ;; (It's unclear whether the previous value of
`rx--local-definitions'
+ ;; should be included, and if so, in which order.)
+ (cdr (assq :rx-locals macroexpand-all-environment)))
+ (rx--delayed-evaluation t)
(elems (car (rx--translate form)))
(args nil))
;; Merge adjacent strings.
@@ -1282,12 +1287,7 @@ Additional constructs can be defined using `rx-define'
and `rx-let',
which see.
\(fn REGEXPS...)"
- ;; Retrieve local definitions from the macroexpansion environment.
- ;; (It's unclear whether the previous value of `rx--local-definitions'
- ;; should be included, and if so, in which order.)
- (let ((rx--local-definitions
- (cdr (assq :rx-locals macroexpand-all-environment))))
- (rx--to-expr (cons 'seq regexps))))
+ (rx--to-expr (cons 'seq regexps)))
(defun rx--make-binding (name tail)
"Make a definitions entry out of TAIL.
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index 4994cfdc7a..f70f7fcce1 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -552,24 +552,40 @@ environment."))
char-script-table))
;; Brahmi composition rules
-(let ((consonant "[\U00011013-\U00011034]")
- (non-consonant "[^\U00011013-\U00011034\U00011046\U0001107F]")
- (vowel "[\U00011038-\U00011045]")
- (numeral "[\U00011052-\U00011065]")
- (multiplier "[\U00011064\U00011065]")
- (virama "\U00011046")
- (number-joiner "\U0001107F"))
+(let ((consonant "[\x11013-\x11037\x11075]")
+ (independent-vowel "[\x11005-\x11012\x11071\x11072]")
+ (vowel "[\x11038-\x11045\x11073\x11074]")
+ (nasal "[\x11000\x11001]")
+ (virama "\x11046")
+ (jivhamuliya "\x11003")
+ (upadhmaniya "\x11004")
+ (ka-kha "[\x11013\x11014]")
+ (pa-pha "[\x11027\x11028]")
+ (number-joiner "\x1107F")
+ (numeral "[\x11052-\x11065]")
+ (multiplier "[\x11064\x11065]"))
(set-char-table-range composition-function-table
- '(#x11046 . #x11046)
+ '(#x11046 . #x11046)
(list (vector
- ;; Consonant conjuncts
- (concat consonant "\\(?:" virama consonant
"\\)+"
- vowel "?")
+ ;; Consonant based syllables
+ (concat consonant "\\(?:" virama consonant
+ "\\)*\\(?:" virama "\\|" vowel "*"
+ nasal "?\\)")
1 'font-shape-gstring)
(vector
- ;; Vowelless consonants
- (concat consonant virama non-consonant)
+ ;; Vowel based syllables
+ (concat independent-vowel virama "?" vowel "?"
nasal "?")
1 'font-shape-gstring)))
+ (set-char-table-range composition-function-table
+ '(#x11003 . #x11004)
+ (list (vector
+ ;; Velar fricative
+ (concat jivhamuliya ka-kha "?")
+ 0 'font-shape-gstring)
+ (vector
+ ;; Bilabial fricative
+ (concat upadhmaniya pa-pha "?")
+ 0 'font-shape-gstring)))
(set-char-table-range composition-function-table
'(#x1107F . #x1107F)
(list (vector
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 8be026b5a8..4e3a88bbda 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -1456,7 +1456,7 @@ COMMAND and ARGS as arguments."
(pcomplete-match-string 1 0)))
((string-prefix-p "-" (pcomplete-arg 0))
(pcomplete-here (apply #'pcomplete-from-help command args)))
- (t (pcomplete-here (pcomplete-entries))))))
+ (t (pcomplete-here* (pcomplete-entries))))))
(provide 'pcomplete)
diff --git a/lisp/progmodes/dockerfile-ts-mode.el
b/lisp/progmodes/dockerfile-ts-mode.el
index 1ece3dd59b..544e0f82d6 100644
--- a/lisp/progmodes/dockerfile-ts-mode.el
+++ b/lisp/progmodes/dockerfile-ts-mode.el
@@ -132,7 +132,7 @@ the subtrees."
;;;###autoload
(add-to-list 'auto-mode-alist
;; NOTE: We can't use `rx' here, as it breaks bootstrap.
- '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)$"
+ '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'"
. dockerfile-ts-mode))
;;;###autoload
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 2ef022992e..2427e7b9d3 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -499,7 +499,7 @@ Here's what an element of this alist might look like:
;; disallow-non-standard-keys
;; enforce-required-keys
;; enforce-optional-keys
- )
+ no-unknown-interfaces)
"How strictly to check LSP interfaces at compile- and run-time.
Value is a list of symbols (if the list is empty, no checks are
@@ -520,7 +520,10 @@ happens at run-time. At compile-time, a warning is raised
if a
destructuring spec doesn't use all optional fields.
If the symbol `disallow-unknown-methods' is present, Eglot warns
-on unknown notifications and errors on unknown requests."))
+on unknown notifications and errors on unknown requests.
+
+If the symbol `no-unknown-interfaces' is present, Eglot warns at
+compile time if an undeclared LSP interface is used."))
(cl-defun eglot--check-object (interface-name
object
@@ -594,7 +597,7 @@ on unknown notifications and errors on unknown requests."))
(when missing-out (byte-compile-warn
"Destructuring for %s is missing out on %s"
interface-name missing-out))))
- (t
+ ((memq 'no-unknown-interfaces eglot-strict-mode)
(byte-compile-warn "Unknown LSP interface %s" interface-name))))))
(cl-defmacro eglot--dbind (vars object &body body)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 016dfdd5b4..7cdaba9c07 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t;
-*-
;; Copyright (C) 2015-2022 Free Software Foundation, Inc.
-;; Version: 0.9.2
+;; Version: 0.9.3
;; Package-Requires: ((emacs "26.1") (xref "1.4.0"))
;; This is a GNU ELPA :core package. Avoid using functionality that
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 133564f6c8..9bb261b66d 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -1848,6 +1848,18 @@ to the offending pattern and highlight the pattern."
;;; Explorer
+(defface treesit-explorer-anonymous-node
+ (let ((display t)
+ (atts '(:inherit shadow)))
+ `((,display . ,atts)))
+ "Face for anonymous nodes in tree-sitter explorer.")
+
+(defface treesit-explorer-field-name
+ (let ((display t)
+ (atts nil))
+ `((,display . ,atts)))
+ "Face for field names in tree-sitter explorer.")
+
(defvar-local treesit--explorer-buffer nil
"Buffer used to display the syntax tree.")
@@ -2026,7 +2038,8 @@ leaves point at the end of the last line of NODE."
;; draw everything in one line, other wise draw field name and the
;; rest of the node in two lines.
(when field-name
- (insert field-name ": ")
+ (insert (propertize (concat field-name ": ")
+ 'face 'treesit-explorer-field-name))
(when (and children (not all-children-inline))
(insert "\n")
(indent-to-column (1+ before-field-column))))
@@ -2085,7 +2098,7 @@ leaves point at the end of the last line of NODE."
(overlay-put ov 'treesit-node node)
(overlay-put ov 'evaporate t)
(when (not named)
- (overlay-put ov 'face 'shadow)))))
+ (overlay-put ov 'face 'treesit-explorer-anonymous-node)))))
(define-derived-mode treesit--explorer-tree-mode special-mode
"TS Explorer"
@@ -2104,7 +2117,7 @@ window."
(unless (buffer-live-p treesit--explorer-buffer)
(setq-local treesit--explorer-buffer
(get-buffer-create
- (format "*tree-sitter playground for %s*"
+ (format "*tree-sitter explorer for %s*"
(buffer-name))))
(setq-local treesit--explorer-language
(intern (completing-read
diff --git a/lisp/use-package/bind-key.el b/lisp/use-package/bind-key.el
index 0d4c3de5d1..c3890c4d0a 100644
--- a/lisp/use-package/bind-key.el
+++ b/lisp/use-package/bind-key.el
@@ -542,13 +542,13 @@ other modes. See `override-global-mode'."
(format
(format "%%-%ds%%-%ds%%s\n" (car bind-key-column-widths)
(cdr bind-key-column-widths))
- key-name (format "`%s\'" command-desc)
+ key-name (format "`%s'" command-desc)
(if (string= command-desc at-present-desc)
(if (or (null was-command)
(string= command-desc was-command-desc))
""
- (format "was `%s\'" was-command-desc))
- (format "[now: `%s\']" at-present)))))
+ (format "was `%s'" was-command-desc))
+ (format "[now: `%s']" at-present)))))
(princ (if (string-match "[ \t]+\n" line)
(replace-match "\n" t t line)
line))))
diff --git a/lisp/use-package/use-package-core.el
b/lisp/use-package/use-package-core.el
index ed6a65494f..1dee08e55b 100644
--- a/lisp/use-package/use-package-core.el
+++ b/lisp/use-package/use-package-core.el
@@ -210,9 +210,7 @@ a symbol) and a list of keywords (in normalized form). It
should
return nil or non-nil depending on whether defaulting should be
attempted."
:type `(repeat
- (list (choice :tag "Keyword"
- ,@(mapcar #'(lambda (k) (list 'const k))
- use-package-keywords))
+ (list (symbol :tag "Keyword")
(choice :tag "Default value" sexp function)
(choice :tag "Enable if non-nil" sexp function)))
:group 'use-package)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 328d33040d..690c907c77 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1135,7 +1135,7 @@ BEWARE: this function may change the current buffer."
(vc-dir-deduce-fileset state-model-only-files))
((derived-mode-p 'dired-mode)
(dired-vc-deduce-fileset state-model-only-files not-state-changing))
- ((derived-mode-p 'diff-mode)
+ ((and (derived-mode-p 'diff-mode) (not buffer-file-name))
(diff-vc-deduce-fileset))
((setq backend (vc-backend buffer-file-name))
(if state-model-only-files
diff --git a/src/xfaces.c b/src/xfaces.c
index 88d3a79f8c..7dbcacb35a 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -6018,12 +6018,10 @@ realize_non_ascii_face (struct frame *f, Lisp_Object
font_object,
appears in `font-fallback-ignored-attributes'. */
static void
-font_unset_attribute (Lisp_Object font_object, enum font_property_index index,
- Lisp_Object symbol)
+font_maybe_unset_attribute (Lisp_Object font_object,
+ enum font_property_index index, Lisp_Object symbol)
{
- Lisp_Object tail;
-
- tail = Vfont_fallback_ignored_attributes;
+ Lisp_Object tail = Vface_font_lax_matched_attributes;
FOR_EACH_TAIL_SAFE (tail)
{
@@ -6046,7 +6044,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
#ifdef HAVE_WINDOW_SYSTEM
struct face *default_face;
struct frame *f;
- Lisp_Object stipple, underline, overline, strike_through, box, spec;
+ Lisp_Object stipple, underline, overline, strike_through, box;
eassert (FRAME_WINDOW_P (cache->f));
@@ -6089,33 +6087,33 @@ realize_gui_face (struct face_cache *cache, Lisp_Object
attrs[LFACE_VECTOR_SIZE]
}
if (! FONT_OBJECT_P (attrs[LFACE_FONT_INDEX]))
{
- spec = copy_font_spec (attrs[LFACE_FONT_INDEX]);
+ Lisp_Object spec = copy_font_spec (attrs[LFACE_FONT_INDEX]);
- /* Unset several values in SPEC, usually the width, slant,
- and weight. The best possible values for these
- attributes is determined in font_find_for_lface, called
- by font_load_for_lface, when the candidate list returned
- by font_list_entities is sorted by font_select_entity
+ /* Maybe unset several values in SPEC, usually the width,
+ slant, and weight. The best possible values for these
+ attributes are determined in font_find_for_lface, called
+ by font_load_for_lface, when the list of candidate fonts
+ returned by font_list_entities is sorted by font_select_entity
(which calls font_sort_entities, which calls font_score).
If these attributes are not unset here, the candidate
font list returned by font_list_entities only contains
- fonts that are exact matches for these weight, slant and
- width attributes, which leads to suboptimal or wrong font
- choices. (bug#5934) */
- font_unset_attribute (spec, FONT_WEIGHT_INDEX, QCwidth);
- font_unset_attribute (spec, FONT_SLANT_INDEX, QCslant);
- font_unset_attribute (spec, FONT_WIDTH_INDEX, QCwidth);
+ fonts that are exact matches for these weight, slant, and
+ width attributes, which could lead to suboptimal or wrong
+ font selection. (bug#5934) */
+ font_maybe_unset_attribute (spec, FONT_WEIGHT_INDEX, QCweight);
+ font_maybe_unset_attribute (spec, FONT_SLANT_INDEX, QCslant);
+ font_maybe_unset_attribute (spec, FONT_WIDTH_INDEX, QCwidth);
/* Also allow unsetting other attributes for debugging
purposes. But not FONT_EXTRA_INDEX; that is not safe to
- touch in the Haiku font backend. */
- font_unset_attribute (spec, FONT_FAMILY_INDEX, QCfamily);
- font_unset_attribute (spec, FONT_FOUNDRY_INDEX, QCfoundry);
- font_unset_attribute (spec, FONT_REGISTRY_INDEX, QCregistry);
- font_unset_attribute (spec, FONT_ADSTYLE_INDEX, QCadstyle);
- font_unset_attribute (spec, FONT_SIZE_INDEX, QCsize);
- font_unset_attribute (spec, FONT_DPI_INDEX, QCdpi);
- font_unset_attribute (spec, FONT_SPACING_INDEX, QCspacing);
- font_unset_attribute (spec, FONT_AVGWIDTH_INDEX, QCavgwidth);
+ touch, at least in the Haiku font backend. */
+ font_maybe_unset_attribute (spec, FONT_FAMILY_INDEX, QCfamily);
+ font_maybe_unset_attribute (spec, FONT_FOUNDRY_INDEX, QCfoundry);
+ font_maybe_unset_attribute (spec, FONT_REGISTRY_INDEX, QCregistry);
+ font_maybe_unset_attribute (spec, FONT_ADSTYLE_INDEX, QCadstyle);
+ font_maybe_unset_attribute (spec, FONT_SIZE_INDEX, QCsize);
+ font_maybe_unset_attribute (spec, FONT_DPI_INDEX, QCdpi);
+ font_maybe_unset_attribute (spec, FONT_SPACING_INDEX, QCspacing);
+ font_maybe_unset_attribute (spec, FONT_AVGWIDTH_INDEX, QCavgwidth);
attrs[LFACE_FONT_INDEX] = font_load_for_lface (f, attrs, spec);
}
@@ -7406,22 +7404,24 @@ Lisp programs that change the value of this variable
should also
clear the face cache, see `clear-face-cache'. */);
face_near_same_color_threshold = 30000;
- DEFVAR_LISP ("font-fallback-ignored-attributes",
- Vfont_fallback_ignored_attributes,
- doc: /* A list of face attributes to ignore.
-
-List of font-related face attributes to ignore when realizing a face.
-This is a list of symbols representing face attributes that will be
-ignored by Emacs when realizing a face, and an exact match couldn't be
-found for its preferred font. For example:
-
- (:weight :slant :width)
-
-tells Emacs to ignore the `:weight', `:slant' and `:width' face
-attributes when searching for a font and an exact match could not be
-found for the font attributes specified in the face being realized. */);
- Vfont_fallback_ignored_attributes
- = list3 (QCwidth, QCslant, QCwidth);
+ DEFVAR_LISP ("face-font-lax-matched-attributes",
+ Vface_font_lax_matched_attributes,
+ doc: /* Font-related face attributes to match in lax manner when
realizing faces.
+
+The value should be a list of font-related face attribute symbols;
+see `set-face-attribute' for the full list of attributes. The
+corresponding face attributes will be treated as "soft" constraints
+when looking for suitable fonts: if an exact match is not possible,
+a font can be selected that is a close, but not an exact, match. For
+example, looking for a semi-bold font might select a bold or a medium
+font if no semi-bold font matching other attributes is found. Emacs
+still tries to find a font that is the closest possible match; in
+particular, if a font is available that matches the face attributes
+exactly, it will be selected.
+
+Note that if the `:extra' attribute is present in the value, it
+will be ignored. */);
+ Vface_font_lax_matched_attributes = list3 (QCweight, QCslant, QCwidth);
#ifdef HAVE_WINDOW_SYSTEM
defsubr (&Sbitmap_spec_p);
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 125ddee859..01772e54d8 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -207,6 +207,12 @@
(list 'ok z))
'(ok "F"))))
+(ert-deftest rx-let-pcase ()
+ "Test `rx-let' around `pcase' with `rx' patterns (bug#59814)."
+ (should (equal (rx-let ((tata "ab"))
+ (pcase "abc" ((rx tata) 'toto)))
+ 'toto)))
+
(ert-deftest rx-kleene ()
"Test greedy and non-greedy repetition operators."
(should (equal (rx (* "a") (+ "b") (\? "c") (?\s "d")
diff --git a/test/lisp/progmodes/eglot-tests.el
b/test/lisp/progmodes/eglot-tests.el
new file mode 100644
index 0000000000..2b4de8c27d
--- /dev/null
+++ b/test/lisp/progmodes/eglot-tests.el
@@ -0,0 +1,1308 @@
+;;; eglot-tests.el --- Tests for eglot.el -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+;; Author: João Távora <joaotavora@gmail.com>
+;; Keywords: tests
+
+;; 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 lisp/progmodes/eglot.el
+;;
+;; Many of these tests rely on the availability of third-party LSP
+;; servers. They are automatically skipped if the program is not
+;; available.
+;;
+;; Some of these tests rely on the GNU ELPA package company.el and
+;; yasnippet.el being available.
+
+;;; Code:
+(require 'eglot)
+(require 'cl-lib)
+(require 'ert)
+(require 'ert-x) ; ert-simulate-command
+(require 'edebug)
+(require 'python) ; some tests use pylsp
+(require 'cc-mode) ; c-mode-hook
+(require 'company nil t)
+(require 'yasnippet nil t)
+(require 'tramp)
+(require 'tramp-sh)
+(require 'subr-x)
+(require 'flymake) ; project-diagnostics
+
+;;; Helpers
+
+(defmacro eglot--with-fixture (fixture &rest body)
+ "Setup FIXTURE, call BODY, teardown FIXTURE.
+FIXTURE is a list. Its elements are of the form (FILE . CONTENT)
+to create a readable FILE with CONTENT. FILE may be a directory
+name and CONTENT another (FILE . CONTENT) list to specify a
+directory hierarchy. FIXTURE's elements can also be (SYMBOL
+VALUE) meaning SYMBOL should be bound to VALUE during BODY and
+then restored."
+ (declare (indent 1) (debug t))
+ `(eglot--call-with-fixture
+ ,fixture #'(lambda () ,@body)))
+
+(defun eglot--make-file-or-dir (ass)
+ (let ((file-or-dir-name (car ass))
+ (content (cdr ass)))
+ (cond ((listp content)
+ (make-directory file-or-dir-name 'parents)
+ (let ((default-directory (concat default-directory "/"
file-or-dir-name)))
+ (mapcan #'eglot--make-file-or-dir content)))
+ ((stringp content)
+ (with-temp-buffer
+ (insert content)
+ (write-region nil nil file-or-dir-name nil 'nomessage))
+ (list (expand-file-name file-or-dir-name)))
+ (t
+ (eglot--error "Expected a string or a directory spec")))))
+
+(defun eglot--call-with-fixture (fixture fn)
+ "Helper for `eglot--with-fixture'. Run FN under FIXTURE."
+ (let* ((fixture-directory (make-temp-file "eglot--fixture" t))
+ (default-directory fixture-directory)
+ file-specs created-files
+ syms-to-restore
+ new-servers
+ test-body-successful-p)
+ (dolist (spec fixture)
+ (cond ((symbolp spec)
+ (push (cons spec (symbol-value spec)) syms-to-restore)
+ (set spec nil))
+ ((symbolp (car spec))
+ (push (cons (car spec) (symbol-value (car spec))) syms-to-restore)
+ (set (car spec) (cadr spec)))
+ ((stringp (car spec)) (push spec file-specs))))
+ (unwind-protect
+ (let* ((home (getenv "HOME"))
+ (process-environment
+ (append
+ `(;; Set XDF_CONFIG_HOME to /dev/null to prevent
+ ;; user-configuration to have an influence on
+ ;; language servers. (See github#441)
+ "XDG_CONFIG_HOME=/dev/null"
+ ;; ... on the flip-side, a similar technique by
+ ;; Emacs's test makefiles means that HOME is set to
+ ;; /nonexistent. This breaks some common
+ ;; installations for LSP servers like pylsp, making
+ ;; these tests mostly useless, so we hack around it
+ ;; here with a great big hack.
+ ,(format "HOME=%s"
+ (if (file-exists-p home) home
+ (format "/home/%s" (getenv "USER")))))
+ process-environment))
+ ;; Prevent "Can't guess python-indent-offset ..." messages.
+ (python-indent-guess-indent-offset-verbose . nil)
+ (eglot-server-initialized-hook
+ (lambda (server) (push server new-servers))))
+ (setq created-files (mapcan #'eglot--make-file-or-dir file-specs))
+ (prog1 (funcall fn)
+ (setq test-body-successful-p t)))
+ (eglot--message
+ "Test body was %s" (if test-body-successful-p "OK" "A FAILURE"))
+ (unwind-protect
+ (let ((eglot-autoreconnect nil))
+ (dolist (server new-servers)
+ (when (jsonrpc-running-p server)
+ (condition-case oops
+ (eglot-shutdown
+ server nil 3 (not test-body-successful-p))
+ (error
+ (eglot--message "Non-critical shutdown error after test: %S"
+ oops))))
+ (when (not test-body-successful-p)
+ ;; We want to do this after the sockets have
+ ;; shut down such that any pending data has been
+ ;; consumed and is available in the process
+ ;; buffers.
+ (let ((buffers (delq nil (list
+ ;; FIXME: Accessing "internal"
symbol here.
+ (process-buffer (jsonrpc--process
server))
+ (jsonrpc-stderr-buffer server)
+ (jsonrpc-events-buffer server)))))
+ (cond (noninteractive
+ (dolist (buffer buffers)
+ (eglot--message "%s:" (buffer-name buffer))
+ (princ (with-current-buffer buffer (buffer-string))
+ 'external-debugging-output)))
+ (t
+ (eglot--message "Preserved for inspection: %s"
+ (mapconcat #'buffer-name buffers ",
"))))))))
+ (eglot--cleanup-after-test fixture-directory created-files
syms-to-restore)))))
+
+(defun eglot--cleanup-after-test (fixture-directory created-files
syms-to-restore)
+ (let ((buffers-to-delete
+ (delete nil (mapcar #'find-buffer-visiting created-files))))
+ (eglot--message "Killing %s, wiping %s, restoring %s"
+ buffers-to-delete
+ fixture-directory
+ (mapcar #'car syms-to-restore))
+ (cl-loop for (sym . val) in syms-to-restore
+ do (set sym val))
+ (dolist (buf buffers-to-delete) ;; have to save otherwise will get prompted
+ (with-current-buffer buf (save-buffer) (kill-buffer)))
+ (delete-directory fixture-directory 'recursive)))
+
+(cl-defmacro eglot--with-timeout (timeout &body body)
+ (declare (indent 1) (debug t))
+ `(eglot--call-with-timeout ,timeout (lambda () ,@body)))
+
+(defun eglot--call-with-timeout (timeout fn)
+ (let* ((tag (gensym "eglot-test-timeout"))
+ (timed-out (make-symbol "timeout"))
+ (timeout-and-message
+ (if (listp timeout) timeout
+ (list timeout "waiting for test to finish")))
+ (timeout (car timeout-and-message))
+ (message (cadr timeout-and-message))
+ (timer)
+ (retval))
+ (unwind-protect
+ (setq retval
+ (catch tag
+ (setq timer
+ (run-with-timer timeout nil
+ (lambda ()
+ (unless edebug-active
+ (throw tag timed-out)))))
+ (funcall fn)))
+ (cancel-timer timer)
+ (when (eq retval timed-out)
+ (error "%s" (concat "Timed out " message))))))
+
+(defun eglot--find-file-noselect (file &optional noerror)
+ (unless (or noerror
+ (file-readable-p file)) (error "%s does not exist" file))
+ (find-file-noselect file))
+
+(cl-defmacro eglot--sniffing ((&key server-requests
+ server-notifications
+ server-replies
+ client-requests
+ client-notifications
+ client-replies)
+ &rest body)
+ "Run BODY saving LSP JSON messages in variables, most recent first."
+ (declare (indent 1) (debug (sexp &rest form)))
+ (let ((log-event-ad-sym (make-symbol "eglot--event-sniff")))
+ `(unwind-protect
+ (let ,(delq nil (list server-requests
+ server-notifications
+ server-replies
+ client-requests
+ client-notifications
+ client-replies))
+ (advice-add
+ #'jsonrpc--log-event :before
+ (lambda (_proc message &optional type)
+ (cl-destructuring-bind (&key method id _error &allow-other-keys)
+ message
+ (let ((req-p (and method id))
+ (notif-p method)
+ (reply-p id))
+ (cond
+ ((eq type 'server)
+ (cond (req-p ,(when server-requests
+ `(push message ,server-requests)))
+ (notif-p ,(when server-notifications
+ `(push message ,server-notifications)))
+ (reply-p ,(when server-replies
+ `(push message ,server-replies)))))
+ ((eq type 'client)
+ (cond (req-p ,(when client-requests
+ `(push message ,client-requests)))
+ (notif-p ,(when client-notifications
+ `(push message ,client-notifications)))
+ (reply-p ,(when client-replies
+ `(push message ,client-replies)))))))))
+ '((name . ,log-event-ad-sym)))
+ ,@body)
+ (advice-remove #'jsonrpc--log-event ',log-event-ad-sym))))
+
+(cl-defmacro eglot--wait-for ((events-sym &optional (timeout 1) message) args
&body body)
+ "Spin until FN match in EVENTS-SYM, flush events after it.
+Pass TIMEOUT to `eglot--with-timeout'."
+ (declare (indent 2) (debug (sexp sexp sexp &rest form)))
+ `(eglot--with-timeout '(,timeout ,(or message
+ (format "waiting for:\n%s"
(pp-to-string body))))
+ (let ((event
+ (cl-loop thereis (cl-loop for json in ,events-sym
+ for method = (plist-get json :method)
+ when (keywordp method)
+ do (plist-put json :method
+ (substring
+ (symbol-name method)
+ 1))
+ when (funcall
+ (jsonrpc-lambda ,args ,@body) json)
+ return (cons json before)
+ collect json into before)
+ for i from 0
+ when (zerop (mod i 5))
+ ;; do (eglot--message "still struggling to find in %s"
+ ;; ,events-sym)
+ do
+ ;; `read-event' is essential to have the file
+ ;; watchers come through.
+ (read-event "[eglot] Waiting a bit..." nil 0.1)
+ (accept-process-output nil 0.1))))
+ (setq ,events-sym (cdr event))
+ (eglot--message "Event detected:\n%s"
+ (pp-to-string (car event))))))
+
+;; `rust-mode' is not a part of Emacs, so we define these two shims
+;; which should be more than enough for testing.
+(unless (functionp 'rust-mode)
+ (define-derived-mode rust-mode prog-mode "Rust")
+ (add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-mode)))
+
+;; `typescript-mode' is not a part of Emacs, so we define these two
+;; shims which should be more than enough for testing.
+(unless (functionp 'typescript-mode)
+ (define-derived-mode typescript-mode prog-mode "TypeScript")
+ (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-mode)))
+
+(defun eglot--tests-connect (&optional timeout)
+ (let* ((timeout (or timeout 10))
+ (eglot-sync-connect t)
+ (eglot-connect-timeout timeout))
+ (apply #'eglot--connect (eglot--guess-contact))))
+
+(defun eglot--simulate-key-event (char)
+ "Like (execute-kbd-macro (vector char)), but with `call-interactively'."
+ ;; Also, this is a bit similar to what electric-tests.el does.
+ (setq last-input-event char)
+ (setq last-command-event char)
+ (call-interactively (key-binding (vector char))))
+
+
+;;; Unit tests
+
+(ert-deftest eclipse-connect ()
+ "Connect to eclipse.jdt.ls server."
+ (skip-unless (executable-find "jdtls"))
+ (eglot--with-fixture
+ '(("project/src/main/java/foo" . (("Main.java" . "")))
+ ("project/.git/" . nil))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/src/main/java/foo/Main.java")
+ (eglot--sniffing (:server-notifications s-notifs)
+ (should (eglot--tests-connect 20))
+ (eglot--wait-for (s-notifs 10)
+ (&key _id method &allow-other-keys)
+ (string= method "language/status"))))))
+
+(defun eglot-tests--auto-detect-running-server-1 ()
+ (let (server)
+ (eglot--with-fixture
+ `(("project" . (("coiso.c" . "bla")
+ ("merdix.c" . "bla")))
+ ("anotherproject" . (("cena.c" . "bla"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/coiso.c")
+ (should (setq server (eglot--tests-connect)))
+ (should (eglot-current-server)))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/merdix.c")
+ (should (eglot-current-server))
+ (should (eq (eglot-current-server) server)))
+ (with-current-buffer
+ (eglot--find-file-noselect "anotherproject/cena.c")
+ (should-error (eglot--current-server-or-lose))))))
+
+(ert-deftest auto-detect-running-server ()
+ "Visit a file and \\[eglot], then visit a neighbour."
+ (skip-unless (executable-find "clangd"))
+ (eglot-tests--auto-detect-running-server-1))
+
+(ert-deftest auto-shutdown ()
+ "Visit a file and \\[eglot], then kill buffer."
+ (skip-unless (executable-find "clangd"))
+ (let (server
+ buffer)
+ (eglot--with-fixture
+ `(("project" . (("thingy.c" . "int main() {return 0;}"))))
+ (with-current-buffer
+ (setq buffer (eglot--find-file-noselect "project/thingy.c"))
+ (should (setq server (eglot--tests-connect)))
+ (should (eglot-current-server))
+ (let ((eglot-autoshutdown nil)) (kill-buffer buffer))
+ (should (jsonrpc-running-p server))
+ ;; re-find file...
+ (setq buffer (eglot--find-file-noselect (buffer-file-name buffer)))
+ ;; ;; but now kill it with `eglot-autoshutdown' set to t
+ (let ((eglot-autoshutdown t)) (kill-buffer buffer))
+ (should (not (jsonrpc-running-p server)))))))
+
+(ert-deftest auto-reconnect ()
+ "Start a server. Kill it. Watch it reconnect."
+ (skip-unless (executable-find "clangd"))
+ (let (server (eglot-autoreconnect 1))
+ (eglot--with-fixture
+ `(("project" . (("thingy.c" . "bla")
+ ("thingy2.c" . "bla"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/thingy.c")
+ (should (setq server (eglot--tests-connect)))
+ ;; In 1.2 seconds > `eglot-autoreconnect' kill servers. We
+ ;; should have a automatic reconnection.
+ (run-with-timer 1.2 nil (lambda () (delete-process
+ (jsonrpc--process server))))
+ (while (jsonrpc-running-p server) (accept-process-output nil 0.5))
+ (should (eglot-current-server))
+ ;; Now try again too quickly
+ (setq server (eglot-current-server))
+ (let ((proc (jsonrpc--process server)))
+ (run-with-timer 0.5 nil (lambda () (delete-process proc)))
+ (while (process-live-p proc) (accept-process-output nil 0.5)))
+ (should (not (eglot-current-server)))))))
+
+(ert-deftest rust-analyzer-watches-files ()
+ "Start rust-analyzer. Notify it when a critical file changes."
+ (skip-unless (executable-find "rust-analyzer"))
+ (skip-unless (executable-find "cargo"))
+ (let ((eglot-autoreconnect 1))
+ (eglot--with-fixture
+ '(("watch-project" . (("coiso.rs" . "bla")
+ ("merdix.rs" . "bla"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "watch-project/coiso.rs")
+ (should (zerop (shell-command "cargo init")))
+ (eglot--sniffing (
+ :server-requests s-requests
+ :client-notifications c-notifs
+ :client-replies c-replies
+ )
+ (should (eglot--tests-connect))
+ (let (register-id)
+ (eglot--wait-for (s-requests 1)
+ (&key id method &allow-other-keys)
+ (setq register-id id)
+ (string= method "client/registerCapability"))
+ (eglot--wait-for (c-replies 1)
+ (&key id error &allow-other-keys)
+ (and (eq id register-id) (null error))))
+ (delete-file "Cargo.toml")
+ (eglot--wait-for
+ (c-notifs 3 "waiting for didChangeWatchedFiles notification")
+ (&key method params &allow-other-keys)
+ (and (string= method "workspace/didChangeWatchedFiles")
+ (cl-destructuring-bind (&key uri type)
+ (elt (plist-get params :changes) 0)
+ (and (string= (eglot--path-to-uri "Cargo.toml") uri)
+ (= type 3))))))))))
+
+(ert-deftest basic-diagnostics ()
+ "Test basic diagnostics."
+ (skip-unless (executable-find "clangd"))
+ (eglot--with-fixture
+ `(("diag-project" .
+ (("main.c" . "int main(){froat a = 42.2; return 0;}"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "diag-project/main.c")
+ (eglot--sniffing (:server-notifications s-notifs)
+ (eglot--tests-connect)
+ (eglot--wait-for (s-notifs 2)
+ (&key _id method &allow-other-keys)
+ (string= method "textDocument/publishDiagnostics"))
+ (flymake-start)
+ (goto-char (point-min))
+ (flymake-goto-next-error 1 '() t)
+ (should (eq 'flymake-error (face-at-point)))))))
+
+(ert-deftest diagnostic-tags-unnecessary-code ()
+ "Test rendering of diagnostics tagged \"unnecessary\"."
+ (skip-unless (executable-find "rust-analyzer"))
+ (eglot--with-fixture
+ '(("diagnostic-tag-project" .
+ (("main.rs" .
+ "fn main() -> () { let test=3; }"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "diagnostic-tag-project/main.rs")
+ (let ((eglot-server-programs '((rust-mode . ("rust-analyzer")))))
+ (should (zerop (shell-command "cargo init")))
+ (eglot--sniffing (:server-notifications s-notifs)
+ (eglot--tests-connect)
+ (eglot--wait-for (s-notifs 10)
+ (&key _id method &allow-other-keys)
+ (string= method "textDocument/publishDiagnostics"))
+ (flymake-start)
+ (goto-char (point-min))
+ (flymake-goto-next-error 1 '() t)
+ (should (eq 'eglot-diagnostic-tag-unnecessary-face
(face-at-point))))))))
+
+(defun eglot--eldoc-on-demand ()
+ ;; Trick Eldoc 1.1.0 into accepting on-demand calls.
+ (eldoc t))
+
+(defun eglot--tests-force-full-eldoc ()
+ ;; FIXME: This uses some Eldoc implementation defatils.
+ (when (buffer-live-p eldoc--doc-buffer)
+ (with-current-buffer eldoc--doc-buffer
+ (let ((inhibit-read-only t))
+ (erase-buffer))))
+ (eglot--eldoc-on-demand)
+ (cl-loop
+ repeat 10
+ for retval = (and (buffer-live-p eldoc--doc-buffer)
+ (with-current-buffer eldoc--doc-buffer
+ (let ((bs (buffer-string)))
+ (unless (zerop (length bs)) bs))))
+ when retval return retval
+ do (sit-for 0.5)
+ finally (error "eglot--tests-force-full-eldoc didn't deliver")))
+
+(ert-deftest rust-analyzer-hover-after-edit ()
+ "Hover and highlightChanges."
+ (skip-unless (executable-find "rust-analyzer"))
+ (skip-unless (executable-find "cargo"))
+ (eglot--with-fixture
+ '(("hover-project" .
+ (("main.rs" .
+ "fn test() -> i32 { let test=3; return te; }"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "hover-project/main.rs")
+ (should (zerop (shell-command "cargo init")))
+ (eglot--sniffing (
+ :server-replies s-replies
+ :client-requests c-reqs
+ )
+ (eglot--tests-connect)
+ (goto-char (point-min))
+ (search-forward "return te")
+ (insert "st")
+ (progn
+ ;; simulate these two which don't happen when buffer isn't
+ ;; visible in a window.
+ (eglot--signal-textDocument/didChange)
+ (eglot--eldoc-on-demand))
+ (let (pending-id)
+ (eglot--wait-for (c-reqs 2)
+ (&key id method &allow-other-keys)
+ (setq pending-id id)
+ (string= method "textDocument/documentHighlight"))
+ (eglot--wait-for (s-replies 2)
+ (&key id &allow-other-keys)
+ (eq id pending-id)))))))
+
+(ert-deftest rename-a-symbol ()
+ "Test basic symbol renaming."
+ (skip-unless (executable-find "clangd"))
+ (eglot--with-fixture
+ `(("rename-project"
+ . (("main.c" .
+ "int foo() {return 42;} int main() {return foo();}"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "rename-project/main.c")
+ (eglot--tests-connect)
+ (goto-char (point-min)) (search-forward "foo")
+ (eglot-rename "bar")
+ (should (equal (buffer-string)
+ "int bar() {return 42;} int main() {return bar();}")))))
+
+(ert-deftest basic-completions ()
+ "Test basic autocompletion in a python LSP."
+ (skip-unless (executable-find "pylsp"))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "import sys\nsys.exi"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (should (eglot--tests-connect))
+ (goto-char (point-max))
+ (completion-at-point)
+ (should (looking-back "sys.exit")))))
+
+(ert-deftest non-unique-completions ()
+ "Test completion resulting in 'Complete, but not unique'."
+ (skip-unless (executable-find "pylsp"))
+ (eglot--with-fixture
+ '(("project" . (("something.py" . "foo=1\nfoobar=2\nfoo"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (should (eglot--tests-connect))
+ (goto-char (point-max))
+ (completion-at-point))
+ ;; FIXME: `current-message' doesn't work here :-(
+ (with-current-buffer (messages-buffer)
+ (save-excursion
+ (goto-char (point-max))
+ (forward-line -1)
+ (should (looking-at "Complete, but not unique"))))))
+
+(ert-deftest basic-xref ()
+ "Test basic xref functionality in a python LSP."
+ (skip-unless (executable-find "pylsp"))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "def foo(): pass\ndef bar(): foo()"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (should (eglot--tests-connect))
+ (search-forward "bar(): f")
+ (call-interactively 'xref-find-definitions)
+ (should (looking-at "foo(): pass")))))
+
+(defvar eglot--test-python-buffer
+ "\
+def foobarquux(a, b, c=True): pass
+def foobazquuz(d, e, f): pass
+")
+
+(declare-function yas-minor-mode nil)
+
+(ert-deftest snippet-completions ()
+ "Test simple snippet completion in a python LSP."
+ (skip-unless (and (executable-find "pylsp")
+ (functionp 'yas-minor-mode)))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . ,eglot--test-python-buffer))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (yas-minor-mode 1)
+ (let ((eglot-workspace-configuration
+ `((:pylsp . (:plugins (:jedi_completion (:include_params t)))))))
+ (should (eglot--tests-connect)))
+ (goto-char (point-max))
+ (insert "foobar")
+ (completion-at-point)
+ (should (looking-back "foobarquux("))
+ (should (looking-at "a, b)")))))
+
+(defvar company-candidates)
+(declare-function company-mode nil)
+(declare-function company-complete nil)
+
+(ert-deftest snippet-completions-with-company ()
+ "Test simple snippet completion in a python LSP."
+ (skip-unless (and (executable-find "pylsp")
+ (functionp 'yas-minor-mode)
+ (functionp 'company-complete)))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . ,eglot--test-python-buffer))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (yas-minor-mode 1)
+ (let ((eglot-workspace-configuration
+ `((:pylsp . (:plugins (:jedi_completion (:include_params t)))))))
+ (should (eglot--tests-connect)))
+ (goto-char (point-max))
+ (insert "foo")
+ (company-mode)
+ (company-complete)
+ (should (looking-back "fooba"))
+ (should (= 2 (length company-candidates)))
+ ;; this last one is brittle, since there it is possible that
+ ;; pylsp will change the representation of this candidate
+ (should (member "foobazquuz(d, e, f)" company-candidates)))))
+
+(ert-deftest eglot-eldoc-after-completions ()
+ "Test documentation echo in a python LSP."
+ (skip-unless (executable-find "pylsp"))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "import sys\nsys.exi"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (should (eglot--tests-connect))
+ (goto-char (point-max))
+ (completion-at-point)
+ (should (looking-back "sys.exit"))
+ (should (string-match "^exit" (eglot--tests-force-full-eldoc))))))
+
+(ert-deftest eglot-multiline-eldoc ()
+ "Test if suitable amount of lines of hover info are shown."
+ (skip-unless (executable-find "pylsp"))
+ (eglot--with-fixture
+ `(("project" . (("hover-first.py" . "from datetime import datetime"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/hover-first.py")
+ (should (eglot--tests-connect))
+ (goto-char (point-max))
+ ;; one-line
+ (let* ((eldoc-echo-area-use-multiline-p t)
+ (captured-message (eglot--tests-force-full-eldoc)))
+ (should (string-match "datetim" captured-message))
+ (should (cl-find ?\n captured-message))))))
+
+(ert-deftest eglot-single-line-eldoc ()
+ "Test if suitable amount of lines of hover info are shown."
+ (skip-unless (executable-find "pylsp"))
+ (eglot--with-fixture
+ `(("project" . (("hover-first.py" . "from datetime import datetime"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/hover-first.py")
+ (should (eglot--tests-connect))
+ (goto-char (point-max))
+ ;; one-line
+ (let* ((eldoc-echo-area-use-multiline-p nil)
+ (captured-message (eglot--tests-force-full-eldoc)))
+ (should (string-match "datetim" captured-message))
+ (should (not (cl-find ?\n eldoc-last-message)))))))
+
+(ert-deftest python-autopep-formatting ()
+ "Test formatting in the pylsp python LSP.
+pylsp prefers autopep over yafp, despite its README stating the contrary."
+ ;; Beware, default autopep rules can change over time, which may
+ ;; affect this test.
+ (skip-unless (and (executable-find "pylsp")
+ (executable-find "autopep8")))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "def a():pass\n\ndef b():pass"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (should (eglot--tests-connect))
+ ;; Try to format just the second line
+ (search-forward "b():pa")
+ (eglot-format (line-beginning-position) (line-end-position))
+ (should (looking-at "ss"))
+ (should
+ (string= (buffer-string) "def a():pass\n\n\ndef b(): pass\n"))
+ ;; now format the whole buffer
+ (eglot-format-buffer)
+ (should
+ (string= (buffer-string) "def a(): pass\n\n\ndef b(): pass\n")))))
+
+(ert-deftest python-yapf-formatting ()
+ "Test formatting in the pylsp python LSP."
+ (skip-unless (and (executable-find "pylsp")
+ (not (executable-find "autopep8"))
+ (or (executable-find "yapf")
+ (executable-find "yapf3"))))
+ (eglot--with-fixture
+ `(("project" . (("something.py" . "def a():pass\ndef b():pass"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.py")
+ (should (eglot--tests-connect))
+ ;; Try to format just the second line
+ (search-forward "b():pa")
+ (eglot-format (line-beginning-position) (line-end-position))
+ (should (looking-at "ss"))
+ (should
+ (string= (buffer-string) "def a():pass\n\n\ndef b():\n pass\n"))
+ ;; now format the whole buffer
+ (eglot-format-buffer)
+ (should
+ (string= (buffer-string) "def a():\n pass\n\n\ndef b():\n
pass\n")))))
+
+(ert-deftest rust-on-type-formatting ()
+ "Test textDocument/onTypeFormatting agains rust-analyzer."
+ (skip-unless (executable-find "rust-analyzer"))
+ (skip-unless (executable-find "cargo"))
+ (eglot--with-fixture
+ '(("on-type-formatting-project" .
+ (("main.rs" .
+ "fn main() -> () {\n foo\n .bar()\n "))))
+ (with-current-buffer
+ (eglot--find-file-noselect "on-type-formatting-project/main.rs")
+ (let ((eglot-server-programs '((rust-mode . ("rust-analyzer")))))
+ (should (zerop (shell-command "cargo init")))
+ (eglot--sniffing (:server-notifications s-notifs)
+ (should (eglot--tests-connect))
+ (eglot--wait-for (s-notifs 10) (&key method &allow-other-keys)
+ (string= method "textDocument/publishDiagnostics")))
+ (goto-char (point-max))
+ (eglot--simulate-key-event ?.)
+ (should (looking-back "^ \\."))))))
+
+(ert-deftest javascript-basic ()
+ "Test basic autocompletion in a JavaScript LSP."
+ (skip-unless (executable-find "typescript-language-server"))
+ (eglot--with-fixture
+ '(("project" . (("hello.js" . "console.log('Hello world!');"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/hello.js")
+ (let ((eglot-server-programs
+ '((js-mode . ("typescript-language-server" "--stdio")))))
+ (goto-char (point-max))
+ (eglot--sniffing (:server-notifications
+ s-notifs
+ :client-notifications
+ c-notifs)
+ (should (eglot--tests-connect))
+ (eglot--wait-for (s-notifs 2) (&key method &allow-other-keys)
+ (string= method "textDocument/publishDiagnostics"))
+ (should (not (eq 'flymake-error (face-at-point))))
+ (insert "{")
+ (eglot--signal-textDocument/didChange)
+ (eglot--wait-for (c-notifs 1) (&key method &allow-other-keys)
+ (string= method "textDocument/didChange"))
+ (eglot--wait-for (s-notifs 2) (&key params method &allow-other-keys)
+ (and (string= method "textDocument/publishDiagnostics")
+ (cl-destructuring-bind (&key _uri diagnostics) params
+ (cl-find-if (jsonrpc-lambda (&key severity
&allow-other-keys)
+ (= severity 1))
+ diagnostics)))))))))
+
+(ert-deftest project-wide-diagnostics-typescript ()
+ "Test diagnostics through multiple files in a TypeScript LSP."
+ (skip-unless (executable-find "typescript-language-server"))
+ (eglot--with-fixture
+ '(("project" . (("hello.ts" . "const thing = 5;\nexport { thin }")
+ ("hello2.ts" . "import { thing } from './hello'"))))
+ (eglot--make-file-or-dir '(".git"))
+ (let ((eglot-server-programs
+ '((typescript-mode . ("typescript-language-server" "--stdio")))))
+ ;; Check both files because typescript-language-server doesn't
+ ;; report all errors on startup, at least not with such a simple
+ ;; setup.
+ (with-current-buffer (eglot--find-file-noselect "project/hello2.ts")
+ (eglot--sniffing (:server-notifications s-notifs)
+ (eglot--tests-connect)
+ (flymake-start)
+ (eglot--wait-for (s-notifs 10)
+ (&key _id method &allow-other-keys)
+ (string= method "textDocument/publishDiagnostics"))
+ (should (= 2 (length (flymake--project-diagnostics)))))
+ (with-current-buffer (eglot--find-file-noselect "hello.ts")
+ (eglot--sniffing (:server-notifications s-notifs)
+ (flymake-start)
+ (eglot--wait-for (s-notifs 10)
+ (&key _id method &allow-other-keys)
+ (string= method "textDocument/publishDiagnostics"))
+ (should (= 4 (length (flymake--project-diagnostics))))))))))
+
+(ert-deftest project-wide-diagnostics-rust-analyzer ()
+ "Test diagnostics through multiple files in a TypeScript LSP."
+ (skip-unless (executable-find "rust-analyzer"))
+ (eglot--with-fixture
+ '(("project" .
+ (("main.rs" .
+ "fn main() -> () { let test=3; }")
+ ("other-file.rs" .
+ "fn foo() -> () { let hi=3; }"))))
+ (eglot--make-file-or-dir '(".git"))
+ (let ((eglot-server-programs '((rust-mode . ("rust-analyzer")))))
+ ;; Open other-file, and see diagnostics arrive for main.rs
+ (with-current-buffer (eglot--find-file-noselect "project/other-file.rs")
+ (should (zerop (shell-command "cargo init")))
+ (eglot--sniffing (:server-notifications s-notifs)
+ (eglot--tests-connect)
+ (flymake-start)
+ (eglot--wait-for (s-notifs 10)
+ (&key _id method &allow-other-keys)
+ (string= method "textDocument/publishDiagnostics"))
+ (let ((diags (flymake--project-diagnostics)))
+ (should (= 2 (length diags)))
+ ;; Check that we really get a diagnostic from main.rs, and
+ ;; not from other-file.rs
+ (should (string-suffix-p
+ "main.rs"
+ (flymake-diagnostic-buffer (car diags))))))))))
+
+(ert-deftest json-basic ()
+ "Test basic autocompletion in vscode-json-languageserver."
+ (skip-unless (executable-find "vscode-json-languageserver"))
+ (eglot--with-fixture
+ '(("project" .
+ (("p.json" . "{\"foo.b")
+ ("s.json" . "{\"properties\":{\"foo.bar\":{\"default\":\"fb\"}}}")
+ (".git" . nil))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/p.json")
+ (yas-minor-mode)
+ (goto-char 2)
+ (insert "\"$schema\": \"file://"
+ (file-name-directory buffer-file-name) "s.json\",")
+ (let ((eglot-server-programs
+ '((js-mode . ("vscode-json-languageserver" "--stdio")))))
+ (goto-char (point-max))
+ (should (eglot--tests-connect))
+ (completion-at-point)
+ (should (looking-back "\"foo.bar\": \""))
+ (should (looking-at "fb\"$"))))))
+
+(defun eglot-tests--lsp-abiding-column-1 ()
+ (eglot--with-fixture
+ '(("project" .
+ (("foo.c" . "const char write_data[] =
u8\"🚂🚃🚄🚅🚆🚈🚇🚈🚉🚊🚋🚌🚎🚝🚞🚟🚠🚡🛤🛲\";"))))
+ (let ((eglot-server-programs
+ '((c-mode . ("clangd")))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/foo.c")
+ (setq-local eglot-move-to-column-function
#'eglot-move-to-lsp-abiding-column)
+ (setq-local eglot-current-column-function #'eglot-lsp-abiding-column)
+ (eglot--sniffing (:client-notifications c-notifs)
+ (eglot--tests-connect)
+ (end-of-line)
+ (insert "p ")
+ (eglot--signal-textDocument/didChange)
+ (eglot--wait-for (c-notifs 2) (&key params &allow-other-keys)
+ (should (equal 71 (cadddr (cadadr (aref (cadddr params) 0))))))
+ (beginning-of-line)
+ (should (eq eglot-move-to-column-function
#'eglot-move-to-lsp-abiding-column))
+ (funcall eglot-move-to-column-function 71)
+ (should (looking-at "p")))))))
+
+(ert-deftest eglot-lsp-abiding-column ()
+ "Test basic `eglot-lsp-abiding-column' and
`eglot-move-to-lsp-abiding-column'."
+ (skip-unless (executable-find "clangd"))
+ (eglot-tests--lsp-abiding-column-1))
+
+(ert-deftest eglot-ensure ()
+ "Test basic `eglot-ensure' functionality."
+ (skip-unless (executable-find "clangd"))
+ (eglot--with-fixture
+ `(("project" . (("foo.c" . "int foo() {return 42;}")
+ ("bar.c" . "int bar() {return 42;}")))
+ (c-mode-hook (eglot-ensure)))
+ (let (server)
+ ;; need `ert-simulate-command' because `eglot-ensure'
+ ;; relies on `post-command-hook'.
+ (with-current-buffer
+ (ert-simulate-command
+ '(find-file "project/foo.c"))
+ ;; FIXME: This test fails without this sleep on my machine.
+ ;; Figure out why and solve this more cleanly.
+ (sleep-for 0.1)
+ (should (setq server (eglot-current-server))))
+ (with-current-buffer
+ (ert-simulate-command
+ '(find-file "project/bar.c"))
+ (should (eq server (eglot-current-server)))))))
+
+(ert-deftest slow-sync-connection-wait ()
+ "Connect with `eglot-sync-connect' set to t."
+ (skip-unless (executable-find "clangd"))
+ (eglot--with-fixture
+ `(("project" . (("something.c" . "int foo() {return 42;}"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.c")
+ (let ((eglot-sync-connect t)
+ (eglot-server-programs
+ `((c-mode . ("sh" "-c" "sleep 1 && clangd")))))
+ (should (eglot--tests-connect 3))))))
+
+(ert-deftest slow-sync-connection-intime ()
+ "Connect synchronously with `eglot-sync-connect' set to 2."
+ (skip-unless (executable-find "clangd"))
+ (eglot--with-fixture
+ `(("project" . (("something.c" . "int foo() {return 42;}"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.c")
+ (let ((eglot-sync-connect 2)
+ (eglot-server-programs
+ `((c-mode . ("sh" "-c" "sleep 1 && clangd")))))
+ (should (eglot--tests-connect 3))))))
+
+(ert-deftest slow-async-connection ()
+ "Connect asynchronously with `eglot-sync-connect' set to 2."
+ (skip-unless (executable-find "clangd"))
+ (eglot--with-fixture
+ `(("project" . (("something.c" . "int foo() {return 42;}"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.c")
+ (let ((eglot-sync-connect 1)
+ (eglot-server-programs
+ `((c-mode . ("sh" "-c" "sleep 2 && clangd")))))
+ (should-not (apply #'eglot--connect (eglot--guess-contact)))
+ (eglot--with-timeout 3
+ (while (not (eglot-current-server))
+ (accept-process-output nil 0.2))
+ (should (eglot-current-server)))))))
+
+(ert-deftest slow-sync-timeout ()
+ "Failed attempt at connection synchronously."
+ (skip-unless (executable-find "clangd"))
+ (eglot--with-fixture
+ `(("project" . (("something.c" . "int foo() {return 42;}"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/something.c")
+ (let ((eglot-sync-connect t)
+ (eglot-connect-timeout 1)
+ (eglot-server-programs
+ `((c-mode . ("sh" "-c" "sleep 2 && clangd")))))
+ (should-error (apply #'eglot--connect (eglot--guess-contact)))))))
+
+(ert-deftest eglot-capabilities ()
+ "Unit test for `eglot--server-capable'."
+ (cl-letf (((symbol-function 'eglot--capabilities)
+ (lambda (_dummy)
+ ;; test data lifted from Golangserver example at
+ ;; https://github.com/joaotavora/eglot/pull/74
+ (list :textDocumentSync 2 :hoverProvider t
+ :completionProvider '(:triggerCharacters ["."])
+ :signatureHelpProvider '(:triggerCharacters ["(" ","])
+ :definitionProvider t :typeDefinitionProvider t
+ :referencesProvider t :documentSymbolProvider t
+ :workspaceSymbolProvider t :implementationProvider t
+ :documentFormattingProvider t
:xworkspaceReferencesProvider t
+ :xdefinitionProvider t :xworkspaceSymbolByProperties t)))
+ ((symbol-function 'eglot--current-server-or-lose)
+ (lambda () nil)))
+ (should (eql 2 (eglot--server-capable :textDocumentSync)))
+ (should (eglot--server-capable :completionProvider :triggerCharacters))
+ (should (equal '(:triggerCharacters ["."]) (eglot--server-capable
:completionProvider)))
+ (should-not (eglot--server-capable :foobarbaz))
+ (should-not (eglot--server-capable :textDocumentSync :foobarbaz))))
+
+(defmacro eglot--without-interface-warnings (&rest body)
+ (let ((eglot-strict-mode nil))
+ (macroexpand-all (macroexp-progn body) macroexpand-all-environment)))
+
+(ert-deftest eglot-strict-interfaces ()
+ (let ((eglot--lsp-interface-alist
+ `((FooObject . ((:foo :bar) (:baz))))))
+ (eglot--without-interface-warnings
+ (should
+ (equal '("foo" . "bar")
+ (let ((eglot-strict-mode nil))
+ (eglot--dbind (foo bar) `(:foo "foo" :bar "bar")
+ (cons foo bar)))))
+ (should-error
+ (let ((eglot-strict-mode '(disallow-non-standard-keys)))
+ (eglot--dbind (foo bar) `(:foo "foo" :bar "bar" :fotrix bargh)
+ (cons foo bar))))
+ (should
+ (equal '("foo" . "bar")
+ (let ((eglot-strict-mode nil))
+ (eglot--dbind (foo bar) `(:foo "foo" :bar "bar" :fotrix bargh)
+ (cons foo bar)))))
+ (should-error
+ (let ((eglot-strict-mode '(disallow-non-standard-keys)))
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :fotrix
bargh)
+ (cons foo bar))))
+ (should
+ (equal '("foo" . "bar")
+ (let ((eglot-strict-mode '(disallow-non-standard-keys)))
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar"
:baz bargh)
+ (cons foo bar)))))
+ (should
+ (equal '("foo" . nil)
+ (let ((eglot-strict-mode nil))
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh)
+ (cons foo bar)))))
+ (should
+ (equal '("foo" . "bar")
+ (let ((eglot-strict-mode '(enforce-required-keys)))
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar"
:baz bargh)
+ (cons foo bar)))))
+ (should-error
+ (let ((eglot-strict-mode '(enforce-required-keys)))
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh)
+ (cons foo bar)))))))
+
+(ert-deftest eglot-dcase ()
+ (eglot--without-interface-warnings
+ (let ((eglot--lsp-interface-alist
+ `((FooObject . ((:foo :bar) (:baz)))
+ (CodeAction (:title) (:kind :diagnostics :edit :command))
+ (Command ((:title . string) (:command . string)) (:arguments)))))
+ (should
+ (equal
+ "foo"
+ (eglot--dcase `(:foo "foo" :bar "bar")
+ (((FooObject) foo)
+ foo))))
+ (should
+ (equal
+ (list "foo" '(:title "hey" :command "ho") "some edit")
+ (eglot--dcase '(:title "foo"
+ :command (:title "hey" :command "ho")
+ :edit "some edit")
+ (((Command) _title _command _arguments)
+ (ert-fail "Shouldn't have destructured this object as a Command"))
+ (((CodeAction) title edit command)
+ (list title command edit)))))
+ (should
+ (equal
+ (list "foo" "some command" nil)
+ (eglot--dcase '(:title "foo" :command "some command")
+ (((Command) title command arguments)
+ (list title command arguments))
+ (((CodeAction) _title _edit _command)
+ (ert-fail "Shouldn't have destructured this object as a
CodeAction"))))))))
+
+(ert-deftest eglot-dcase-issue-452 ()
+ (let ((eglot--lsp-interface-alist
+ `((FooObject . ((:foo :bar) (:baz)))
+ (CodeAction (:title) (:kind :diagnostics :edit :command))
+ (Command ((string . :title) (:command . string)) (:arguments)))))
+ (should
+ (equal
+ (list "foo" '(:command "cmd" :title "alsofoo"))
+ (eglot--dcase '(:title "foo" :command (:command "cmd" :title "alsofoo"))
+ (((Command) _title _command _arguments)
+ (ert-fail "Shouldn't have destructured this object as a Command"))
+ (((CodeAction) title command)
+ (list title command)))))))
+
+(cl-defmacro eglot--guessing-contact ((interactive-sym
+ prompt-args-sym
+ guessed-class-sym guessed-contact-sym
+ &optional guessed-lang-id-sym)
+ &body body)
+ "Guess LSP contact with `eglot--guessing-contact', evaluate BODY.
+
+BODY is evaluated twice, with INTERACTIVE bound to the boolean passed to
+`eglot--guess-contact' each time.
+
+If the user would have been prompted, PROMPT-ARGS-SYM is bound to
+the list of arguments that would have been passed to
+`read-shell-command', else nil. GUESSED-CLASS-SYM,
+GUESSED-CONTACT-SYM and GUESSED-LANG-ID-SYM are bound to the
+useful return values of `eglot--guess-contact'. Unless the
+server program evaluates to \"a-missing-executable.exe\", this
+macro will assume it exists."
+ (declare (indent 1) (debug t))
+ (let ((i-sym (cl-gensym)))
+ `(dolist (,i-sym '(nil t))
+ (let ((,interactive-sym ,i-sym)
+ (buffer-file-name "_")
+ ,@(when prompt-args-sym `((,prompt-args-sym nil))))
+ (cl-letf (((symbol-function 'executable-find)
+ (lambda (name &optional _remote)
+ (unless (string-equal name "a-missing-executable.exe")
+ (format "/totally-mock-bin/%s" name))))
+ ((symbol-function 'read-shell-command)
+ ,(if prompt-args-sym
+ `(lambda (&rest args) (setq ,prompt-args-sym args) "")
+ `(lambda (&rest _dummy) ""))))
+ (cl-destructuring-bind
+ (_ _ ,guessed-class-sym ,guessed-contact-sym
+ ,(or guessed-lang-id-sym '_))
+ (eglot--guess-contact ,i-sym)
+ ,@body))))))
+
+(ert-deftest eglot-server-programs-simple-executable ()
+ (let ((eglot-server-programs '((foo-mode "some-executable")))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("some-executable"))))))
+
+(ert-deftest eglot-server-programs-simple-missing-executable ()
+ (let ((eglot-server-programs '((foo-mode "a-missing-executable.exe")))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (interactive-p prompt-args guessed-class
guessed-contact)
+ (should (equal (not prompt-args) (not interactive-p)))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (or prompt-args
+ (equal guessed-contact '("a-missing-executable.exe")))))))
+
+(ert-deftest eglot-server-programs-executable-multiple-major-modes ()
+ (let ((eglot-server-programs '(((bar-mode foo-mode) "some-executable")))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("some-executable"))))))
+
+(ert-deftest eglot-server-programs-executable-with-arg ()
+ (let ((eglot-server-programs '((foo-mode "some-executable" "arg1")))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("some-executable" "arg1"))))))
+
+(ert-deftest eglot-server-programs-executable-with-args-and-autoport ()
+ (let ((eglot-server-programs '((foo-mode "some-executable" "arg1"
+ :autoport "arg2")))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("some-executable" "arg1"
+ :autoport "arg2"))))))
+
+(ert-deftest eglot-server-programs-host-and-port ()
+ (let ((eglot-server-programs '((foo-mode "somehost.example.com" 7777)))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("somehost.example.com" 7777))))))
+
+(ert-deftest eglot-server-programs-host-and-port-and-tcp-args ()
+ (let ((eglot-server-programs '((foo-mode "somehost.example.com" 7777
+ :type network)))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("somehost.example.com" 7777
+ :type network))))))
+
+(ert-deftest eglot-server-programs-class-name-and-plist ()
+ (let ((eglot-server-programs '((foo-mode bar-class :init-key init-val)))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'bar-class))
+ (should (equal guessed-contact '(:init-key init-val))))))
+
+(ert-deftest eglot-server-programs-class-name-and-contact-spec ()
+ (let ((eglot-server-programs '((foo-mode bar-class "some-executable" "arg1"
+ :autoport "arg2")))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'bar-class))
+ (should (equal guessed-contact '("some-executable" "arg1"
+ :autoport "arg2"))))))
+
+(ert-deftest eglot-server-programs-function ()
+ (let ((eglot-server-programs '((foo-mode . (lambda (&optional _)
+ '("some-executable")))))
+ (major-mode 'foo-mode))
+ (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
+ (should (not prompt-args))
+ (should (equal guessed-class 'eglot-lsp-server))
+ (should (equal guessed-contact '("some-executable"))))))
+
+(ert-deftest eglot-server-programs-guess-lang ()
+ (let ((major-mode 'foo-mode))
+ (let ((eglot-server-programs '((foo-mode . ("prog-executable")))))
+ (eglot--guessing-contact (_ nil _ _ guessed-lang)
+ (should (equal guessed-lang "foo"))))
+ (let ((eglot-server-programs '(((foo-mode :language-id "bar")
+ . ("prog-executable")))))
+ (eglot--guessing-contact (_ nil _ _ guessed-lang)
+ (should (equal guessed-lang "bar"))))
+ (let ((eglot-server-programs '(((baz-mode (foo-mode :language-id "bar"))
+ . ("prog-executable")))))
+ (eglot--guessing-contact (_ nil _ _ guessed-lang)
+ (should (equal guessed-lang "bar"))))))
+
+(defun eglot--glob-match (glob str)
+ (funcall (eglot--glob-compile glob t t) str))
+
+(ert-deftest eglot--glob-test ()
+ (should (eglot--glob-match "foo/**/baz" "foo/bar/baz"))
+ (should (eglot--glob-match "foo/**/baz" "foo/baz"))
+ (should-not (eglot--glob-match "foo/**/baz" "foo/bar"))
+ (should (eglot--glob-match "foo/**/baz/**/quuz" "foo/baz/foo/quuz"))
+ (should (eglot--glob-match "foo/**/baz/**/quuz" "foo/foo/foo/baz/foo/quuz"))
+ (should-not (eglot--glob-match "foo/**/baz/**/quuz"
"foo/foo/foo/ding/foo/quuz"))
+ (should (eglot--glob-match "*.js" "foo.js"))
+ (should-not (eglot--glob-match "*.js" "foo.jsx"))
+ (should (eglot--glob-match "foo/**/*.js" "foo/bar/baz/foo.js"))
+ (should-not (eglot--glob-match "foo/**/*.js" "foo/bar/baz/foo.jsx"))
+ (should (eglot--glob-match "*.{js,ts}" "foo.js"))
+ (should-not (eglot--glob-match "*.{js,ts}" "foo.xs"))
+ (should (eglot--glob-match "foo/**/*.{js,ts}" "foo/bar/baz/foo.ts"))
+ (should (eglot--glob-match "foo/**/*.{js,ts}x" "foo/bar/baz/foo.tsx"))
+ (should (eglot--glob-match "?oo.js" "foo.js"))
+ (should (eglot--glob-match "foo/**/*.{js,ts}?" "foo/bar/baz/foo.tsz"))
+ (should (eglot--glob-match "foo/**/*.{js,ts}?" "foo/bar/baz/foo.tsz"))
+ (should (eglot--glob-match "example.[!0-9]" "example.a"))
+ (should-not (eglot--glob-match "example.[!0-9]" "example.0"))
+ (should (eglot--glob-match "example.[0-9]" "example.0"))
+ (should-not (eglot--glob-match "example.[0-9]" "example.a"))
+ (should (eglot--glob-match "**/bar/" "foo/bar/"))
+ (should-not (eglot--glob-match "foo.hs" "fooxhs"))
+
+ ;; Some more tests
+ (should (eglot--glob-match "**/.*" ".git"))
+ (should (eglot--glob-match ".?" ".o"))
+ (should (eglot--glob-match "**/.*" ".hidden.txt"))
+ (should (eglot--glob-match "**/.*" "path/.git"))
+ (should (eglot--glob-match "**/.*" "path/.hidden.txt"))
+ (should (eglot--glob-match "**/node_modules/**" "node_modules/"))
+ (should (eglot--glob-match "{foo,bar}/**" "foo/test"))
+ (should (eglot--glob-match "{foo,bar}/**" "bar/test"))
+ (should (eglot--glob-match "some/**/*" "some/foo.js"))
+ (should (eglot--glob-match "some/**/*" "some/folder/foo.js"))
+
+ ;; VSCode supposedly supports this, not sure if good idea.
+ ;;
+ ;; (should (eglot--glob-match "**/node_modules/**" "node_modules"))
+ ;; (should (eglot--glob-match "{foo,bar}/**" "foo"))
+ ;; (should (eglot--glob-match "{foo,bar}/**" "bar"))
+
+ ;; VSCode also supports nested blobs. Do we care?
+ ;;
+ ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "/testing/foo.js"))
+ ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "testing/foo.d.ts"))
+ ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js,foo.[0-9]}" "foo.5"))
+ ;; (should (eglot--glob-match "prefix/{**/*.d.ts,**/*.js,foo.[0-9]}"
"prefix/foo.8"))
+ )
+
+(defun eglot--call-with-tramp-test (fn)
+ ;; Set up a loopback TRAMP method that’s just a shell so the remote
+ ;; host is really just the local host.
+ (let ((tramp-remote-path (cons 'tramp-own-remote-path tramp-remote-path))
+ (tramp-histfile-override t)
+ (tramp-methods '(("loopback"
+ (tramp-login-program "/bin/sh")
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c")))))
+ (temporary-file-directory (concat "/loopback::"
+ temporary-file-directory)))
+ ;; With ‘temporary-file-directory’ bound to the ‘loopback’ TRAMP
+ ;; method, fixtures will be automatically made “remote".
+ (unwind-protect
+ (funcall fn)
+ ;; Tramp leave some buffers behind, and some time later,
+ ;; `project-buffers' will trip over them causing a hard to debug
+ ;; intermittent test failure somewhere else.
+ (dolist (buf (buffer-list))
+ (when (string-match-p "^\\*tramp" (buffer-name buf))
+ (kill-buffer buf))))))
+
+(ert-deftest eglot--tramp-test ()
+ "Ensure LSP servers can be used over TRAMP."
+ (skip-unless (executable-find "clangd"))
+ (eglot--call-with-tramp-test #'eglot-tests--auto-detect-running-server-1))
+
+(ert-deftest eglot--tramp-test-2 ()
+ "Ensure LSP servers can be used over TRAMP."
+ (skip-unless (executable-find "clangd"))
+ (eglot--call-with-tramp-test #'eglot-tests--lsp-abiding-column-1))
+
+(ert-deftest eglot--path-to-uri-windows ()
+ (skip-unless (eq system-type 'windows-nt))
+ (should (string-prefix-p "file:///"
+ (eglot--path-to-uri "c:/Users/Foo/bar.lisp")))
+ (should (string-suffix-p "c%3A/Users/Foo/bar.lisp"
+ (eglot--path-to-uri "c:/Users/Foo/bar.lisp"))))
+
+(ert-deftest eglot--same-server-multi-mode ()
+ "Check single LSP instance manages multiple modes in same project."
+ (skip-unless (executable-find "clangd"))
+ (let (server)
+ (eglot--with-fixture
+ `(("project" . (("foo.cpp" .
+ "#include \"foolib.h\"
+ int main() { return foo(); }")
+ ("foolib.h" .
+ "#ifdef __cplusplus\nextern \"C\" {\n#endif
+ int foo();
+ #ifdef __cplusplus\n}\n#endif")
+ ("foolib.c" .
+ "#include \"foolib.h\"
+ int foo() {return 42;}"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/foo.cpp")
+ (should (setq server (eglot--tests-connect))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/foolib.h")
+ (should (eq (eglot-current-server) server)))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/foolib.c")
+ (should (eq (eglot-current-server) server))))))
+
+(provide 'eglot-tests)
+;;; eglot-tests.el ends here
+
+;; Local Variables:
+;; checkdoc-force-docstrings-flag: nil
+;; End: