(defun auth-source-pass--match-regexp (s)
(rx-to-string ; autoloaded
`(: (or bot "/")
- (or (: (? (group-n 20 (+ (not (in ?\ ?/ ,s)))) "@")
- (group-n 10 (+ (not (in ?\ ?/ ?@ ,s))))
- (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s))))))
- (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s))))
- (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s)))))
- (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s)))))))
+ (or (: (? (group-n 20 (+ (not (in ?/ ,s)))) "@") ; user prefix
+ (group-n 10 (+ (not (in ?/ ?@ ,s)))) ; host
+ (? ,s (group-n 30 (+ (not (in ?\s ?/ ,s)))))) ; port
+ (: (group-n 11 (+ (not (in ?/ ?@ ,s)))) ; host
+ (? ,s (group-n 31 (+ (not (in ?\s ?/ ,s))))) ; port
+ (? "/" (group-n 21 (+ (not (in ?/ ,s))))))) ; user suffix
eot)
'no-group))
;; This hard codes `auth-source-pass-port-separator' to ":"
(defun erc-compat--29-auth-source-pass--retrieve-parsed (seen e port-number-p)
(when (string-match (rx (or bot "/")
- (or (: (? (group-n 20 (+ (not (in " /:")))) "@")
- (group-n 10 (+ (not (in " /:@"))))
+ (or (: (? (group-n 20 (+ (not (in "/:")))) "@")
+ (group-n 10 (+ (not (in "/:@"))))
(? ":" (group-n 30 (+ (not (in " /:"))))))
- (: (group-n 11 (+ (not (in " /:@"))))
+ (: (group-n 11 (+ (not (in "/:@"))))
(? ":" (group-n 31 (+ (not (in " /:")))))
- (? "/" (group-n 21 (+ (not (in " /:")))))))
+ (? "/" (group-n 21 (+ (not (in "/:")))))))
eot)
e)
(puthash e `( :host ,(or (match-string 10 e) (match-string 11 e))
icomplete-scroll (not (null icomplete-vertical-mode))
completion-styles '(flex)
completion-flex-nospace nil
- completion-category-defaults nil
completion-ignore-case t
read-buffer-completion-ignore-case t
read-file-name-completion-ignore-case t)))
(modify-syntax-entry ?\240 "." table)
(modify-syntax-entry ?/ ". 124b" table)
(modify-syntax-entry ?* ". 23" table)
+ (modify-syntax-entry ?\n "> b" table)
+ (modify-syntax-entry ?\^m "> b" table)
table)
"Syntax table for `c-ts-mode'.")
(false) @font-lock-constant-face
(null) @font-lock-constant-face
,@(when (eq mode 'cpp)
- '((this) @font-lock-constant-face)))
+ '((this) @font-lock-constant-face
+ (nullptr) @font-lock-constant-face)))
:language mode
:feature 'keyword
(if (looking-at "\\s<\\|\n")
(forward-line 1)))))
+(defun c-ts-mode-indent-defun ()
+ "Indent the current top-level declaration syntactically.
+
+`treesit-defun-type-regexp' defines what constructs to indent."
+ (interactive "*")
+ (let ((orig-point (point-marker)))
+ ;; If `treesit-beginning-of-defun' returns nil, we are not in a
+ ;; defun, so don't indent anything.
+ (when (treesit-beginning-of-defun)
+ (let ((start (point)))
+ (treesit-end-of-defun)
+ (indent-region start (point))))
+ (goto-char orig-point)))
+
+(defvar-keymap c-ts-mode-map
+ :doc "Keymap for the C language with tree-sitter"
+ :parent prog-mode-map
+ "C-c C-q" #'c-ts-mode-indent-defun)
+
;;;###autoload
(define-derived-mode c-ts-base-mode prog-mode "C"
- "Major mode for editing C, powered by tree-sitter."
+ "Major mode for editing C, powered by tree-sitter.
+
+\\{c-ts-mode-map}"
:syntax-table c-ts-mode--syntax-table
;; Navigation.
;;;###autoload
(define-derived-mode csharp-ts-mode prog-mode "C#"
"Major mode for editing C# code."
+ :syntax-table (csharp--make-mode-syntax-table)
(unless (treesit-ready-p 'c-sharp)
(error "Tree-sitter for C# isn't available"))
;; Maintainer: João Távora <joaotavora@gmail.com>
;; URL: https://github.com/joaotavora/eglot
;; Keywords: convenience, languages
-;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.14") (flymake "1.2.1") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23"))
+;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.14") (flymake "1.2.1") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23") (external-completion "0.1"))
;; This is a GNU ELPA :core package. Avoid adding functionality
;; that is not available in the version of Emacs recorded above or any
(require 'filenotify)
(require 'ert)
(require 'array)
+(require 'external-completion)
;; ElDoc is preloaded in Emacs, so `require'-ing won't guarantee we are
;; using the latest version from GNU Elpa when we load eglot.el. Use an
(t 'eglot-note)))
(mess (source code message)
(concat source (and code (format " [%s]" code)) ": " message)))
- (if-let ((buffer (find-buffer-visiting (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
+ initially (assoc-delete-all path flymake-list-only-diagnostics #'string=)
for diag-spec across diagnostics
collect (eglot--dbind ((Diagnostic) range code message severity source tags)
diag-spec
(t
(setq eglot--diagnostics diags)))))
(cl-loop
- with path = (expand-file-name (eglot--uri-to-path uri))
for diag-spec across diagnostics
collect (eglot--dbind ((Diagnostic) code range message severity source) diag-spec
(setq message (mess source code message))
(let ((probe (gethash pat cache :missing)))
(if (eq probe :missing) (puthash pat (refresh pat) cache)
probe)))
- (lookup (pat)
+ (lookup (pat _point)
(let ((res (lookup-1 pat))
(def (and (string= pat "") (gethash :default cache))))
(append def res nil)))
(cl-getf (get-text-property
0 'eglot--lsp-workspaceSymbol c)
:score 0)))
- (lambda (string _pred action)
- (pcase action
- (`metadata `(metadata
- (cycle-sort-function
- . ,(lambda (completions)
- (cl-sort completions #'> :key #'score)))
- (category . eglot-indirection-joy)))
- (`(eglot--lsp-tryc . ,point) `(eglot--lsp-tryc . (,string . ,point)))
- (`(eglot--lsp-allc . ,_point) `(eglot--lsp-allc . ,(lookup string)))
- (_ nil))))))
+ (external-completion-table
+ 'eglot-indirection-joy
+ #'lookup
+ `((cycle-sort-function
+ . ,(lambda (completions)
+ (cl-sort completions #'> :key #'score))))))))
(defun eglot--recover-workspace-symbol-meta (string)
"Search `eglot--workspace-symbols-cache' for rich entry of STRING."
(setq v (cdr v))))
eglot--workspace-symbols-cache)))
-(add-to-list 'completion-category-overrides
- '(eglot-indirection-joy (styles . (eglot--lsp-backend-style))))
-
(cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot)))
(let ((attempt
(and (xref--prompt-p this-command)
'eglot-managed-mode-hook "1.6")
(provide 'eglot)
-\f
-;;; Backend completion
-
-;; Written by Stefan Monnier circa 2016. Something to move to
-;; minibuffer.el "ASAP" (with all the `eglot--lsp-' replaced by
-;; something else. The very same code already in SLY and stable for a
-;; long time.
-
-;; This "completion style" delegates all the work to the "programmable
-;; completion" table which is then free to implement its own
-;; completion style. Typically this is used to take advantage of some
-;; external tool which already has its own completion system and
-;; doesn't give you efficient access to the prefix completion needed
-;; by other completion styles. The table should recognize the symbols
-;; 'eglot--lsp-tryc and 'eglot--lsp-allc as ACTION, reply with
-;; (eglot--lsp-tryc COMP...) or (eglot--lsp-allc . (STRING . POINT)),
-;; accordingly. tryc/allc names made akward/recognizable on purpose.
-
-(add-to-list 'completion-styles-alist
- '(eglot--lsp-backend-style
- eglot--lsp-backend-style-try-completion
- eglot--lsp-backend-style-all-completions
- "Ad-hoc completion style provided by the completion table."))
-
-(defun eglot--lsp-backend-style-call (op string table pred point)
- (when (functionp table)
- (let ((res (funcall table string pred (cons op point))))
- (when (eq op (car-safe res))
- (cdr res)))))
-
-(defun eglot--lsp-backend-style-try-completion (string table pred point)
- (eglot--lsp-backend-style-call 'eglot--lsp-tryc string table pred point))
-
-(defun eglot--lsp-backend-style-all-completions (string table pred point)
- (eglot--lsp-backend-style-call 'eglot--lsp-allc string table pred point))
-
;; Local Variables:
;; bug-reference-bug-regexp: "\\(github#\\([0-9]+\\)\\)"
(modify-syntax-entry ?| "." table)
(modify-syntax-entry ?\' "\"" table)
(modify-syntax-entry ?\240 "." table)
+ (modify-syntax-entry ?/ ". 124b" table)
+ (modify-syntax-entry ?* ". 23" table)
+ (modify-syntax-entry ?\n "> b" table)
+ (modify-syntax-entry ?\^m "> b" table)
+ (modify-syntax-entry ?@ "'" table)
table)
"Syntax table for `java-ts-mode'.")
(defvar json-ts-mode--syntax-table
(let ((table (make-syntax-table)))
- ;; Taken from the cc-langs version
(modify-syntax-entry ?_ "_" table)
- (modify-syntax-entry ?$ "_" table)
(modify-syntax-entry ?\\ "\\" table)
(modify-syntax-entry ?+ "." table)
(modify-syntax-entry ?- "." table)
(modify-syntax-entry ?> "." table)
(modify-syntax-entry ?& "." table)
(modify-syntax-entry ?| "." table)
- (modify-syntax-entry ?` "\"" table)
+ (modify-syntax-entry ?\' "\"" table)
(modify-syntax-entry ?\240 "." table)
+ (modify-syntax-entry ?/ ". 124b" table)
+ (modify-syntax-entry ?* ". 23" table)
+ (modify-syntax-entry ?\n "> b" table)
+ (modify-syntax-entry ?\^m "> b" table)
table)
"Syntax table for `json-ts-mode'.")
(let ((table (make-syntax-table)))
;; Taken from the cc-langs version
(modify-syntax-entry ?_ "_" table)
- (modify-syntax-entry ?$ "_" table)
(modify-syntax-entry ?\\ "\\" table)
(modify-syntax-entry ?+ "." table)
(modify-syntax-entry ?- "." table)
(modify-syntax-entry ?> "." table)
(modify-syntax-entry ?& "." table)
(modify-syntax-entry ?| "." table)
- (modify-syntax-entry ?` "\"" table)
+ (modify-syntax-entry ?\' "\"" table)
(modify-syntax-entry ?\240 "." table)
+ (modify-syntax-entry ?/ ". 124b" table)
+ (modify-syntax-entry ?* ". 23" table)
+ (modify-syntax-entry ?\n "> b" table)
+ (modify-syntax-entry ?\^m "> b" table)
+ (modify-syntax-entry ?$ "_" table)
+ (modify-syntax-entry ?` "\"" table)
table)
"Syntax table for `typescript-ts-mode'.")
can also be used to fill comments.
\\{css-mode-map}"
+ :syntax-table css-mode-syntax-table
(when (treesit-ready-p 'css)
;; Borrowed from `css-mode'.
(add-hook 'completion-at-point-functions
(nreverse result))
(list node)))
-(defun treesit--children-covering-range-recurse (node start end threshold)
+(defun treesit--children-covering-range-recurse
+ (node start end threshold &optional limit)
"Return a list of children of NODE covering a range.
+
Recursively go down the parse tree and collect children, until
all nodes in the returned list are smaller than THRESHOLD. The
-range is between START and END."
+range is between START and END.
+
+LIMIT is the recursion limit, which defaults to 100."
(let* ((child (treesit-node-first-child-for-pos node start))
+ (limit (or limit 100))
result)
- (while (and child (<= (treesit-node-start child) end))
+ ;; If LIMIT is exceeded, we are probably seeing the erroneously
+ ;; tall tree, in that case, just give up.
+ (while (and (> limit 0) child (<= (treesit-node-start child) end))
;; If child still too large, recurse down. Otherwise collect
;; child.
(if (> (- (treesit-node-end child)
(treesit-node-start child))
threshold)
(dolist (r (treesit--children-covering-range-recurse
- child start end threshold))
+ child start end threshold (1- limit)))
(push r result))
(push child result))
(setq child (treesit-node-next-sibling child)))
;; top-level nodes and query them. This ensures that querying is fast
;; everywhere else, except for the problematic region.
;;
+;; Some other time the source file has a top-level node that contains
+;; a huge number of children (say, 10k children), querying that node
+;; is also very slow, so instead of getting the top-level node, we
+;; recursively go down the tree to find nodes that cover the region
+;; but are reasonably small.
+;;
;; 3. It is possible to capture a node that's completely outside the
;; region between START and END: as long as the whole pattern
;; intersects the region, all the captured nodes in that pattern are
;; If we run into problematic files, use the "fast mode" to
;; try to recover. See comment #2 above for more explanation.
(when treesit--font-lock-fast-mode
- (setq nodes (treesit--children-covering-range
- (car nodes) start end)))
+ (setq nodes (treesit--children-covering-range-recurse
+ (car nodes) start end (* 4 jit-lock-chunk-size))))
;; Query each node.
(dolist (sub-node nodes)
xsignal1 (Qtreesit_node_outdated, obj);
}
+/* Checks that OBJ is a positive integer and it is within the visible
+ portion of BUF. */
+static void
+treesit_check_position (Lisp_Object obj, struct buffer *buf)
+{
+ treesit_check_positive_integer (obj);
+ ptrdiff_t pos = XFIXNUM (obj);
+ if (pos < BUF_BEGV (buf) || pos > BUF_ZV (buf))
+ xsignal1 (Qargs_out_of_range, obj);
+}
+
bool
treesit_node_uptodate_p (Lisp_Object obj)
{
if (NILP (node))
return Qnil;
treesit_check_node (node);
- treesit_check_positive_integer (pos);
struct buffer *buf = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer);
ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg;
ptrdiff_t byte_pos = buf_charpos_to_bytepos (buf, XFIXNUM (pos));
- if (byte_pos < BUF_BEGV_BYTE (buf) || byte_pos > BUF_ZV_BYTE (buf))
- xsignal1 (Qargs_out_of_range, pos);
+ treesit_check_position (pos, buf);
treesit_initialize ();
{
if (NILP (node)) return Qnil;
treesit_check_node (node);
- CHECK_INTEGER (beg);
- CHECK_INTEGER (end);
struct buffer *buf = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer);
ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg;
ptrdiff_t byte_beg = buf_charpos_to_bytepos (buf, XFIXNUM (beg));
ptrdiff_t byte_end = buf_charpos_to_bytepos (buf, XFIXNUM (end));
- /* Checks for BUFFER_BEG <= BEG <= END <= BUFFER_END. */
- if (!(BUF_BEGV_BYTE (buf) <= byte_beg
- && byte_beg <= byte_end
- && byte_end <= BUF_ZV_BYTE (buf)))
- xsignal2 (Qargs_out_of_range, beg, end);
+ treesit_check_position (beg, buf);
+ treesit_check_position (end, buf);
treesit_initialize ();
(Lisp_Object node, Lisp_Object query,
Lisp_Object beg, Lisp_Object end, Lisp_Object node_only)
{
- if (!NILP (beg))
- CHECK_INTEGER (beg);
- if (!NILP (end))
- CHECK_INTEGER (end);
-
if (!(TS_COMPILED_QUERY_P (query)
|| CONSP (query) || STRINGP (query)))
wrong_type_argument (Qtreesit_query_p, query);
+ treesit_initialize ();
+
/* Resolve NODE into an actual node. */
Lisp_Object lisp_node;
if (TS_NODEP (node))
- lisp_node = node;
+ {
+ treesit_check_node (node); /* Check if up-to-date. */
+ lisp_node = node;
+ }
else if (TS_PARSERP (node))
- lisp_node = Ftreesit_parser_root_node (node);
+ {
+ treesit_check_parser (node); /* Check if deleted. */
+ lisp_node = Ftreesit_parser_root_node (node);
+ }
else if (SYMBOLP (node))
{
Lisp_Object parser
list4 (Qor, Qtreesit_node_p, Qtreesit_parser_p, Qsymbolp),
node);
- treesit_initialize ();
-
/* Extract C values from Lisp objects. */
TSNode treesit_node
= XTS_NODE (lisp_node)->node;
const TSLanguage *lang
= ts_parser_language (XTS_PARSER (lisp_parser)->parser);
+ /* Check BEG and END. */
+ struct buffer *buf = XBUFFER (XTS_PARSER (lisp_parser)->buffer);
+ if (!NILP (beg))
+ treesit_check_position (beg, buf);
+ if (!NILP (end))
+ treesit_check_position (end, buf);
+
/* Initialize query objects. At the end of this block, we should
have a working TSQuery and a TSQueryCursor. */
TSQuery *treesit_query;
(ert-deftest auth-source-pass-any-host ()
(auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user"))
("bar"))
- (should-not (auth-source-pass-search :host t))))
+ (let ((inhibit-message t)) ; silence "... does not handle host wildcards."
+ (should-not (auth-source-pass-search :host t)))))
(ert-deftest auth-source-pass-undefined-host ()
(auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user"))
;; with slightly more realistic and less legible values.
(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user ()
- (let ((store (sort (copy-sequence '(("x.com:42/b@r" (secret . "a"))
- ("b@r@x.com" (secret . "b"))
+ (let ((store (sort (copy-sequence '(("x.com:42/s p@m" (secret . "a"))
+ ("s p@m@x.com" (secret . "b"))
("x.com" (secret . "?"))
- ("b@r@y.org" (secret . "c"))
- ("fake.com" (secret . "?"))
- ("fake.com/b@r" (secret . "d"))
- ("y.org/b@r" (secret . "?"))
- ("b@r@fake.com" (secret . "e"))))
+ ("s p@m@y.org" (secret . "c"))
+ ("fa ke" (secret . "?"))
+ ("fa ke/s p@m" (secret . "d"))
+ ("y.org/s p@m" (secret . "?"))
+ ("s p@m@fa ke" (secret . "e"))))
(lambda (&rest _) (zerop (random 2))))))
(auth-source-pass--with-store store
(auth-source-pass-enable)
(let* ((auth-source-pass-extra-query-keywords t)
- (results (auth-source-search :host '("x.com" "fake.com" "y.org")
- :user "b@r"
+ (results (auth-source-search :host '("x.com" "fa ke" "y.org")
+ :user "s p@m"
:require '(:user) :max 5)))
(dolist (result results)
(setf (plist-get result :secret) (auth-info-password result)))
(should (equal results
- '((:host "x.com" :user "b@r" :secret "b")
- (:host "x.com" :user "b@r" :port "42" :secret "a")
- (:host "fake.com" :user "b@r" :secret "e")
- (:host "fake.com" :user "b@r" :secret "d")
- (:host "y.org" :user "b@r" :secret "c"))))))))
+ '((:host "x.com" :user "s p@m" :secret "b")
+ (:host "x.com" :user "s p@m" :port "42" :secret "a")
+ (:host "fa ke" :user "s p@m" :secret "e")
+ (:host "fa ke" :user "s p@m" :secret "d")
+ (:host "y.org" :user "s p@m" :secret "c"))))))))
;; This is a more distilled version of `suffixed-user', above. It
;; better illustrates that search order takes precedence over "/user"
(dolist (str comint-testsuite-password-strings)
(should (string-match comint-password-prompt-regexp str))))
+(declare-function w32-application-type "w32proc.c")
+(defun w32-native-executable-p (fname)
+ "Predicate to test program FNAME for being a native Windows application."
+ (and (memq (w32-application-type fname) '(w32-native dos))
+ (file-executable-p fname)))
+
+(defun w32-native-executable-find (name)
+ "Find a native MS-Windows application named NAME.
+This is needed to avoid invoking MSYS or Cygwin executables that
+happen to lurk on PATH when running the test suite."
+ (locate-file name exec-path exec-suffixes 'w32-native-executable-p))
+
(defun comint-tests/test-password-function (password-function)
"PASSWORD-FUNCTION can return nil or a string."
- (when-let ((cat (executable-find "cat")))
+ (when-let ((cat (if (eq system-type 'windows-nt)
+ (w32-native-executable-find "cat")
+ (executable-find "cat"))))
(let ((comint-password-function password-function))
(cl-letf (((symbol-function 'read-passwd)
(lambda (&rest _args) "non-nil")))
(declare-function sqlite-select "sqlite.c")
(declare-function sqlite-open "sqlite.c")
(declare-function sqlite-load-extension "sqlite.c")
+(declare-function sqlite-version "sqlite.c")
(ert-deftest sqlite-select ()
(skip-unless (sqlite-available-p))
(treesit-node-string
(treesit-node-first-child-for-pos
doc-node 3))))
+ (should-error (treesit-node-first-child-for-pos doc-node 100)
+ :type 'args-out-of-range)
;; `treesit-node-descendant-for-range'.
(should (equal "(\"{\")"
(treesit-node-string
(treesit-node-string
(treesit-node-descendant-for-range
root-node 6 7 t))))
+ (should-error (treesit-node-descendant-for-range
+ root-node 100 101)
+ :type 'args-out-of-range)
;; `treesit-node-eq'.
(should (treesit-node-eq root-node root-node))
(should (not (treesit-node-eq root-node doc-node))))))
(setq root-node (treesit-parser-root-node
parser)))
+ (should-error (treesit-query-capture root-node "" 100 101)
+ :type 'args-out-of-range)
+
;; Test `treesit-query-capture' on string, sexp and compiled
;; queries.
(dolist (query1
projects / emacs.git / commitdiff