[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 9e05453a8c2 3/3: Merge remote-tracking branch 'refs/remotes/origi
|
From: |
Stefan Monnier |
|
Subject: |
master 9e05453a8c2 3/3: Merge remote-tracking branch 'refs/remotes/origin/master' |
|
Date: |
Mon, 4 Sep 2023 16:43:36 -0400 (EDT) |
branch: master
commit 9e05453a8c23f882d2849b21a27e752607cfcf3b
Merge: 913ae070e68 59c35bf16fb
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
Merge remote-tracking branch 'refs/remotes/origin/master'
---
doc/misc/eglot.texi | 149 ++++++++++
doc/misc/ert.texi | 23 +-
etc/NEWS | 7 +
lisp/emacs-lisp/ert.el | 39 ++-
lisp/net/shr.el | 5 +-
lisp/progmodes/eglot.el | 392 +++++++++++++------------
lisp/progmodes/idlwave.el | 5 +-
test/lisp/autorevert-tests.el | 2 +-
test/lisp/emacs-lisp/benchmark-tests.el | 4 +-
test/lisp/emacs-lisp/ert-tests.el | 14 +
test/lisp/emacs-lisp/find-func-tests.el | 2 +-
test/lisp/eshell/esh-proc-tests.el | 2 +-
test/lisp/filenotify-tests.el | 2 +-
test/lisp/ibuffer-tests.el | 2 +-
test/lisp/international/ucs-normalize-tests.el | 4 +-
test/lisp/net/network-stream-tests.el | 20 +-
test/lisp/progmodes/cperl-mode-tests.el | 6 +-
test/lisp/progmodes/elisp-mode-tests.el | 8 +-
test/lisp/progmodes/python-tests.el | 2 +-
test/lisp/shadowfile-tests.el | 20 +-
test/lisp/simple-tests.el | 6 +-
test/lisp/term-tests.el | 20 +-
test/lisp/thread-tests.el | 2 +-
test/lisp/vc/vc-tests.el | 4 +-
test/manual/scroll-tests.el | 10 +-
test/misc/test-custom-libs.el | 2 +-
test/src/emacs-module-tests.el | 2 +-
test/src/fileio-tests.el | 2 +-
test/src/filelock-tests.el | 10 +-
test/src/image-tests.el | 6 +-
test/src/process-tests.el | 6 +-
31 files changed, 491 insertions(+), 287 deletions(-)
diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi
index 3338756c63c..89813a17944 100644
--- a/doc/misc/eglot.texi
+++ b/doc/misc/eglot.texi
@@ -99,6 +99,7 @@ This manual documents how to configure, use, and customize
Eglot.
* Using Eglot:: Important Eglot commands and variables.
* Customizing Eglot:: Eglot customization and advanced features.
* Advanced server configuration:: Fine-tune a specific language server
+* Extending Eglot:: Writing Eglot extensions in Elisp
* Troubleshooting Eglot:: Troubleshooting and reporting bugs.
* GNU Free Documentation License:: The license for this manual.
* Index::
@@ -1264,6 +1265,154 @@ is serialized by Eglot to the following JSON text:
@}
@end example
+@node Extending Eglot
+@chapter Extending Eglot
+
+Sometimes it may be useful to extend existing Eglot functionality
+using Elisp its public methods. A good example of when this need may
+arise is adding support for a custom LSP protocol extension only
+implemented by a specific server.
+
+The best source of documentation for this is probably Eglot source
+code itself, particularly the section marked ``API''.
+
+Most of the functionality is implemented with Common-Lisp style
+generic functions (@pxref{Generics,,,eieio,EIEIO}) that can be easily
+extended or overridden. The Eglot code itself is an example on how to
+do this.
+
+The following is a relatively simple example that adds support for the
+@code{inactiveRegions} experimental feature introduced in version 17
+of the @command{clangd} C/C++ language server++.
+
+Summarily, the feature works by first having the server detect the
+Eglot's advertisement of the @code{inactiveRegions} client capability
+during startup, whereupon the language server will report a list of
+regions of inactive code for each buffer. This is usually code
+surrounded by C/C++ @code{#ifdef} macros that the preprocessor removes
+based on compile-time information.
+
+The language server reports the regions by periodically sending a
+@code{textDocument/inactiveRegions} notification for each managed
+buffer (@pxref{Eglot and Buffers}). Normally, unknown server
+notifications are ignored by Eglot, but we're going change that.
+
+Both the announcement of the client capability and the handling of the
+new notification is done by adding methods to generic functions.
+
+@itemize @bullet
+@item
+The first method extends @code{eglot-client-capabilities} using a
+simple heuristic to detect if current server is @command{clangd} and
+enables the @code{inactiveRegion} capability.
+
+@lisp
+(cl-defmethod eglot-client-capabilities :around (server)
+ (let ((base (cl-call-next-method)))
+ (when (cl-find "clangd" (process-command
+ (jsonrpc--process server))
+ :test #'string-match)
+ (setf (cl-getf (cl-getf base :textDocument)
+ :inactiveRegionsCapabilities)
+ '(:inactiveRegions t)))
+ base))
+@end lisp
+
+Notice we use an internal function of the @code{jsonrpc.el} library,
+and a regexp search to detect @command{clangd}. An alternative would
+be to define a new EIEIO subclass of @code{eglot-lsp-server}, maybe
+called @code{eglot-clangd}, so that the method would be simplified:
+
+@lisp
+(cl-defmethod eglot-client-capabilities :around ((_s eglot-clangd))
+ (let ((base (cl-call-next-method)))
+ (setf (cl-getf (cl-getf base :textDocument)
+ :inactiveRegionsCapabilities)
+ '(:inactiveRegions t))))
+@end lisp
+
+However, this would require that users tweak
+@code{eglot-server-program} to tell Eglot instantiate such sub-classes
+instead of the generic @code{eglot-lsp-server} (@pxref{Setting Up LSP
+Servers}). For the purposes of this particular demonstration, we're
+going to use the more hacky regexp route which doesn't require that.
+
+Note, however, that detecting server versions before announcing new
+capabilities is generally not needed, as both server and client are
+required by LSP to ignore unknown capabilities advertised by their
+counterparts.
+
+@item
+The second method implements @code{eglot-handle-notification} to
+process the server notification for the LSP method
+@code{textDocument/inactiveRegions}. For each region received it
+creates an overlay applying the @code{shadow} face to the region.
+Overlays are recreated every time a new notification of this kind is
+received.
+
+To learn about how @command{clangd}'s special JSONRPC notification
+message is structured in detail you could consult that server's
+documentation. Another possibility is to evaluate the first
+capability-announcing method, reconnect to the server and peek in the
+events buffer (@pxref{Eglot Commands, eglot-events-buffer}). You
+could find something like:
+
+@lisp
+[server-notification] Mon Sep 4 01:10:04 2023:
+(:jsonrpc "2.0" :method "textDocument/inactiveRegions" :params
+ (:textDocument
+ (:uri "file:///path/to/file.cpp")
+ :regions
+ [(:start (:character 0 :line 18)
+ :end (:character 58 :line 19))
+ (:start (:character 0 :line 36)
+ :end (:character 1 :line 38))]))
+@end lisp
+
+This reveals that the @code{textDocument/inactiveRegions} notification
+contains a @code{:textDocument} property to designate the managed
+buffer and an array of LSP regions under the @code{:regions} property.
+Notice how the message (originally in JSON format), is represented as
+Elisp plists (@pxref{JSONRPC objects in Elisp}).
+
+The Eglot generic function machinery will automatically destructure
+the incoming message, so these two properties can simply be added to
+the new method's lambda list as @code{&key} arguments. Also, the
+@code{eglot-uri-to-path} and@code{eglot-range-region} may be used to
+easily parse the LSP @code{:uri} and @code{:start ... :end ...}
+objects to obtain Emacs objects for file names and positions.
+
+The remainder of the implementation consists of standard Elisp
+techniques to loop over arrays, manage buffers and overlays.
+
+@lisp
+(defvar-local eglot-clangd-inactive-region-overlays '())
+
+(cl-defmethod eglot-handle-notification
+ (_server (_method (eql textDocument/inactiveRegions))
+ &key regions textDocument &allow-other-keys)
+ (if-let* ((path (expand-file-name (eglot-uri-to-path
+ (cl-getf textDocument :uri))))
+ (buffer (find-buffer-visiting path)))
+ (with-current-buffer buffer
+ (mapc #'delete-overlay eglot-clangd-inactive-region-overlays)
+ (cl-loop
+ for r across regions
+ for (beg . end) = (eglot-range-region r)
+ for ov = (make-overlay beg end)
+ do
+ (overlay-put ov 'face 'shadow)
+ (push ov eglot-clangd-inactive-region-overlays)))))
+@end lisp
+
+@end itemize
+
+After evaluating these two additions and reconnecting to the
+@command{clangd} language server (version 17), the result will be that
+all the inactive code in the buffer will be nicely grayed out using
+the LSP server knowledge about current compile time preprocessor
+defines.
+
@node Troubleshooting Eglot
@chapter Troubleshooting Eglot
@cindex troubleshooting Eglot
diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index a6b62a058f2..f4a072cf2bc 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -658,11 +658,30 @@ versions, specific architectures, etc.:
@cindex skipping tests
@cindex test preconditions
@cindex preconditions of a test
+@findex skip-when
+@findex skip-unless
Sometimes, it doesn't make sense to run a test due to missing
preconditions. A required Emacs feature might not be compiled in, the
function to be tested could call an external binary which might not be
-available on the test machine, you name it. In this case, the macro
-@code{skip-unless} could be used to skip the test:
+available on the test machine, you name it. In this case, the macros
+@code{skip-when} or @code{skip-unless} could be used to skip the
+test.@footnote{The @code{skip-when} macro was added in Emacs 30.1. If
+you need your tests to be compatible with older versions of Emacs, use
+@code{skip-unless} instead.}
+
+@noindent
+For example, this test is skipped on MS-Windows and macOS:
+
+@lisp
+(ert-deftest test-gnu-linux ()
+ "A test that is not relevant on MS-Windows and macOS."
+ (skip-when (memq system-type '(windows-nt ns))
+ ...))
+@end lisp
+
+@noindent
+This test is skipped if the feature @samp{dbusbind} is not present in
+the running Emacs:
@lisp
(ert-deftest test-dbus ()
diff --git a/etc/NEWS b/etc/NEWS
index 3afb0e3008e..936bb62d750 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -724,6 +724,13 @@ without specifying a file, like this:
*** New user option 'image-dired-thumb-naming'.
You can now configure how a thumbnail is named using this option.
+** ERT
+
+*** New macro `skip-when' to skip 'ert-deftest' tests.
+This can help avoid some awkward skip conditions. For example
+'(skip-unless (not noninteractive))' can be changed to the easier
+to read '(skip-when noninteractive)'.
+
** checkdoc
---
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 4ea894f4ede..d727bc94ec5 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -34,17 +34,18 @@
;; `ert-run-tests-batch-and-exit' for non-interactive use.
;;
;; The body of `ert-deftest' forms resembles a function body, but the
-;; additional operators `should', `should-not', `should-error' and
-;; `skip-unless' are available. `should' is similar to cl's `assert',
-;; but signals a different error when its condition is violated that
-;; is caught and processed by ERT. In addition, it analyzes its
-;; argument form and records information that helps debugging
-;; (`cl-assert' tries to do something similar when its second argument
-;; SHOW-ARGS is true, but `should' is more sophisticated). For
-;; information on `should-not' and `should-error', see their
-;; docstrings. `skip-unless' skips the test immediately without
-;; processing further, this is useful for checking the test
-;; environment (like availability of features, external binaries, etc).
+;; additional operators `should', `should-not', `should-error',
+;; `skip-when' and `skip-unless' are available. `should' is similar
+;; to cl's `assert', but signals a different error when its condition
+;; is violated that is caught and processed by ERT. In addition, it
+;; analyzes its argument form and records information that helps
+;; debugging (`cl-assert' tries to do something similar when its
+;; second argument SHOW-ARGS is true, but `should' is more
+;; sophisticated). For information on `should-not' and
+;; `should-error', see their docstrings. The `skip-when' and
+;; `skip-unless' forms skip the test immediately, which is useful for
+;; checking the test environment (like availability of features,
+;; external binaries, etc).
;;
;; See ERT's Info manual `(ert) Top' as well as the docstrings for
;; more details. To see some examples of tests written in ERT, see
@@ -194,8 +195,8 @@ and the body."
BODY is evaluated as a `progn' when the test is run. It should
signal a condition on failure or just return if the test passes.
-`should', `should-not', `should-error' and `skip-unless' are
-useful for assertions in BODY.
+`should', `should-not', `should-error', `skip-when', and
+`skip-unless' are useful for assertions in BODY.
Use `ert' to run tests interactively.
@@ -227,7 +228,8 @@ in batch mode, an error is signaled.
(tags nil tags-supplied-p))
body)
(ert--parse-keys-and-body docstring-keys-and-body)
- `(cl-macrolet ((skip-unless (form) `(ert--skip-unless ,form)))
+ `(cl-macrolet ((skip-when (form) `(ert--skip-when ,form))
+ (skip-unless (form) `(ert--skip-unless ,form)))
(ert-set-test ',name
(make-ert-test
:name ',name
@@ -464,6 +466,15 @@ failed."
(list
:fail-reason "did not signal an error")))))))))
+(cl-defmacro ert--skip-when (form)
+ "Evaluate FORM. If it returns t, skip the current test.
+Errors during evaluation are caught and handled like t."
+ (declare (debug t))
+ (ert--expand-should `(skip-when ,form) form
+ (lambda (inner-form form-description-form _value-var)
+ `(when (condition-case nil ,inner-form (t t))
+ (ert-skip ,form-description-form)))))
+
(cl-defmacro ert--skip-unless (form)
"Evaluate FORM. If it returns nil, skip the current test.
Errors during evaluation are caught and handled like nil."
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index b5bb7b42650..645e1cc51e5 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -2617,11 +2617,12 @@ flags that control whether to collect or render
objects."
columns))
(defun shr-count (dom elem)
+ ;; This is faster than `seq-count', and shr can use it.
(let ((i 0))
(dolist (sub (dom-children dom))
(when (and (not (stringp sub))
- (eq (dom-tag sub) elem))
- (setq i (1+ i))))
+ (eq (dom-tag sub) elem))
+ (setq i (1+ i))))
i))
(defun shr-max-columns (dom)
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 2bc5351145d..f7c7c29c094 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -132,6 +132,35 @@
(defvar tramp-use-ssh-controlmaster-options)
+;;; Obsolete aliases
+;;;
+(make-obsolete-variable 'eglot--managed-mode-hook
+ 'eglot-managed-mode-hook "1.6")
+(define-obsolete-variable-alias 'eglot-confirm-server-initiated-edits
+ 'eglot-confirm-server-edits "1.16")
+(define-obsolete-function-alias 'eglot--uri-to-path 'eglot-uri-to-path "1.16")
+(define-obsolete-function-alias 'eglot--path-to-uri 'eglot-path-to-uri "1.16")
+(define-obsolete-function-alias 'eglot--range-region 'eglot-range-region
"1.16")
+(define-obsolete-function-alias 'eglot--server-capable 'eglot-server-capable
"1.16")
+(define-obsolete-function-alias 'eglot--server-capable-or-lose
'eglot-server-capable-or-lose "1.16")
+(define-obsolete-function-alias
+ 'eglot-lsp-abiding-column 'eglot-utf-16-linepos "1.12")
+(define-obsolete-function-alias
+ 'eglot-current-column 'eglot-utf-32-linepos "1.12")
+(define-obsolete-variable-alias
+ 'eglot-current-column-function 'eglot-current-linepos-function "1.12")
+(define-obsolete-function-alias
+ 'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "1.12")
+(define-obsolete-function-alias
+ 'eglot-move-to-lsp-abiding-column 'eglot-move-to-utf-16-linepos "1.12")
+(define-obsolete-variable-alias
+'eglot-move-to-column-function 'eglot-move-to-linepos-function "1.12")
+(define-obsolete-variable-alias 'eglot-ignored-server-capabilites
+ 'eglot-ignored-server-capabilities "1.8")
+;;;###autoload
+(define-obsolete-function-alias 'eglot-update 'eglot-upgrade-eglot "29.1")
+
+
;;; User tweakable stuff
(defgroup eglot nil
"Interaction with Language Server Protocol servers."
@@ -391,9 +420,6 @@ done by `eglot-reconnect'."
:type '(choice (const :tag "No limit" nil)
(integer :tag "Number of characters")))
-(define-obsolete-variable-alias 'eglot-confirm-server-initiated-edits
- 'eglot-confirm-server-edits "1.16")
-
(defcustom eglot-confirm-server-edits '((eglot-rename . nil)
(t . maybe-summary))
"Control if changes proposed by LSP should be confirmed with user.
@@ -444,6 +470,36 @@ mode line indicator."
:type 'boolean
:version "1.10")
+(defcustom eglot-ignored-server-capabilities (list)
+ "LSP server capabilities that Eglot could use, but won't.
+You could add, for instance, the symbol
+`:documentHighlightProvider' to prevent automatic highlighting
+under cursor."
+ :type '(set
+ :tag "Tick the ones you're not interested in"
+ (const :tag "Documentation on hover" :hoverProvider)
+ (const :tag "Code completion" :completionProvider)
+ (const :tag "Function signature help" :signatureHelpProvider)
+ (const :tag "Go to definition" :definitionProvider)
+ (const :tag "Go to type definition" :typeDefinitionProvider)
+ (const :tag "Go to implementation" :implementationProvider)
+ (const :tag "Go to declaration" :declarationProvider)
+ (const :tag "Find references" :referencesProvider)
+ (const :tag "Highlight symbols automatically"
:documentHighlightProvider)
+ (const :tag "List symbols in buffer" :documentSymbolProvider)
+ (const :tag "List symbols in workspace" :workspaceSymbolProvider)
+ (const :tag "Execute code actions" :codeActionProvider)
+ (const :tag "Code lens" :codeLensProvider)
+ (const :tag "Format buffer" :documentFormattingProvider)
+ (const :tag "Format portion of buffer"
:documentRangeFormattingProvider)
+ (const :tag "On-type formatting" :documentOnTypeFormattingProvider)
+ (const :tag "Rename symbol" :renameProvider)
+ (const :tag "Highlight links in document" :documentLinkProvider)
+ (const :tag "Decorate color references" :colorProvider)
+ (const :tag "Fold regions of buffer" :foldingRangeProvider)
+ (const :tag "Execute custom commands" :executeCommandProvider)
+ (const :tag "Inlay hints" :inlayHintProvider)))
+
(defvar eglot-withhold-process-id nil
"If non-nil, Eglot will not send the Emacs process id to the language server.
This can be useful when using docker to run a language server.")
@@ -488,6 +544,7 @@ It is nil if Eglot is not byte-complied.")
(2 . eglot-diagnostic-tag-deprecated-face)))
(defvaralias 'eglot-{} 'eglot--{})
+
(defconst eglot--{} (make-hash-table :size 1) "The empty JSON object.")
(defun eglot--executable-find (command &optional remote)
@@ -499,6 +556,12 @@ It is nil if Eglot is not byte-complied.")
(if (and (not eglot-prefer-plaintext) (fboundp 'gfm-view-mode))
["markdown" "plaintext"] ["plaintext"]))
+(defconst eglot--uri-path-allowed-chars
+ (let ((vec (copy-sequence url-path-allowed-chars)))
+ (aset vec ?: nil) ;; see github#639
+ vec)
+ "Like `url-path-allows-chars' but more restrictive.")
+
;;; Message verification helpers
;;;
@@ -692,7 +755,6 @@ Honor `eglot-strict-mode'."
(cl-destructuring-bind (&key ,@vars &allow-other-keys)
,object-once
(funcall ,fn-once ,@vars))))))))
-
(cl-defmacro eglot--lambda (cl-lambda-list &body body)
"Function of args CL-LAMBDA-LIST for processing INTERFACE objects.
Honor `eglot-strict-mode'."
@@ -741,9 +803,6 @@ treated as in `eglot--dbind'."
,obj-once
',(mapcar #'car clauses)))))))
-
-;;; API (WORK-IN-PROGRESS!)
-;;;
(cl-defmacro eglot--when-live-buffer (buf &rest body)
"Check BUF live, then do BODY in it." (declare (indent 1) (debug t))
(let ((b (cl-gensym)))
@@ -761,6 +820,9 @@ treated as in `eglot--dbind'."
"Save excursion and restriction. Widen. Then run BODY." (declare (debug t))
`(save-excursion (save-restriction (widen) ,@body)))
+
+;;; Public Elisp API
+;;;
(cl-defgeneric eglot-handle-request (server method &rest params)
"Handle SERVER's METHOD request with PARAMS.")
@@ -783,7 +845,7 @@ ACTION is an LSP object of either `CodeAction' or `Command'
type."
(((Command)) (eglot--request server :workspace/executeCommand action))
(((CodeAction) edit command data)
(if (and (null edit) (null command) data
- (eglot--server-capable :codeActionProvider :resolveProvider))
+ (eglot-server-capable :codeActionProvider :resolveProvider))
(eglot-execute server (eglot--request server :codeAction/resolve
action))
(when edit (eglot--apply-workspace-edit edit this-command))
(when command (eglot--request server :workspace/executeCommand
command)))))))
@@ -903,7 +965,7 @@ ACTION is an LSP object of either `CodeAction' or `Command'
type."
(let ((project (eglot--project server)))
(vconcat
(mapcar (lambda (dir)
- (list :uri (eglot--path-to-uri dir)
+ (list :uri (eglot-path-to-uri dir)
:name (abbreviate-file-name dir)))
`(,(project-root project) ,@(project-external-roots project))))))
@@ -949,6 +1011,81 @@ ACTION is an LSP object of either `CodeAction' or
`Command' type."
:documentation
"Represents a server. Wraps a process for LSP communication.")
+(declare-function w32-long-file-name "w32proc.c" (fn))
+(defun eglot-uri-to-path (uri)
+ "Convert URI to file path, helped by `eglot--current-server'."
+ (when (keywordp uri) (setq uri (substring (symbol-name uri) 1)))
+ (let* ((server (eglot-current-server))
+ (remote-prefix (and server (eglot--trampish-p server)))
+ (url (url-generic-parse-url uri)))
+ ;; Only parse file:// URIs, leave other URI untouched as
+ ;; `file-name-handler-alist' should know how to handle them
+ ;; (bug#58790).
+ (if (string= "file" (url-type url))
+ (let* ((retval (url-unhex-string (url-filename url)))
+ ;; Remove the leading "/" for local MS Windows-style paths.
+ (normalized (if (and (not remote-prefix)
+ (eq system-type 'windows-nt)
+ (cl-plusp (length retval)))
+ (w32-long-file-name (substring retval 1))
+ retval)))
+ (concat remote-prefix normalized))
+ uri)))
+
+(defun eglot-path-to-uri (path)
+ "Convert PATH, a file name, to LSP URI string and return it."
+ (let ((truepath (file-truename path)))
+ (if (and (url-type (url-generic-parse-url path))
+ ;; It might be MS Windows path which includes a drive
+ ;; letter that looks like a URL scheme (bug#59338)
+ (not (and (eq system-type 'windows-nt)
+ (file-name-absolute-p truepath))))
+ ;; Path is already a URI, so forward it to the LSP server
+ ;; untouched. The server should be able to handle it, since
+ ;; it provided this URI to clients in the first place.
+ path
+ (concat "file://"
+ ;; Add a leading "/" for local MS Windows-style paths.
+ (if (and (eq system-type 'windows-nt)
+ (not (file-remote-p truepath)))
+ "/")
+ (url-hexify-string
+ ;; Again watch out for trampy paths.
+ (directory-file-name (file-local-name truepath))
+ eglot--uri-path-allowed-chars)))))
+
+(defun eglot-range-region (range &optional markers)
+ "Return a cons (BEG . END) of positions representing LSP RANGE.
+If optional MARKERS, make markers instead."
+ (let* ((st (plist-get range :start))
+ (beg (eglot--lsp-position-to-point st markers))
+ (end (eglot--lsp-position-to-point (plist-get range :end) markers)))
+ (cons beg end)))
+
+(defun eglot-server-capable (&rest feats)
+ "Determine if current server is capable of FEATS."
+ (unless (cl-some (lambda (feat)
+ (memq feat eglot-ignored-server-capabilities))
+ feats)
+ (cl-loop for caps = (eglot--capabilities (eglot--current-server-or-lose))
+ then (cadr probe)
+ for (feat . more) on feats
+ for probe = (plist-member caps feat)
+ if (not probe) do (cl-return nil)
+ if (eq (cadr probe) :json-false) do (cl-return nil)
+ if (not (listp (cadr probe))) do (cl-return (if more nil (cadr
probe)))
+ finally (cl-return (or (cadr probe) t)))))
+
+(defun eglot-server-capable-or-lose (&rest feats)
+ "Like `eglot-server-capable', but maybe error out."
+ (let ((retval (apply #'eglot-server-capable feats)))
+ (unless retval
+ (eglot--error "Unsupported or ignored LSP capability `%s'"
+ (mapconcat #'symbol-name feats " ")))
+ retval))
+
+
+;;; Process/server management
(defun eglot--major-modes (s) "Major modes server S is responsible for."
(mapcar #'car (eglot--languages s)))
@@ -958,8 +1095,6 @@ ACTION is an LSP object of either `CodeAction' or
`Command' type."
(cl-defmethod initialize-instance :before ((_server eglot-lsp-server)
&optional args)
(cl-remf args :initializationOptions))
-
-;;; Process management
(defvar eglot--servers-by-project (make-hash-table :test #'equal)
"Keys are projects. Values are lists of processes.")
@@ -1401,7 +1536,7 @@ This docstring appeases checkdoc, that's all."
;; into `/path/to/baz.py', so LSP groks it.
:rootPath (file-local-name
(expand-file-name default-directory))
- :rootUri (eglot--path-to-uri default-directory)
+ :rootUri (eglot-path-to-uri default-directory)
:initializationOptions
(eglot-initialization-options
server)
:capabilities (eglot-client-capabilities server)
@@ -1556,13 +1691,6 @@ Unless IMMEDIATE, send pending changes before making
request."
;;; Encoding fever
;;;
-(define-obsolete-function-alias
- 'eglot-lsp-abiding-column 'eglot-utf-16-linepos "1.12")
-(define-obsolete-function-alias
- 'eglot-current-column 'eglot-utf-32-linepos "1.12")
-(define-obsolete-variable-alias
- 'eglot-current-column-function 'eglot-current-linepos-function "1.12")
-
(defvar eglot-current-linepos-function #'eglot-utf-16-linepos
"Function calculating position relative to line beginning.
@@ -1601,13 +1729,6 @@ LBP defaults to `eglot--bol'."
:character (progn (when pos (goto-char pos))
(funcall eglot-current-linepos-function)))))
-(define-obsolete-function-alias
- 'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "1.12")
-(define-obsolete-function-alias
- 'eglot-move-to-lsp-abiding-column 'eglot-move-to-utf-16-linepos "1.12")
-(define-obsolete-variable-alias
-'eglot-move-to-column-function 'eglot-move-to-linepos-function "1.12")
-
(defvar eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos
"Function to move to a position within a line reported by the LSP server.
@@ -1674,55 +1795,6 @@ If optional MARKER, return a marker instead"
;;; More helpers
-(defconst eglot--uri-path-allowed-chars
- (let ((vec (copy-sequence url-path-allowed-chars)))
- (aset vec ?: nil) ;; see github#639
- vec)
- "Like `url-path-allows-chars' but more restrictive.")
-
-(defun eglot--path-to-uri (path)
- "URIfy PATH."
- (let ((truepath (file-truename path)))
- (if (and (url-type (url-generic-parse-url path))
- ;; It might be MS Windows path which includes a drive
- ;; letter that looks like a URL scheme (bug#59338)
- (not (and (eq system-type 'windows-nt)
- (file-name-absolute-p truepath))))
- ;; Path is already a URI, so forward it to the LSP server
- ;; untouched. The server should be able to handle it, since
- ;; it provided this URI to clients in the first place.
- path
- (concat "file://"
- ;; Add a leading "/" for local MS Windows-style paths.
- (if (and (eq system-type 'windows-nt)
- (not (file-remote-p truepath)))
- "/")
- (url-hexify-string
- ;; Again watch out for trampy paths.
- (directory-file-name (file-local-name truepath))
- eglot--uri-path-allowed-chars)))))
-
-(declare-function w32-long-file-name "w32proc.c" (fn))
-(defun eglot--uri-to-path (uri)
- "Convert URI to file path, helped by `eglot--current-server'."
- (when (keywordp uri) (setq uri (substring (symbol-name uri) 1)))
- (let* ((server (eglot-current-server))
- (remote-prefix (and server (eglot--trampish-p server)))
- (url (url-generic-parse-url uri)))
- ;; Only parse file:// URIs, leave other URI untouched as
- ;; `file-name-handler-alist' should know how to handle them
- ;; (bug#58790).
- (if (string= "file" (url-type url))
- (let* ((retval (url-unhex-string (url-filename url)))
- ;; Remove the leading "/" for local MS Windows-style paths.
- (normalized (if (and (not remote-prefix)
- (eq system-type 'windows-nt)
- (cl-plusp (length retval)))
- (w32-long-file-name (substring retval 1))
- retval)))
- (concat remote-prefix normalized))
- uri)))
-
(defun eglot--snippet-expansion-fn ()
"Compute a function to expand snippets.
Doubles as an indicator of snippet support."
@@ -1757,69 +1829,6 @@ Doubles as an indicator of snippet support."
(prop-match-end match)))))
(string-trim (buffer-string))))))
-(define-obsolete-variable-alias 'eglot-ignored-server-capabilites
- 'eglot-ignored-server-capabilities "1.8")
-
-(defcustom eglot-ignored-server-capabilities (list)
- "LSP server capabilities that Eglot could use, but won't.
-You could add, for instance, the symbol
-`:documentHighlightProvider' to prevent automatic highlighting
-under cursor."
- :type '(set
- :tag "Tick the ones you're not interested in"
- (const :tag "Documentation on hover" :hoverProvider)
- (const :tag "Code completion" :completionProvider)
- (const :tag "Function signature help" :signatureHelpProvider)
- (const :tag "Go to definition" :definitionProvider)
- (const :tag "Go to type definition" :typeDefinitionProvider)
- (const :tag "Go to implementation" :implementationProvider)
- (const :tag "Go to declaration" :declarationProvider)
- (const :tag "Find references" :referencesProvider)
- (const :tag "Highlight symbols automatically"
:documentHighlightProvider)
- (const :tag "List symbols in buffer" :documentSymbolProvider)
- (const :tag "List symbols in workspace" :workspaceSymbolProvider)
- (const :tag "Execute code actions" :codeActionProvider)
- (const :tag "Code lens" :codeLensProvider)
- (const :tag "Format buffer" :documentFormattingProvider)
- (const :tag "Format portion of buffer"
:documentRangeFormattingProvider)
- (const :tag "On-type formatting" :documentOnTypeFormattingProvider)
- (const :tag "Rename symbol" :renameProvider)
- (const :tag "Highlight links in document" :documentLinkProvider)
- (const :tag "Decorate color references" :colorProvider)
- (const :tag "Fold regions of buffer" :foldingRangeProvider)
- (const :tag "Execute custom commands" :executeCommandProvider)
- (const :tag "Inlay hints" :inlayHintProvider)))
-
-(defun eglot--server-capable (&rest feats)
- "Determine if current server is capable of FEATS."
- (unless (cl-some (lambda (feat)
- (memq feat eglot-ignored-server-capabilities))
- feats)
- (cl-loop for caps = (eglot--capabilities (eglot--current-server-or-lose))
- then (cadr probe)
- for (feat . more) on feats
- for probe = (plist-member caps feat)
- if (not probe) do (cl-return nil)
- if (eq (cadr probe) :json-false) do (cl-return nil)
- if (not (listp (cadr probe))) do (cl-return (if more nil (cadr
probe)))
- finally (cl-return (or (cadr probe) t)))))
-
-(defun eglot--server-capable-or-lose (&rest feats)
- "Like `eglot--server-capable', but maybe error out."
- (let ((retval (apply #'eglot--server-capable feats)))
- (unless retval
- (eglot--error "Unsupported or ignored LSP capability `%s'"
- (mapconcat #'symbol-name feats " ")))
- retval))
-
-(defun eglot--range-region (range &optional markers)
- "Return region (BEG . END) that represents LSP RANGE.
-If optional MARKERS, make markers."
- (let* ((st (plist-get range :start))
- (beg (eglot--lsp-position-to-point st markers))
- (end (eglot--lsp-position-to-point (plist-get range :end) markers)))
- (cons beg end)))
-
(defun eglot--read-server (prompt &optional dont-if-just-the-one)
"Read a running Eglot server from minibuffer using PROMPT.
If DONT-IF-JUST-THE-ONE and there's only one server, don't prompt
@@ -2078,9 +2087,6 @@ If it is activated, also signal textDocument/didOpen."
(package-delete existing t))
(package-install (cadr (assoc 'eglot package-archive-contents)))))
-;;;###autoload
-(define-obsolete-function-alias 'eglot-update 'eglot-upgrade-eglot "29.1")
-
(easy-menu-define eglot-menu nil "Eglot"
`("Eglot"
;; Commands for getting information and customization.
@@ -2089,47 +2095,47 @@ If it is activated, also signal textDocument/didOpen."
;; xref like commands.
["Find definitions" xref-find-definitions
:help "Find definitions of identifier at point"
- :active (eglot--server-capable :definitionProvider)]
+ :active (eglot-server-capable :definitionProvider)]
["Find references" xref-find-references
:help "Find references to identifier at point"
- :active (eglot--server-capable :referencesProvider)]
+ :active (eglot-server-capable :referencesProvider)]
["Find symbols in workspace (apropos)" xref-find-apropos
:help "Find symbols matching a query"
- :active (eglot--server-capable :workspaceSymbolProvider)]
+ :active (eglot-server-capable :workspaceSymbolProvider)]
["Find declaration" eglot-find-declaration
:help "Find declaration for identifier at point"
- :active (eglot--server-capable :declarationProvider)]
+ :active (eglot-server-capable :declarationProvider)]
["Find implementation" eglot-find-implementation
:help "Find implementation for identifier at point"
- :active (eglot--server-capable :implementationProvider)]
+ :active (eglot-server-capable :implementationProvider)]
["Find type definition" eglot-find-typeDefinition
:help "Find type definition for identifier at point"
- :active (eglot--server-capable :typeDefinitionProvider)]
+ :active (eglot-server-capable :typeDefinitionProvider)]
"--"
;; LSP-related commands (mostly Eglot's own commands).
["Rename symbol" eglot-rename
- :active (eglot--server-capable :renameProvider)]
+ :active (eglot-server-capable :renameProvider)]
["Format buffer" eglot-format-buffer
- :active (eglot--server-capable :documentFormattingProvider)]
+ :active (eglot-server-capable :documentFormattingProvider)]
["Format active region" eglot-format
:active (and (region-active-p)
- (eglot--server-capable :documentRangeFormattingProvider))]
+ (eglot-server-capable :documentRangeFormattingProvider))]
["Show Flymake diagnostics for buffer" flymake-show-buffer-diagnostics]
["Show Flymake diagnostics for project" flymake-show-project-diagnostics]
["Show Eldoc documentation at point" eldoc-doc-buffer]
"--"
["All possible code actions" eglot-code-actions
- :active (eglot--server-capable :codeActionProvider)]
+ :active (eglot-server-capable :codeActionProvider)]
["Organize imports" eglot-code-action-organize-imports
- :visible (eglot--server-capable :codeActionProvider)]
+ :visible (eglot-server-capable :codeActionProvider)]
["Extract" eglot-code-action-extract
- :visible (eglot--server-capable :codeActionProvider)]
+ :visible (eglot-server-capable :codeActionProvider)]
["Inline" eglot-code-action-inline
- :visible (eglot--server-capable :codeActionProvider)]
+ :visible (eglot-server-capable :codeActionProvider)]
["Rewrite" eglot-code-action-rewrite
- :visible (eglot--server-capable :codeActionProvider)]
+ :visible (eglot-server-capable :codeActionProvider)]
["Quickfix" eglot-code-action-quickfix
- :visible (eglot--server-capable :codeActionProvider)]))
+ :visible (eglot-server-capable :codeActionProvider)]))
(easy-menu-define eglot-server-menu nil "Monitor server communication"
'("Debugging the server communication"
@@ -2323,7 +2329,7 @@ still unanswered LSP requests to the server\n")))
(t 'eglot-note)))
(mess (source code message)
(concat source (and code (format " [%s]" code)) ": " message)))
- (if-let* ((path (expand-file-name (eglot--uri-to-path uri)))
+ (if-let* ((path (expand-file-name (eglot-uri-to-path uri)))
(buffer (find-buffer-visiting path)))
(with-current-buffer buffer
(cl-loop
@@ -2335,7 +2341,7 @@ still unanswered LSP requests to the server\n")))
diag-spec
(setq message (mess source code message))
(pcase-let
- ((`(,beg . ,end) (eglot--range-region range)))
+ ((`(,beg . ,end) (eglot-range-region range)))
;; Fallback to `flymake-diag-region' if server
;; botched the range
(when (= beg end)
@@ -2427,7 +2433,7 @@ THINGS are either registrations or unregisterations
(sic)."
(filename))
(cond
((eq external t) (browse-url uri))
- ((file-readable-p (setq filename (eglot--uri-to-path uri)))
+ ((file-readable-p (setq filename (eglot-uri-to-path uri)))
;; Use run-with-timer to avoid nested client requests like the
;; "synchronous imenu" floated in bug#62116 presumably caused by
;; which-func-mode.
@@ -2440,7 +2446,7 @@ THINGS are either registrations or unregisterations
(sic)."
(select-frame-set-input-focus (selected-frame)))
((display-buffer (current-buffer))))
(when selection
- (pcase-let ((`(,beg . ,end) (eglot--range-region selection)))
+ (pcase-let ((`(,beg . ,end) (eglot-range-region selection)))
;; FIXME: it is very naughty to use someone else's `--'
;; function, but `xref--goto-char' happens to have
;; exactly the semantics we want vis-a-vis widening.
@@ -2451,7 +2457,7 @@ THINGS are either registrations or unregisterations
(sic)."
(defun eglot--TextDocumentIdentifier ()
"Compute TextDocumentIdentifier object for current buffer."
- `(:uri ,(eglot--path-to-uri (or buffer-file-name
+ `(:uri ,(eglot-path-to-uri (or buffer-file-name
(ignore-errors
(buffer-file-name
(buffer-base-buffer)))))))
@@ -2492,7 +2498,7 @@ buffer."
(defun eglot--post-self-insert-hook ()
"Set `eglot--last-inserted-char', maybe call on-type-formatting."
(setq eglot--last-inserted-char last-command-event)
- (let ((ot-provider (eglot--server-capable
:documentOnTypeFormattingProvider)))
+ (let ((ot-provider (eglot-server-capable :documentOnTypeFormattingProvider)))
(when (and ot-provider
(ignore-errors ; github#906, some LS's send empty strings
(or (eq eglot--last-inserted-char
@@ -2516,7 +2522,7 @@ buffer."
`(:context
,(if-let (trigger (and (characterp eglot--last-inserted-char)
(cl-find eglot--last-inserted-char
- (eglot--server-capable :completionProvider
+ (eglot-server-capable :completionProvider
:triggerCharacters)
:key (lambda (str) (aref str 0))
:test #'char-equal)))
@@ -2677,7 +2683,7 @@ When called interactively, use the currently active
server"
(mapcar
(eglot--lambda ((ConfigurationItem) scopeUri section)
(cl-loop
- with scope-uri-path = (and scopeUri (eglot--uri-to-path scopeUri))
+ with scope-uri-path = (and scopeUri (eglot-uri-to-path scopeUri))
for (wsection o)
on (eglot--workspace-configuration-plist server scope-uri-path)
by #'cddr
@@ -2693,7 +2699,7 @@ When called interactively, use the currently active
server"
"Send textDocument/didChange to server."
(when eglot--recent-changes
(let* ((server (eglot--current-server-or-lose))
- (sync-capability (eglot--server-capable :textDocumentSync))
+ (sync-capability (eglot-server-capable :textDocumentSync))
(sync-kind (if (numberp sync-capability) sync-capability
(plist-get sync-capability :change)))
(full-sync-p (or (eq sync-kind 1)
@@ -2738,9 +2744,9 @@ When called interactively, use the currently active
server"
"Maybe send textDocument/willSave to server."
(let ((server (eglot--current-server-or-lose))
(params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier))))
- (when (eglot--server-capable :textDocumentSync :willSave)
+ (when (eglot-server-capable :textDocumentSync :willSave)
(jsonrpc-notify server :textDocument/willSave params))
- (when (eglot--server-capable :textDocumentSync :willSaveWaitUntil)
+ (when (eglot-server-capable :textDocumentSync :willSaveWaitUntil)
(ignore-errors
(eglot--apply-text-edits
(eglot--request server :textDocument/willSaveWaitUntil params
@@ -2749,7 +2755,7 @@ When called interactively, use the currently active
server"
(defun eglot--signal-textDocument/didSave ()
"Maybe send textDocument/didSave to server."
(eglot--signal-textDocument/didChange)
- (when (eglot--server-capable :textDocumentSync :save)
+ (when (eglot-server-capable :textDocumentSync :save)
(jsonrpc-notify
(eglot--current-server-or-lose)
:textDocument/didSave
@@ -2808,12 +2814,12 @@ may be called multiple times (respecting the protocol of
"Like `xref-make-match' but with LSP's NAME, URI and RANGE.
Try to visit the target file for a richer summary line."
(pcase-let*
- ((file (eglot--uri-to-path uri))
+ ((file (eglot-uri-to-path uri))
(visiting (or (find-buffer-visiting file)
(gethash uri eglot--temp-location-buffers)))
(collect (lambda ()
(eglot--widening
- (pcase-let* ((`(,beg . ,end) (eglot--range-region range))
+ (pcase-let* ((`(,beg . ,end) (eglot-range-region range))
(bol (progn (goto-char beg) (eglot--bol)))
(substring (buffer-substring bol
(line-end-position)))
(hi-beg (- beg bol))
@@ -2844,7 +2850,7 @@ Try to visit the target file for a richer summary line."
"Ask for :workspace/symbol on PAT, return list of formatted strings.
If BUFFER, switch to it before."
(with-current-buffer (or buffer (current-buffer))
- (eglot--server-capable-or-lose :workspaceSymbolProvider)
+ (eglot-server-capable-or-lose :workspaceSymbolProvider)
(mapcar
(lambda (wss)
(eglot--dbind ((WorkspaceSymbol) name containerName kind) wss
@@ -2906,7 +2912,7 @@ If BUFFER, switch to it before."
(cl-defun eglot--lsp-xrefs-for-method (method &key extra-params capability)
"Make `xref''s for METHOD, EXTRA-PARAMS, check CAPABILITY."
- (eglot--server-capable-or-lose
+ (eglot-server-capable-or-lose
(or capability
(intern
(format ":%sProvider"
@@ -2970,7 +2976,7 @@ If BUFFER, switch to it before."
:textDocument/references :extra-params `(:context (:includeDeclaration
t)))))
(cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern)
- (when (eglot--server-capable :workspaceSymbolProvider)
+ (when (eglot-server-capable :workspaceSymbolProvider)
(eglot--collecting-xrefs (collect)
(mapc
(eglot--lambda ((SymbolInformation) name location)
@@ -3008,7 +3014,7 @@ for which LSP on-type-formatting should be requested."
:end (eglot--pos-to-lsp-position end)))))
(t
'(:textDocument/formatting :documentFormattingProvider
nil)))))
- (eglot--server-capable-or-lose cap)
+ (eglot-server-capable-or-lose cap)
(eglot--apply-text-edits
(eglot--request
(eglot--current-server-or-lose)
@@ -3033,7 +3039,7 @@ for which LSP on-type-formatting should be requested."
(defun eglot-completion-at-point ()
"Eglot's `completion-at-point' function."
;; Commit logs for this function help understand what's going on.
- (when-let (completion-capability (eglot--server-capable :completionProvider))
+ (when-let (completion-capability (eglot-server-capable :completionProvider))
(let* ((server (eglot--current-server-or-lose))
(sort-completions
(lambda (completions)
@@ -3096,7 +3102,7 @@ for which LSP on-type-formatting should be requested."
(lambda (lsp-comp)
(or (gethash lsp-comp resolved)
(setf (gethash lsp-comp resolved)
- (if (and (eglot--server-capable :completionProvider
+ (if (and (eglot-server-capable :completionProvider
:resolveProvider)
(plist-get lsp-comp :data))
(eglot--request server :completionItem/resolve
@@ -3224,7 +3230,7 @@ for which LSP on-type-formatting should be requested."
(delete-region orig-pos (point))
(eglot--dbind ((TextEdit) range newText) textEdit
(pcase-let ((`(,beg . ,end)
- (eglot--range-region range)))
+ (eglot-range-region range)))
(delete-region beg end)
(goto-char beg)
(funcall (or snippet-fn #'insert) newText))))
@@ -3307,7 +3313,7 @@ for which LSP on-type-formatting should be requested."
(defun eglot-signature-eldoc-function (cb)
"A member of `eldoc-documentation-functions', for signatures."
- (when (eglot--server-capable :signatureHelpProvider)
+ (when (eglot-server-capable :signatureHelpProvider)
(let ((buf (current-buffer)))
(jsonrpc-async-request
(eglot--current-server-or-lose)
@@ -3331,7 +3337,7 @@ for which LSP on-type-formatting should be requested."
(defun eglot-hover-eldoc-function (cb)
"A member of `eldoc-documentation-functions', for hover."
- (when (eglot--server-capable :hoverProvider)
+ (when (eglot-server-capable :hoverProvider)
(let ((buf (current-buffer)))
(jsonrpc-async-request
(eglot--current-server-or-lose)
@@ -3353,7 +3359,7 @@ for which LSP on-type-formatting should be requested."
;; FIXME: Obviously, this is just piggy backing on eldoc's calls for
;; convenience, as shown by the fact that we just ignore cb.
(let ((buf (current-buffer)))
- (when (eglot--server-capable :documentHighlightProvider)
+ (when (eglot-server-capable :documentHighlightProvider)
(jsonrpc-async-request
(eglot--current-server-or-lose)
:textDocument/documentHighlight (eglot--TextDocumentPositionParams)
@@ -3365,7 +3371,7 @@ for which LSP on-type-formatting should be requested."
(mapcar
(eglot--lambda ((DocumentHighlight) range)
(pcase-let ((`(,beg . ,end)
- (eglot--range-region range)))
+ (eglot-range-region range)))
(let ((ov (make-overlay beg end)))
(overlay-put ov 'face 'eglot-highlight-symbol-face)
(overlay-put ov 'modification-hooks
@@ -3385,7 +3391,7 @@ for which LSP on-type-formatting should be requested."
(pcase-lambda (`(,container . ,objs))
(let ((elems (mapcar
(eglot--lambda ((SymbolInformation) kind name location)
- (let ((reg (eglot--range-region
+ (let ((reg (eglot-range-region
(plist-get location :range)))
(kind (alist-get kind
eglot--symbol-kind-names)))
(cons (propertize name
@@ -3401,7 +3407,7 @@ for which LSP on-type-formatting should be requested."
(defun eglot--imenu-DocumentSymbol (res)
"Compute `imenu--index-alist' for RES vector of DocumentSymbol."
(cl-labels ((dfs (&key name children range kind &allow-other-keys)
- (let* ((reg (eglot--range-region range))
+ (let* ((reg (eglot-range-region range))
(kind (alist-get kind eglot--symbol-kind-names))
(name (propertize name
'breadcrumb-region reg
@@ -3415,7 +3421,7 @@ for which LSP on-type-formatting should be requested."
(cl-defun eglot-imenu ()
"Eglot's `imenu-create-index-function'.
Returns a list as described in docstring of `imenu--index-alist'."
- (unless (eglot--server-capable :documentSymbolProvider)
+ (unless (eglot-server-capable :documentSymbolProvider)
(cl-return-from eglot-imenu))
(let* ((res (eglot--request (eglot--current-server-or-lose)
:textDocument/documentSymbol
@@ -3457,7 +3463,7 @@ If SILENT, don't echo progress in mode-line."
(when reporter
(eglot--reporter-update reporter (cl-incf done))))))))
(mapcar (eglot--lambda ((TextEdit) range newText)
- (cons newText (eglot--range-region range 'markers)))
+ (cons newText (eglot-range-region range 'markers)))
(reverse edits)))
(undo-amalgamate-change-group change-group)
(when reporter
@@ -3521,14 +3527,14 @@ edit proposed by the server."
(mapcar (eglot--lambda ((TextDocumentEdit) textDocument edits)
(eglot--dbind ((VersionedTextDocumentIdentifier) uri
version)
textDocument
- (list (eglot--uri-to-path uri) edits version)))
+ (list (eglot-uri-to-path uri) edits version)))
documentChanges)))
(unless (and changes documentChanges)
;; We don't want double edits, and some servers send both
;; changes and documentChanges. This unless ensures that we
;; prefer documentChanges over changes.
(cl-loop for (uri edits) on changes by #'cddr
- do (push (list (eglot--uri-to-path uri) edits) prepared)))
+ do (push (list (eglot-uri-to-path uri) edits) prepared)))
(cl-flet ((notevery-visited-p ()
(cl-notevery #'find-buffer-visiting
(mapcar #'car prepared)))
@@ -3566,7 +3572,7 @@ edit proposed by the server."
"unknown symbol"))
nil nil nil nil
(symbol-name (symbol-at-point)))))
- (eglot--server-capable-or-lose :renameProvider)
+ (eglot-server-capable-or-lose :renameProvider)
(eglot--apply-workspace-edit
(eglot--request (eglot--current-server-or-lose)
:textDocument/rename `(,@(eglot--TextDocumentPositionParams)
@@ -3593,7 +3599,7 @@ at point. With prefix argument, prompt for ACTION-KIND."
'("quickfix" "refactor.extract" "refactor.inline"
"refactor.rewrite" "source.organizeImports")))
t))
- (eglot--server-capable-or-lose :codeActionProvider)
+ (eglot-server-capable-or-lose :codeActionProvider)
(let* ((server (eglot--current-server-or-lose))
(actions
(eglot--request
@@ -3693,7 +3699,7 @@ at point. With prefix argument, prompt for ACTION-KIND."
(funcall glob file))))
(jsonrpc-notify
server :workspace/didChangeWatchedFiles
- `(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
+ `(:changes ,(vector `(:uri ,(eglot-path-to-uri file)
:type ,action-type))))
(when (and (eq action 'created)
(file-directory-p file))
@@ -3960,7 +3966,7 @@ If NOERROR, return predicate, else erroring function."
"Minor mode for annotating buffers with LSP server's inlay hints."
:global nil
(cond (eglot-inlay-hints-mode
- (if (eglot--server-capable :inlayHintProvider)
+ (if (eglot-server-capable :inlayHintProvider)
(jit-lock-register #'eglot--update-hints 'contextual)
(eglot-inlay-hints-mode -1)))
(t
@@ -3987,11 +3993,7 @@ If NOERROR, return predicate, else erroring function."
"https://github.com/joaotavora/eglot/issues/%s";
"https://debbugs.gnu.org/%s";)
(match-string 3))))
-;;; Obsolete
-;;;
-(make-obsolete-variable 'eglot--managed-mode-hook
- 'eglot-managed-mode-hook "1.6")
(provide 'eglot)
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 3c00046a26a..54c758c6a8a 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -8750,11 +8750,12 @@ This expects NAME TYPE IDLWAVE-TWIN-CLASS to be bound
to the right values."
(defun idlwave-count-eq (elt list)
"How often is ELT in LIST?"
- (length (delq nil (mapcar (lambda (x) (eq x elt)) list))))
+ (declare (obsolete nil "30.1"))
+ (seq-count (lambda (x) (eq x elt)) list))
(defun idlwave-count-memq (elt alist)
"How often is ELT a key in ALIST?"
- (length (delq nil (mapcar (lambda (x) (eq (car x) elt)) alist))))
+ (seq-count (lambda (x) (eq (car x) elt)) alist))
(defun idlwave-syslib-p (file)
"Non-nil if FILE is in the system library."
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 8dbb5d2a496..e01ce82858b 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -257,7 +257,7 @@ This expects `auto-revert--messages' to be bound by
;; Repeated unpredictable failures, bug#32645.
:tags '(:unstable)
;; Unlikely to be hydra-specific?
- ;; (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ ;; (skip-when (getenv "EMACS_HYDRA_CI"))
(with-auto-revert-test
(ert-with-temp-file tmpfile
(let (;; Try to catch bug#32645.
diff --git a/test/lisp/emacs-lisp/benchmark-tests.el
b/test/lisp/emacs-lisp/benchmark-tests.el
index 99b5b142c37..7fe3be2157f 100644
--- a/test/lisp/emacs-lisp/benchmark-tests.el
+++ b/test/lisp/emacs-lisp/benchmark-tests.el
@@ -25,8 +25,8 @@
(ert-deftest benchmark-tests ()
;; Avoid fork failures on Cygwin. See bug#62450 and etc/PROBLEMS
;; ("Fork failures in a build with native compilation").
- (skip-unless (not (and (eq system-type 'cygwin)
- (featurep 'native-compile))))
+ (skip-when (and (eq system-type 'cygwin)
+ (featurep 'native-compile)))
(let (str t-long t-short m)
(should (consp (benchmark-run nil (setq m (1+ 0)))))
(should (consp (benchmark-run 1 (setq m (1+ 0)))))
diff --git a/test/lisp/emacs-lisp/ert-tests.el
b/test/lisp/emacs-lisp/ert-tests.el
index 7713a0f6e38..bb3de111e3e 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -304,6 +304,20 @@ failed or if there was a problem."
(cl-macrolet ((test () (error "Foo")))
(should-error (test))))
+(ert-deftest ert-test-skip-when ()
+ ;; Don't skip.
+ (let ((test (make-ert-test :body (lambda () (skip-when nil)))))
+ (let ((result (ert-run-test test)))
+ (should (ert-test-passed-p result))))
+ ;; Skip.
+ (let ((test (make-ert-test :body (lambda () (skip-when t)))))
+ (let ((result (ert-run-test test)))
+ (should (ert-test-skipped-p result))))
+ ;; Skip in case of error.
+ (let ((test (make-ert-test :body (lambda () (skip-when (error "Foo"))))))
+ (let ((result (ert-run-test test)))
+ (should (ert-test-skipped-p result)))))
+
(ert-deftest ert-test-skip-unless ()
;; Don't skip.
(let ((test (make-ert-test :body (lambda () (skip-unless t)))))
diff --git a/test/lisp/emacs-lisp/find-func-tests.el
b/test/lisp/emacs-lisp/find-func-tests.el
index 7251b76157b..59ecb5ab187 100644
--- a/test/lisp/emacs-lisp/find-func-tests.el
+++ b/test/lisp/emacs-lisp/find-func-tests.el
@@ -32,7 +32,7 @@
(ert-deftest find-func-tests--library-completion () ;bug#43393
;; FIXME: How can we make this work in batch (see also
;; `mule-cmds--test-universal-coding-system-argument')?
- ;; (skip-unless (not noninteractive))
+ ;; (skip-when noninteractive)
;; Check that `partial-completion' works when completing library names.
(should (equal "org/org"
(ert-simulate-keys
diff --git a/test/lisp/eshell/esh-proc-tests.el
b/test/lisp/eshell/esh-proc-tests.el
index fa20efa71e1..712d3519dce 100644
--- a/test/lisp/eshell/esh-proc-tests.el
+++ b/test/lisp/eshell/esh-proc-tests.el
@@ -281,7 +281,7 @@ prompt. See bug#54136."
(executable-find "sleep")))
;; This test doesn't work on EMBA with AOT nativecomp, but works
;; fine elsewhere.
- (skip-unless (not (getenv "EMACS_EMBA_CI")))
+ (skip-when (getenv "EMACS_EMBA_CI"))
(with-temp-eshell
(eshell-insert-command
(concat "sh -c 'while true; do echo y; sleep 1; done' | "
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 0873910ddf9..57099add08b 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -1583,7 +1583,7 @@ the file watch."
:tags '(:expensive-test)
(skip-unless (file-notify--test-local-enabled))
;; This test does not work for kqueue (yet).
- (skip-unless (not (string-equal (file-notify--test-library) "kqueue")))
+ (skip-when (string-equal (file-notify--test-library) "kqueue"))
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
file-notify--test-tmpfile1 (file-notify--test-make-temp-name))
diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el
index 83bfa1f68af..ec0ba85da39 100644
--- a/test/lisp/ibuffer-tests.el
+++ b/test/lisp/ibuffer-tests.el
@@ -34,7 +34,7 @@
(ert-deftest ibuffer-0autoload () ; sort first
"Tests to see whether ibuffer has been autoloaded"
- (skip-unless (not (featurep 'ibuf-ext)))
+ (skip-when (featurep 'ibuf-ext))
(should
(fboundp 'ibuffer-mark-unsaved-buffers))
(should
diff --git a/test/lisp/international/ucs-normalize-tests.el
b/test/lisp/international/ucs-normalize-tests.el
index 97b8fa66cd3..bc7e743291d 100644
--- a/test/lisp/international/ucs-normalize-tests.el
+++ b/test/lisp/international/ucs-normalize-tests.el
@@ -255,8 +255,8 @@ Must be called with `ucs-normalize-tests--norm-buf' as
current buffer."
(ert-deftest ucs-normalize-part1 ()
:tags '(:expensive-test)
- (skip-unless (not (or (getenv "EMACS_HYDRA_CI")
- (getenv "EMACS_EMBA_CI")))) ; SLOW ~ 1800s
+ (skip-when (or (getenv "EMACS_HYDRA_CI")
+ (getenv "EMACS_EMBA_CI"))) ; SLOW ~ 1800s
;; This takes a long time, so make sure we're compiled.
(dolist (fun '(ucs-normalize-tests--part1-rule2
ucs-normalize-tests--rule1-failing-for-partX
diff --git a/test/lisp/net/network-stream-tests.el
b/test/lisp/net/network-stream-tests.el
index 0fd9549c305..8b1ae398930 100644
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -236,7 +236,7 @@
(while (and (eq (process-status proc) 'connect)
(< (setq times (1+ times)) 10))
(sit-for 0.1))
- (skip-unless (not (eq (process-status proc) 'connect)))
+ (skip-when (eq (process-status proc) 'connect))
(with-current-buffer (process-buffer proc)
(process-send-string proc "echo foo")
(sleep-for 0.1)
@@ -323,7 +323,7 @@
(while (and (eq (process-status proc) 'connect)
(< (setq times (1+ times)) 10))
(sit-for 0.1))
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -336,7 +336,7 @@
(ert-deftest connect-to-tls-ipv6-nowait ()
(skip-unless (executable-find "gnutls-serv"))
(skip-unless (gnutls-available-p))
- (skip-unless (not (eq system-type 'windows-nt)))
+ (skip-when (eq system-type 'windows-nt))
(skip-unless (featurep 'make-network-process '(:family ipv6)))
(let ((server (make-tls-server 44333))
(times 0)
@@ -368,7 +368,7 @@
(while (and (eq (process-status proc) 'connect)
(< (setq times (1+ times)) 10))
(sit-for 0.1))
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -403,7 +403,7 @@
(< (setq times (1+ times)) 10))
(sit-for 0.1))
(should proc)
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -446,7 +446,7 @@
(while (and (eq (process-status proc) 'connect)
(< (setq times (1+ times)) 10))
(sit-for 0.1))
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -484,7 +484,7 @@
(< (setq times (1+ times)) 10))
(sit-for 0.1))
(should proc)
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -523,7 +523,7 @@
(< (setq times (1+ times)) 10))
(sit-for 0.1))
(should proc)
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -673,7 +673,7 @@
(while (and (eq (process-status proc) 'connect)
(< (setq times (1+ times)) 10))
(sit-for 0.1))
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
@@ -712,7 +712,7 @@
(while (and (eq (process-status proc) 'connect)
(< (setq times (1+ times)) 10))
(sit-for 0.1))
- (skip-unless (not (eq (process-status proc) 'connect))))
+ (skip-when (eq (process-status proc) 'connect)))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index 8f334245c64..87d8ffa2d8d 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -892,8 +892,8 @@ without a statement terminator on the same line does not
loop
forever. The test starts an asynchronous Emacs batch process
under timeout control."
:tags '(:expensive-test)
- (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out
- (skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen
+ (skip-when (getenv "EMACS_HYDRA_CI")) ; FIXME times out
+ (skip-when (< emacs-major-version 28)) ; times out in older Emacsen
(skip-unless (eq cperl-test-mode #'cperl-mode))
(let* ((emacs (concat invocation-directory invocation-name))
(test-function 'cperl-test--run-bug-10483)
@@ -1242,7 +1242,7 @@ however, must not happen when the keyword occurs in a
variable
\"$else\" or \"$continue\"."
(skip-unless (eq cperl-test-mode #'cperl-mode))
;; `self-insert-command' takes a second argument only since Emacs 27
- (skip-unless (not (< emacs-major-version 27)))
+ (skip-when (< emacs-major-version 27))
(with-temp-buffer
(setq cperl-electric-keywords t)
(cperl-mode)
diff --git a/test/lisp/progmodes/elisp-mode-tests.el
b/test/lisp/progmodes/elisp-mode-tests.el
index 5b6ef88dceb..4fa869c773f 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -128,7 +128,7 @@
(ert-deftest eval-last-sexp-print-format-sym-echo ()
;; We can only check the echo area when running interactive.
- (skip-unless (not noninteractive))
+ (skip-when noninteractive)
(with-temp-buffer
(let ((current-prefix-arg nil))
(erase-buffer) (insert "t") (message nil)
@@ -147,7 +147,7 @@
(should (equal (buffer-string) "?A65 (#o101, #x41, ?A)")))))
(ert-deftest eval-last-sexp-print-format-small-int-echo ()
- (skip-unless (not noninteractive))
+ (skip-when noninteractive)
(with-temp-buffer
(let ((current-prefix-arg nil))
(erase-buffer) (insert "?A") (message nil)
@@ -171,7 +171,7 @@
(should (equal (buffer-string) "?B66 (#o102, #x42, ?B)"))))))
(ert-deftest eval-last-sexp-print-format-large-int-echo ()
- (skip-unless (not noninteractive))
+ (skip-when noninteractive)
(with-temp-buffer
(let ((eval-expression-print-maximum-character ?A))
(let ((current-prefix-arg nil))
@@ -186,7 +186,7 @@
;;; eval-defun
(ert-deftest eval-defun-prints-edebug-when-instrumented ()
- (skip-unless (not noninteractive))
+ (skip-when noninteractive)
(with-temp-buffer
(let ((current-prefix-arg '(4)))
(erase-buffer) (insert "(defun foo ())") (message nil)
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index 9f935f2748c..a44a11896f0 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -4918,7 +4918,7 @@ import abc
;; Skip the test on macOS, since the standard Python installation uses
;; libedit rather than readline which confuses the running of an inferior
;; interpreter in this case (see bug#59477 and bug#25753).
- (skip-unless (not (eq system-type 'darwin)))
+ (skip-when (eq system-type 'darwin))
(trace-function 'python-shell-output-filter)
(python-tests-with-temp-buffer-with-shell
"
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index 5edba039032..b1c06ad2d05 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -101,7 +101,7 @@ Per definition, all files are identical on the different
hosts of
a cluster (or site). This is not tested here; it must be
guaranteed by the originator of a cluster definition."
:tags '(:expensive-test)
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(skip-unless (file-remote-p ert-remote-temporary-file-directory))
(let ((text-quoting-style 'grave) ;; We inspect the *Messages* buffer!
@@ -219,7 +219,7 @@ guaranteed by the originator of a cluster definition."
Per definition, all files are identical on the different hosts of
a cluster (or site). This is not tested here; it must be
guaranteed by the originator of a cluster definition."
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(skip-unless (file-remote-p ert-remote-temporary-file-directory))
(let ((shadow-info-file shadow-test-info-file)
@@ -320,7 +320,7 @@ guaranteed by the originator of a cluster definition."
(ert-deftest shadow-test02-files ()
"Check file manipulation functions."
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(skip-unless (file-remote-p ert-remote-temporary-file-directory))
(let ((shadow-info-file shadow-test-info-file)
@@ -391,7 +391,7 @@ guaranteed by the originator of a cluster definition."
(ert-deftest shadow-test03-expand-cluster-in-file-name ()
"Check canonical file name of a cluster or site."
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(skip-unless (file-remote-p ert-remote-temporary-file-directory))
(let ((shadow-info-file shadow-test-info-file)
@@ -456,7 +456,7 @@ guaranteed by the originator of a cluster definition."
(ert-deftest shadow-test04-contract-file-name ()
"Check canonical file name of a cluster or site."
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(skip-unless (file-remote-p ert-remote-temporary-file-directory))
(let ((shadow-info-file shadow-test-info-file)
@@ -511,7 +511,7 @@ guaranteed by the originator of a cluster definition."
(ert-deftest shadow-test05-file-match ()
"Check `shadow-same-site' and `shadow-file-match'."
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(skip-unless (file-remote-p ert-remote-temporary-file-directory))
(let ((shadow-info-file shadow-test-info-file)
@@ -563,7 +563,7 @@ guaranteed by the originator of a cluster definition."
(ert-deftest shadow-test06-literal-groups ()
"Check literal group definitions."
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(skip-unless (file-remote-p ert-remote-temporary-file-directory))
(let ((shadow-info-file shadow-test-info-file)
@@ -648,7 +648,7 @@ guaranteed by the originator of a cluster definition."
(ert-deftest shadow-test07-regexp-groups ()
"Check regexp group definitions."
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(skip-unless (file-remote-p ert-remote-temporary-file-directory))
(let ((shadow-info-file shadow-test-info-file)
@@ -710,7 +710,7 @@ guaranteed by the originator of a cluster definition."
(ert-deftest shadow-test08-shadow-todo ()
"Check that needed shadows are added to todo."
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(skip-unless (file-remote-p ert-remote-temporary-file-directory))
(skip-unless (file-writable-p ert-remote-temporary-file-directory))
@@ -855,7 +855,7 @@ guaranteed by the originator of a cluster definition."
(ert-deftest shadow-test09-shadow-copy-files ()
"Check that needed shadow files are copied."
:tags '(:expensive-test)
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(skip-unless (file-remote-p ert-remote-temporary-file-directory))
(skip-unless (file-writable-p ert-remote-temporary-file-directory))
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 7dabb735522..b632c908443 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -742,7 +742,7 @@ See Bug#21722."
(ert-deftest eval-expression-print-format-sym-echo ()
;; We can only check the echo area when running interactive.
- (skip-unless (not noninteractive))
+ (skip-when noninteractive)
(with-temp-buffer
(cl-letf (((symbol-function 'read--expression) (lambda (&rest _) t)))
(let ((current-prefix-arg nil))
@@ -763,7 +763,7 @@ See Bug#21722."
(should (equal (buffer-string) "65 (#o101, #x41, ?A)"))))))
(ert-deftest eval-expression-print-format-small-int-echo ()
- (skip-unless (not noninteractive))
+ (skip-when noninteractive)
(with-temp-buffer
(cl-letf (((symbol-function 'read--expression) (lambda (&rest _) ?A)))
(let ((current-prefix-arg nil))
@@ -789,7 +789,7 @@ See Bug#21722."
(should (equal (buffer-string) "66 (#o102, #x42, ?B)"))))))
(ert-deftest eval-expression-print-format-large-int-echo ()
- (skip-unless (not noninteractive))
+ (skip-when noninteractive)
(with-temp-buffer
(cl-letf (((symbol-function 'read--expression) (lambda (&rest _) ?B))
(eval-expression-print-maximum-character ?A))
diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el
index ee2bb6574ae..911d03d5628 100644
--- a/test/lisp/term-tests.el
+++ b/test/lisp/term-tests.el
@@ -110,7 +110,7 @@
(buffer-substring (point-min) (point-max))))))
(ert-deftest term-simple-lines ()
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(let ((str "\
first line\r
next line\r\n"))
@@ -118,14 +118,14 @@ next line\r\n"))
(string-replace "\r" "" str)))))
(ert-deftest term-carriage-return ()
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(let ((str "\
first line\r_next line\r\n"))
(should (equal (term-test-screen-from-input 40 12 str)
"_next line\n"))))
(ert-deftest term-line-wrap ()
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(should (string-match-p
;; Don't be strict about trailing whitespace.
"\\`a\\{40\\}\na\\{20\\} *\\'"
@@ -137,7 +137,7 @@ first line\r_next line\r\n"))
(list str str))))))
(ert-deftest term-colors ()
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(pcase-dolist (`(,str ,expected) ansi-test-strings)
(let ((result (term-test-screen-from-input 40 12 str)))
(should (equal result expected))
@@ -145,7 +145,7 @@ first line\r_next line\r\n"))
(text-properties-at 0 expected))))))
(ert-deftest term-colors-bold-is-bright ()
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(let ((ansi-color-bold-is-bright t))
(pcase-dolist (`(,str ,expected ,bright-expected) ansi-test-strings)
(let ((expected (or bright-expected expected))
@@ -155,7 +155,7 @@ first line\r_next line\r\n"))
(text-properties-at 0 expected)))))))
(ert-deftest term-cursor-movement ()
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
;; Absolute positioning.
(should (equal "ab\ncd"
(term-test-screen-from-input
@@ -186,7 +186,7 @@ first line\r_next line\r\n"))
"\e[D\e[Da")))))
(ert-deftest term-scrolling-region ()
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(should (equal "\
line3
line4
@@ -338,7 +338,7 @@ line6\r
line7")))))
(ert-deftest term-set-directory ()
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(let ((term-ansi-at-user (user-real-login-name)))
(should (equal (term-test-screen-from-input
40 12 "\eAnSiTc /foo/\n" 'default-directory)
@@ -354,7 +354,7 @@ A real-life example is the default zsh prompt which writes
spaces
to the end of line (triggering line-wrapping state), and then
sends a carriage return followed by another space to overwrite
the first character of the line."
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(let* ((width 10)
(strs (list "x" (make-string (1- width) ?_)
"\r_")))
@@ -364,7 +364,7 @@ the first character of the line."
(ert-deftest term-to-margin ()
"Test cursor movement at the scroll margin.
This is a reduced example from GNU nano's initial screen."
- (skip-unless (not (memq system-type '(windows-nt ms-dos))))
+ (skip-when (memq system-type '(windows-nt ms-dos)))
(let* ((width 10)
(x (make-string width ?x))
(y (make-string width ?y)))
diff --git a/test/lisp/thread-tests.el b/test/lisp/thread-tests.el
index 4ba7b99719c..5d684a96a18 100644
--- a/test/lisp/thread-tests.el
+++ b/test/lisp/thread-tests.el
@@ -88,7 +88,7 @@
(ert-deftest thread-tests-list-threads-error-when-not-configured ()
"Signal an error running `list-threads' if threads are not configured."
- (skip-unless (not (featurep 'threads)))
+ (skip-when (featurep 'threads))
(should-error (list-threads)))
(provide 'thread-tests)
diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index 0a26e25e32a..f40cee8cc5b 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -781,7 +781,7 @@ This checks also `vc-backend' and `vc-responsible-backend'."
;; CVS calls vc-delete-file, which insists on prompting
;; "Really want to delete ...?", and `vc-mtn.el' does not implement
;; `delete-file' at all.
- (skip-unless (not (memq ',backend '(CVS Mtn))))
+ (skip-when (memq ',backend '(CVS Mtn)))
(vc-test--rename-file ',backend))
(ert-deftest
@@ -796,7 +796,7 @@ This checks also `vc-backend' and `vc-responsible-backend'."
(format "vc-test-%s01-register" backend-string))))))
;; `vc-mtn.el' gives me:
;; "Failed (status 1): mtn commit -m Testing vc-version-diff\n\n foo"
- (skip-unless (not (memq ',backend '(Mtn))))
+ (skip-when (memq ',backend '(Mtn)))
(vc-test--version-diff ',backend))
))))
diff --git a/test/manual/scroll-tests.el b/test/manual/scroll-tests.el
index c2a4ef17bff..b2cfeabfe64 100644
--- a/test/manual/scroll-tests.el
+++ b/test/manual/scroll-tests.el
@@ -80,25 +80,25 @@
,@body)))
(ert-deftest scroll-tests-scroll-margin-0 ()
- (skip-unless (not noninteractive))
+ (skip-when noninteractive)
(scroll-tests-with-buffer-window
(scroll-tests-up-and-down 0)))
(ert-deftest scroll-tests-scroll-margin-negative ()
"A negative `scroll-margin' should be the same as 0."
- (skip-unless (not noninteractive))
+ (skip-when noninteractive)
(scroll-tests-with-buffer-window
(scroll-tests-up-and-down -10 0)))
(ert-deftest scroll-tests-scroll-margin-max ()
- (skip-unless (not noninteractive))
+ (skip-when noninteractive)
(scroll-tests-with-buffer-window
(let ((max-margin (/ (window-text-height) 4)))
(scroll-tests-up-and-down max-margin))))
(ert-deftest scroll-tests-scroll-margin-over-max ()
"A `scroll-margin' more than max should be the same as max."
- (skip-unless (not noninteractive))
+ (skip-when noninteractive)
(scroll-tests-with-buffer-window 7
(let ((max-margin (/ (window-text-height) 4)))
(scroll-tests-up-and-down (+ max-margin 1) max-margin)
@@ -155,7 +155,7 @@ middle of the window."
(should (scroll-tests--point-in-middle-of-window-p)))))
(ert-deftest scroll-tests-scroll-margin-whole-window ()
- (skip-unless (not noninteractive))
+ (skip-when noninteractive)
(scroll-tests--scroll-margin-whole-window))
(ert-deftest scroll-tests-scroll-margin-whole-window-line-spacing ()
diff --git a/test/misc/test-custom-libs.el b/test/misc/test-custom-libs.el
index eb565de8eee..d255a87eeaf 100644
--- a/test/misc/test-custom-libs.el
+++ b/test/misc/test-custom-libs.el
@@ -39,7 +39,7 @@
:tags '(:expensive-test)
:expected-result :failed ; FIXME: See above.
;; This test is very slow, and IMO not worth the time it takes.
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (skip-when (getenv "EMACS_HYDRA_CI"))
(skip-unless (file-readable-p custom-test-admin-cus-test))
(load custom-test-admin-cus-test)
(cus-test-libs t)
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index ac88011b543..59af5d9a4a8 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -457,7 +457,7 @@ See Bug#36226."
(ert-deftest module/async-pipe ()
"Check that writing data from another thread works."
- (skip-unless (not (eq system-type 'windows-nt))) ; FIXME!
+ (skip-when (eq system-type 'windows-nt)) ; FIXME!
(with-temp-buffer
(let ((process (make-pipe-process :name "module/async-pipe"
:buffer (current-buffer)
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index 50642420ce9..62a9be546f9 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -50,7 +50,7 @@ Also check that an encoding error can appear in a symlink."
;; Some Windows versions don't support symlinks, and those which do
;; will pop up UAC elevation prompts, so we disable this test on
;; MS-Windows.
- (skip-unless (not (eq system-type 'windows-nt)))
+ (skip-when (eq system-type 'windows-nt))
(should (equal nil (fileio-tests--symlink-failure))))
(ert-deftest fileio-tests--directory-file-name ()
diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el
index c5e77f70bb2..f4376b2a5b0 100644
--- a/test/src/filelock-tests.el
+++ b/test/src/filelock-tests.el
@@ -109,7 +109,7 @@ the case)."
(ert-deftest filelock-tests-lock-spoiled ()
"Check `lock-buffer'."
- (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
+ (skip-when (eq system-type 'ms-dos)) ; no filelock support
(filelock-tests--fixture
(filelock-tests--spoil-lock-file buffer-file-truename)
;; FIXME: errors when locking a file are ignored; should they be?
@@ -119,7 +119,7 @@ the case)."
(ert-deftest filelock-tests-file-locked-p-spoiled ()
"Check that `file-locked-p' fails if the lockfile is \"spoiled\"."
- (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
+ (skip-when (eq system-type 'ms-dos)) ; no filelock support
(filelock-tests--fixture
(filelock-tests--spoil-lock-file buffer-file-truename)
(let ((err (should-error (file-locked-p (buffer-file-name)))))
@@ -130,7 +130,7 @@ the case)."
(ert-deftest filelock-tests-unlock-spoiled ()
"Check that `unlock-buffer' fails if the lockfile is \"spoiled\"."
- (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
+ (skip-when (eq system-type 'ms-dos)) ; no filelock support
(filelock-tests--fixture
;; Set the buffer modified with file locking temporarily disabled.
(let ((create-lockfiles nil))
@@ -150,7 +150,7 @@ the case)."
(ert-deftest filelock-tests-kill-buffer-spoiled ()
"Check that `kill-buffer' fails if a lockfile is \"spoiled\"."
- (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
+ (skip-when (eq system-type 'ms-dos)) ; no filelock support
(filelock-tests--fixture
;; Set the buffer modified with file locking temporarily disabled.
(let ((create-lockfiles nil))
@@ -176,7 +176,7 @@ the case)."
(ert-deftest filelock-tests-detect-external-change ()
"Check that an external file modification is reported."
- (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
+ (skip-when (eq system-type 'ms-dos)) ; no filelock support
(skip-unless (executable-find "touch"))
(skip-unless (executable-find "echo"))
(dolist (cl '(t nil))
diff --git a/test/src/image-tests.el b/test/src/image-tests.el
index 317f4d3aab6..3eec2bb4c60 100644
--- a/test/src/image-tests.el
+++ b/test/src/image-tests.el
@@ -44,15 +44,15 @@
(xpm . ,(find-image '((:file "splash.xpm" :type xpm))))))
(ert-deftest image-tests-image-size/error-on-nongraphical-display ()
- (skip-unless (not (display-images-p)))
+ (skip-when (display-images-p))
(should-error (image-size 'invalid-spec)))
(ert-deftest image-tests-image-mask-p/error-on-nongraphical-display ()
- (skip-unless (not (display-images-p)))
+ (skip-when (display-images-p))
(should-error (image-mask-p (cdr (assq 'xpm image-tests--images)))))
(ert-deftest image-tests-image-metadata/error-on-nongraphical-display ()
- (skip-unless (not (display-images-p)))
+ (skip-when (display-images-p))
(should-error (image-metadata (cdr (assq 'xpm image-tests--images)))))
(ert-deftest image-tests-imagemagick-types ()
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index e17e1c0d833..711a27f1cfb 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -231,7 +231,7 @@ process to complete."
(with-timeout (60 (ert-fail "Test timed out"))
;; Frequent random (?) failures on hydra.nixos.org, with no process output.
;; Maybe this test should be tagged unstable? See bug#31214.
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (skip-when (getenv "EMACS_HYDRA_CI"))
(with-temp-buffer
(let ((process (make-process
:name "mix-stderr"
@@ -723,7 +723,7 @@ FD_SETSIZE file descriptors (Bug#24325)."
(skip-unless (featurep 'make-network-process '(:server t)))
(skip-unless (featurep 'make-network-process '(:family local)))
;; Avoid hang due to connect/accept handshake on Cygwin (bug#49496).
- (skip-unless (not (eq system-type 'cygwin)))
+ (skip-when (eq system-type 'cygwin))
(with-timeout (60 (ert-fail "Test timed out"))
(ert-with-temp-directory directory
(process-tests--with-processes processes
@@ -763,7 +763,7 @@ FD_SETSIZE file descriptors (Bug#24325)."
"Check that Emacs doesn't crash when trying to use more than
FD_SETSIZE file descriptors (Bug#24325)."
;; This test cannot be run if PTYs aren't supported.
- (skip-unless (not (eq system-type 'windows-nt)))
+ (skip-when (eq system-type 'windows-nt))
(with-timeout (60 (ert-fail "Test timed out"))
(process-tests--with-processes processes
;; In order to use `make-serial-process', we need to create some