commit 832bd2dfe51b2b9ea5e0e56e0e6ee60b2d8ae2ed (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Wed Oct 26 14:59:49 2022 +0800 Fix Haiku build for recent changes to system headers * src/callproc.c (emacs_posix_spawn_init_actions): Do not use posix_spawn_file_actions_addchdir on Haiku; it links but does not work. diff --git a/src/callproc.c b/src/callproc.c index 2d457b3c84..1337d2b9de 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1306,29 +1306,29 @@ emacs_posix_spawn_init_actions (posix_spawn_file_actions_t *actions, return error; error = posix_spawn_file_actions_adddup2 (actions, std_in, - STDIN_FILENO); + STDIN_FILENO); if (error != 0) goto out; error = posix_spawn_file_actions_adddup2 (actions, std_out, - STDOUT_FILENO); + STDOUT_FILENO); if (error != 0) goto out; error = posix_spawn_file_actions_adddup2 (actions, - std_err < 0 ? std_out - : std_err, - STDERR_FILENO); + std_err < 0 ? std_out + : std_err, + STDERR_FILENO); if (error != 0) goto out; - error = -#ifdef HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR - posix_spawn_file_actions_addchdir + /* Haiku appears to have linkable posix_spawn_file_actions_chdir, + but it always fails. So use the _np function instead. */ +#if defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR && !defined HAIKU + error = posix_spawn_file_actions_addchdir (actions, cwd); #else - posix_spawn_file_actions_addchdir_np + error = posix_spawn_file_actions_addchdir_np (actions, cwd); #endif - (actions, cwd); if (error != 0) goto out; @@ -1347,9 +1347,9 @@ emacs_posix_spawn_init_attributes (posix_spawnattr_t *attributes, return error; error = posix_spawnattr_setflags (attributes, - POSIX_SPAWN_SETSID - | POSIX_SPAWN_SETSIGDEF - | POSIX_SPAWN_SETSIGMASK); + POSIX_SPAWN_SETSID + | POSIX_SPAWN_SETSIGDEF + | POSIX_SPAWN_SETSIGMASK); if (error != 0) goto out; commit 5ad5b797f78dacb9c901d3c63bee05b1762fa94f Author: Andrea Corallo Date: Tue Oct 18 15:14:32 2022 +0200 Set `comp-no-spawn' earlier using -no-comp-spawn * src/emacs.c (standard_args): Add '-no-comp-spawn' cmd line option. * lisp/startup.el (command-line): Parse '-no-comp-spawn' cmd line option. * lisp/emacs-lisp/comp.el (comp-run-async-workers, comp-final): Use '-no-comp-spawn'. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 5a05fe4854..3987692f6f 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3689,8 +3689,7 @@ Prepare every function for final compilation and drive the C back-end." (print-circle t) (print-escape-multibyte t) (expr `((require 'comp) - (setf comp-no-spawn t - native-comp-verbose ,native-comp-verbose + (setf native-comp-verbose ,native-comp-verbose comp-libgccjit-reproducer ,comp-libgccjit-reproducer comp-ctxt ,comp-ctxt native-comp-eln-load-path ',native-comp-eln-load-path @@ -3716,7 +3715,8 @@ Prepare every function for final compilation and drive the C back-end." (if (zerop (call-process (expand-file-name invocation-name invocation-directory) - nil t t "--batch" "-l" temp-file)) + nil t t "-no-comp-spawn" "--batch" "-l" + temp-file)) (progn (delete-file temp-file) output) @@ -3948,7 +3948,6 @@ display a message." source-file (comp-el-to-eln-filename source-file)))) do (let* ((expr `((require 'comp) (setq comp-async-compilation t - comp-no-spawn t warning-fill-column most-positive-fixnum) ,(let ((set (list 'setq))) (dolist (var '(comp-file-preloaded-p @@ -4005,7 +4004,8 @@ display a message." :command (list (expand-file-name invocation-name invocation-directory) - "--batch" "-l" temp-file) + "-no-comp-spawn" "--batch" "-l" + temp-file) :sentinel (lambda (process _event) (run-hook-with-args diff --git a/lisp/startup.el b/lisp/startup.el index 725984b815..70267fc857 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1198,7 +1198,7 @@ please check its value") ("--user") ("--iconic") ("--icon-type") ("--quick") ("--no-blinking-cursor") ("--basic-display") ("--dump-file") ("--temacs") ("--seccomp") - ("--init-directory"))) + ("--init-directory" "--no-comp-spawn"))) (argi (pop args)) (orig-argi argi) argval) @@ -1255,6 +1255,9 @@ please check its value") ((equal argi "-no-site-file") (setq site-run-file nil) (put 'site-run-file 'standard-value '(nil))) + ((equal argi "-no-comp-spawn") + (defvar comp-no-spawn) + (setq comp-no-spawn t)) ((equal argi "-debug-init") (setq init-file-debug t)) ((equal argi "-iconic") diff --git a/src/emacs.c b/src/emacs.c index 43e81b912c..8ad70fecd4 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2564,6 +2564,7 @@ static const struct standard_args standard_args[] = { "-init-directory", "--init-directory", 30, 1 }, { "-no-x-resources", "--no-x-resources", 40, 0 }, { "-no-site-file", "--no-site-file", 40, 0 }, + { "-no-comp-spawn", "--no-comp-spawn", 60, 0 }, { "-u", "--user", 30, 1 }, { "-user", 0, 30, 1 }, { "-debug-init", "--debug-init", 20, 0 }, commit d062482c3f9c243e3224d9de0d776be05c54926b Author: Dmitry Gutov Date: Wed Oct 26 00:09:01 2022 +0300 vc-hg-checkin-patch: Add implementation for Hg * lisp/vc/vc-hg.el (vc-hg-checkin-patch): Add Hg-specific implementation (bug#52349), like suggested in https://lists.gnu.org/archive/html/emacs-devel/2022-10/msg01533.html. (vc-hg--extract-headers): Extract from vc-hg-checkin. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 2eebe2d543..1b1c1683dd 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -51,6 +51,7 @@ ;; - receive-file (file rev) ?? PROBABLY NOT NEEDED ;; - unregister (file) OK ;; * checkin (files rev comment) OK +;; - checkin-patch (patch-string comment) OK ;; * find-revision (file rev buffer) OK ;; * checkout (file &optional rev) OK ;; * revert (file &optional contents-done) OK @@ -1189,16 +1190,31 @@ It is based on `log-edit-mode', and has Hg-specific extensions.") (defun vc-hg-checkin (files comment &optional _rev) "Hg-specific version of `vc-backend-checkin'. REV is ignored." - (let ((amend-extract-fn - (lambda (value) - (when (equal value "yes") - (list "--amend"))))) - (apply #'vc-hg-command nil 0 files - (nconc (list "commit" "-m") - (log-edit-extract-headers `(("Author" . "--user") - ("Date" . "--date") - ("Amend" . ,amend-extract-fn)) - comment))))) + (apply #'vc-hg-command nil 0 files + (nconc (list "commit" "-m") + (vc-hg--extract-headers comment)))) + +(defun vc-hg-checkin-patch (patch-string comment) + (let ((patch-file (make-temp-file "hg-patch"))) + (write-region patch-string nil patch-file) + (unwind-protect + (progn + (apply #'vc-hg-command nil 0 nil + (nconc (list "import" "--bypass" patch-file "-m") + (vc-hg--extract-headers comment))) + (vc-hg-command nil 0 nil + "update" + "--merge" "--tool" "internal:local" + "tip")) + (delete-file patch-file)))) + +(defun vc-hg--extract-headers (comment) + (log-edit-extract-headers `(("Author" . "--user") + ("Date" . "--date") + ("Amend" . (lambda (value) + (when (equal value "yes") + (list "--amend"))))) + comment)) (defun vc-hg-find-revision (file rev buffer) (let ((coding-system-for-read 'binary) commit 33647b6d63fe3062361a23a901664a379c07097f Author: Andreas Schwab Date: Tue Oct 25 18:22:21 2022 +0200 Ignore non-base64 junk when decoding MIME * src/fns.c (Fbase64_decode_region): Add optional argument IGNORE-INVALID and pass down to base64_decode_1. (Fbase64_decode_string): Likewise. (base64_decode_1): Add argument IGNORE_INVALID. * doc/lispref/text.texi (Base 64): Document them. * lisp/gnus/mm-bodies.el (mm-decode-content-transfer-encoding): Ignore any junk when decoding base64. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 509ce56725..d1010db515 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4876,7 +4876,7 @@ If the optional argument @var{no-pad} is non-@code{nil} then this function doesn't generate the padding. @end defun -@deffn Command base64-decode-region beg end &optional base64url +@deffn Command base64-decode-region beg end &optional base64url ignore-invalid This function converts the region from @var{beg} to @var{end} from base 64 code into the corresponding decoded text. It returns the length of the decoded text. @@ -4885,9 +4885,11 @@ The decoding functions ignore newline characters in the encoded text. If optional argument @var{base64url} is non-@code{nil}, then padding is optional, and the URL variant of base 64 encoding is used. +If optional argument @var{ignore-invalid} is non-@code{nil}, then any +unrecognized characters are ignored. @end deffn -@defun base64-decode-string string &optional base64url +@defun base64-decode-string string &optional base64url ignore-invalid This function converts the string @var{string} from base 64 code into the corresponding decoded text. It returns a unibyte string containing the decoded text. @@ -4897,6 +4899,8 @@ The decoding functions ignore newline characters in the encoded text. If optional argument @var{base64url} is non-@code{nil}, then padding is optional, and the URL variant of base 64 encoding is used. +If optional argument @var{ignore-invalid} is non-@code{nil}, then any +unrecognized characters are ignored. @end defun @node Checksum/Hash diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index 9045966df5..44ce1c9485 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -189,24 +189,8 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (quoted-printable-decode-region (point-min) (point-max)) t) ((eq encoding 'base64) - (base64-decode-region - (point-min) - (save-excursion - ;; Some mailers insert whitespace junk at the end which - ;; base64-decode-region dislikes. - (goto-char (point-min)) - (while (re-search-forward "^[\t ]*\r?\n" nil t) - (delete-region (match-beginning 0) (match-end 0))) - ;; Also ignore junk which could have been added by - ;; mailing list software by finding the final line with - ;; base64 text. - (goto-char (point-max)) - (beginning-of-line) - (while (and (not (mm-base64-line-p)) - (not (bobp))) - (forward-line -1)) - (forward-line 1) - (point)))) + ;; MIME says to ignore any non-base64 junk + (base64-decode-region (point-min) (point-max) nil t)) ((memq encoding '(nil 7bit 8bit binary)) ;; Do nothing. t) diff --git a/src/fns.c b/src/fns.c index 940fb680fc..c35f40357b 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3661,7 +3661,7 @@ static signed char const base64_char_to_value[2][UCHAR_MAX] = static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool, bool, bool); static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool, - bool, ptrdiff_t *); + bool, bool, ptrdiff_t *); static Lisp_Object base64_encode_region_1 (Lisp_Object, Lisp_Object, bool, bool, bool); @@ -3924,7 +3924,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t length, DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region, - 2, 3, "r", + 2, 4, "r", doc: /* Base64-decode the region between BEG and END. Return the length of the decoded data. @@ -3935,8 +3935,11 @@ system. If the region can't be decoded, signal an error and don't modify the buffer. Optional third argument BASE64URL determines whether to use the URL variant -of the base 64 encoding, as defined in RFC 4648. */) - (Lisp_Object beg, Lisp_Object end, Lisp_Object base64url) +of the base 64 encoding, as defined in RFC 4648. +If optional fourth argument INGORE-INVALID is non-nil invalid characters +are ignored instead of signaling an error. */) + (Lisp_Object beg, Lisp_Object end, Lisp_Object base64url, + Lisp_Object ignore_invalid) { ptrdiff_t ibeg, iend, length, allength; char *decoded; @@ -3962,7 +3965,8 @@ of the base 64 encoding, as defined in RFC 4648. */) move_gap_both (XFIXNAT (beg), ibeg); decoded_length = base64_decode_1 ((char *) BYTE_POS_ADDR (ibeg), decoded, length, !NILP (base64url), - multibyte, &inserted_chars); + multibyte, !NILP (ignore_invalid), + &inserted_chars); if (decoded_length > allength) emacs_abort (); @@ -3995,11 +3999,13 @@ of the base 64 encoding, as defined in RFC 4648. */) } DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string, - 1, 2, 0, + 1, 3, 0, doc: /* Base64-decode STRING and return the result as a string. Optional argument BASE64URL determines whether to use the URL variant of -the base 64 encoding, as defined in RFC 4648. */) - (Lisp_Object string, Lisp_Object base64url) +the base 64 encoding, as defined in RFC 4648. +If optional third argument IGNORE-INVALID is non-nil invalid characters are +ignored instead of signaling an error. */) + (Lisp_Object string, Lisp_Object base64url, Lisp_Object ignore_invalid) { char *decoded; ptrdiff_t length, decoded_length; @@ -4015,7 +4021,8 @@ the base 64 encoding, as defined in RFC 4648. */) /* The decoded result should be unibyte. */ ptrdiff_t decoded_chars; decoded_length = base64_decode_1 (SSDATA (string), decoded, length, - !NILP (base64url), 0, &decoded_chars); + !NILP (base64url), false, + !NILP (ignore_invalid), &decoded_chars); if (decoded_length > length) emacs_abort (); else if (decoded_length >= 0) @@ -4032,12 +4039,13 @@ the base 64 encoding, as defined in RFC 4648. */) /* Base64-decode the data at FROM of LENGTH bytes into TO. If MULTIBYTE, the decoded result should be in multibyte - form. Store the number of produced characters in *NCHARS_RETURN. */ + form. If IGNORE_INVALID, ignore invalid base64 characters. + Store the number of produced characters in *NCHARS_RETURN. */ static ptrdiff_t base64_decode_1 (const char *from, char *to, ptrdiff_t length, - bool base64url, - bool multibyte, ptrdiff_t *nchars_return) + bool base64url, bool multibyte, bool ignore_invalid, + ptrdiff_t *nchars_return) { char const *f = from; char const *flim = from + length; @@ -4063,7 +4071,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length, c = *f++; v1 = b64_char_to_value[c]; } - while (v1 < 0); + while (v1 < 0 || (v1 == 0 && ignore_invalid)); if (v1 == 0) return -1; @@ -4078,7 +4086,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length, c = *f++; v1 = b64_char_to_value[c]; } - while (v1 < 0); + while (v1 < 0 || (v1 == 0 && ignore_invalid)); if (v1 == 0) return -1; @@ -4097,7 +4105,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length, { if (f == flim) { - if (!base64url) + if (!base64url && !ignore_invalid) return -1; *nchars_return = nchars; return e - to; @@ -4105,7 +4113,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length, c = *f++; v1 = b64_char_to_value[c]; } - while (v1 < 0); + while (v1 < 0 || (v1 == 0 && ignore_invalid)); if (c == '=') { @@ -4139,7 +4147,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length, { if (f == flim) { - if (!base64url) + if (!base64url && !ignore_invalid) return -1; *nchars_return = nchars; return e - to; @@ -4147,7 +4155,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length, c = *f++; v1 = b64_char_to_value[c]; } - while (v1 < 0); + while (v1 < 0 || (v1 == 0 && ignore_invalid)); if (c == '=') continue; commit e5cb66c046be440ca63fb384ea93f450aa4f958e Author: João Guerra Date: Tue Oct 25 21:48:37 2022 +0300 * lisp/tab-line.el (tab-line-auto-hscroll): Set word-wrap to nil (bug#58740). Copyright-paperwork-exempt: yes diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 94e8f29a95..a4e95bbc75 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -620,7 +620,8 @@ the selected tab visible." (let ((truncate-partial-width-windows nil) (inhibit-modification-hooks t) show-arrows) - (setq truncate-lines nil) + (setq truncate-lines nil + word-wrap nil) (erase-buffer) (apply 'insert strings) (goto-char (point-min)) commit 1b1ffe07897ebe06cf96ab423fad3cde9fd6c981 Author: Stefan Monnier Date: Mon Oct 17 17:11:40 2022 -0400 (Ffunction): Make interpreted closures safe for space Interpreted closures currently just grab a reference to the complete lexical environment, so (lambda (x) (+ x y)) can end up looking like (closure ((foo ...) (y 7) (bar ...) ...) (x) (+ x y)) where the foo/bar/... bindings are not only useless but can prevent the GC from collecting that memory (i.e. it's a representation that is not "safe for space") and it can also make that closure "unwritable" (or more specifically, it can cause the closure's print representation to be u`read`able). Compiled closures don't suffer from this problem because `cconv.el` actually looks at the code and only stores in the compiled closure those variables which are actually used. So, we fix this discrepancy by letting the existing code in `cconv.el` tell `Ffunction` which variables are actually used by the body of the function such that it can filter out the irrelevant elements and return a closure of the form: (closure ((y 7)) (x) (+ x y)) * lisp/loadup.el: Preload `cconv` and set `internal-filter-closure-env-function` once we have a usable `cconv-fv`. * lisp/emacs-lisp/bytecomp.el (byte-compile-preprocess): Adjust to new calling convention of `cconv-closure-convert`. (byte-compile-not-lexical-var-p): Delete function, moved to `cconv.el`. (byte-compile-bind): Use `cconv--not-lexical-var-p`. * lisp/emacs-lisp/cconv.el (cconv--dynbound-variables): New var. (cconv-closure-convert): New arg `dynbound-vars` (cconv--warn-unused-msg): Remove special case for `ignored`, so we don't get confused when a function uses an argument called `ignored`, e.g. holding a list of things that it should ignore. (cconv--not-lexical-var-p): New function, moved from `bytecomp.el`. Don't special case keywords and `nil` and `t` since they are already `special-variable-p`. (cconv--analyze-function): Use `cconv--not-lexical-var-p`. (cconv--dynbindings): New dynbound var. (cconv-analyze-form): Use `cconv--not-lexical-var-p`. Remember in `cconv--dynbindings` the vars for which we used dynamic scoping. (cconv-analyze-form): Use `cconv--dynbound-variables` rather than `byte-compile-bound-variables`. (cconv-fv): New function. * src/eval.c (Fsetq, eval_sub): Remove optimization designed when `lexical-binding == nil` was the common case. (Ffunction): Use `internal-filter-closure-env-function` when available. (eval_sub, Ffuncall): Improve error info for `excessive_lisp_nesting`. (internal-filter-closure-env-function): New defvar. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index cbe276b2dc..7206f2acd2 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1183,7 +1183,7 @@ Here is an example: (let ((x 0)) ; @r{@code{x} is lexically bound.} (setq my-ticker (lambda () (setq x (1+ x))))) - @result{} (closure ((x . 0) t) () + @result{} (closure ((x . 0)) () (setq x (1+ x))) (funcall my-ticker) diff --git a/etc/NEWS b/etc/NEWS index 6622f2d4ad..cbbf90fde6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3171,6 +3171,15 @@ The following generalized variables have been made obsolete: * Lisp Changes in Emacs 29.1 ++++ +** Interpreted closures are "safe for space". +As was already the case for byte-compiled closures, instead of capturing +the whole current lexical environment, interpreted closures now only +capture the part of the environment that they need. +The previous behavior could occasionally lead to memory leaks or +to problems where a printed closure would not be 'read'able because +of an un'read'able value in an unrelated lexical variable. + +++ ** New accessor function 'file-attribute-file-identifier'. It returns the list of the inode number and device identifier diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f026568217..9f29ffbb8e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2565,7 +2565,7 @@ list that represents a doc string reference. ;; macroexpand-all. ;; (if (memq byte-optimize '(t source)) ;; (setq form (byte-optimize-form form for-effect))) - (cconv-closure-convert form)) + (cconv-closure-convert form byte-compile-bound-variables)) ;; byte-hunk-handlers cannot call this! (defun byte-compile-toplevel-file-form (top-level-form) @@ -4663,13 +4663,6 @@ Return the offset in the form (VAR . OFFSET)." (byte-compile-form (cadr clause)) (byte-compile-push-constant nil))))) -(defun byte-compile-not-lexical-var-p (var) - (or (not (symbolp var)) - (special-variable-p var) - (memq var byte-compile-bound-variables) - (memq var '(nil t)) - (keywordp var))) - (defun byte-compile-bind (var init-lexenv) "Emit byte-codes to bind VAR and update `byte-compile--lexical-environment'. INIT-LEXENV should be a lexical-environment alist describing the @@ -4678,7 +4671,7 @@ Return non-nil if the TOS value was popped." ;; The mix of lexical and dynamic bindings mean that we may have to ;; juggle things on the stack, to move them to TOS for ;; dynamic binding. - (if (and lexical-binding (not (byte-compile-not-lexical-var-p var))) + (if (not (cconv--not-lexical-var-p var byte-compile-bound-variables)) ;; VAR is a simple stack-allocated lexical variable. (progn (push (assq var init-lexenv) byte-compile--lexical-environment) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 23d0f12194..3f27faab11 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -64,20 +64,12 @@ ;; ;;; Code: -;; PROBLEM cases found during conversion to lexical binding. -;; We should try and detect and warn about those cases, even -;; for lexical-binding==nil to help prepare the migration. -;; - Uses of run-hooks, and friends. -;; - Cases where we want to apply the same code to different vars depending on -;; some test. These sometimes use a (let ((foo (if bar 'a 'b))) -;; ... (symbol-value foo) ... (set foo ...)). - ;; TODO: (not just for cconv but also for the lexbind changes in general) ;; - let (e)debug find the value of lexical variables from the stack. ;; - make eval-region do the eval-sexp-add-defvars dance. ;; - byte-optimize-form should be applied before cconv. ;; OTOH, the warnings emitted by cconv-analyze need to come before optimize -;; since afterwards they can because obnoxious (warnings about an "unused +;; since afterwards they can become obnoxious (warnings about an "unused ;; variable" should not be emitted when the variable use has simply been ;; optimized away). ;; - let macros specify that some let-bindings come from the same source, @@ -87,33 +79,9 @@ ;; - canonize code in macro-expand so we don't have to handle (let (var) body) ;; and other oddities. ;; - new byte codes for unwind-protect so that closures aren't needed at all. -;; - a reference to a var that is known statically to always hold a constant -;; should be turned into a byte-constant rather than a byte-stack-ref. -;; Hmm... right, that's called constant propagation and could be done here, -;; but when that constant is a function, we have to be careful to make sure -;; the bytecomp only compiles it once. ;; - Since we know here when a variable is not mutated, we could pass that ;; info to the byte-compiler, e.g. by using a new `immutable-let'. ;; - call known non-escaping functions with `goto' rather than `call'. -;; - optimize mapc to a dolist loop. - -;; (defmacro dlet (binders &rest body) -;; ;; Works in both lexical and non-lexical mode. -;; (declare (indent 1) (debug let)) -;; `(progn -;; ,@(mapcar (lambda (binder) -;; `(defvar ,(if (consp binder) (car binder) binder))) -;; binders) -;; (let ,binders ,@body))) - -;; (defmacro llet (binders &rest body) -;; ;; Only works in lexical-binding mode. -;; `(funcall -;; (lambda ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder)) -;; binders) -;; ,@body) -;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder))) -;; binders))) (eval-when-compile (require 'cl-lib)) @@ -142,13 +110,19 @@ is less than this number.") ;; interactive forms. (make-hash-table :test #'eq :weakness 'key)) +(defvar cconv--dynbound-variables nil + "List of variables known to be dynamically bound.") + ;;;###autoload -(defun cconv-closure-convert (form) +(defun cconv-closure-convert (form &optional dynbound-vars) "Main entry point for closure conversion. FORM is a piece of Elisp code after macroexpansion. +DYNBOUND-VARS is a list of symbols that should be considered as +using dynamic scoping. Returns a form where all lambdas don't have any free variables." - (let ((cconv-freevars-alist '()) + (let ((cconv--dynbound-variables dynbound-vars) + (cconv-freevars-alist '()) (cconv-var-classification '())) ;; Analyze form - fill these variables with new information. (cconv-analyze-form form '()) @@ -262,9 +236,7 @@ Returns a form where all lambdas don't have any free variables." ;; it is often non-trivial for the programmer to avoid such ;; unused vars. (not (intern-soft var)) - (eq ?_ (aref (symbol-name var) 0)) - ;; As a special exception, ignore "ignored". - (eq var 'ignored)) + (eq ?_ (aref (symbol-name var) 0))) (let ((suggestions (help-uni-confusable-suggestions (symbol-name var)))) (format "Unused lexical %s `%S'%s" varkind (bare-symbol var) @@ -342,7 +314,7 @@ EXTEND is a list of variables which might need to be accessed even from places where they are shadowed, because some part of ENV causes them to be used at places where they originally did not directly appear." (cl-assert (not (delq nil (mapcar (lambda (mapping) - (if (eq (cadr mapping) 'apply-partially) + (if (eq (cadr mapping) #'apply-partially) (cconv--set-diff (cdr (cddr mapping)) extend))) env)))) @@ -634,6 +606,12 @@ places where they originally did not directly appear." (defvar byte-compile-lexical-variables) +(defun cconv--not-lexical-var-p (var dynbounds) + (or (not lexical-binding) + (not (symbolp var)) + (special-variable-p var) + (memq var dynbounds))) + (defun cconv--analyze-use (vardata form varkind) "Analyze the use of a variable. VARDATA should be (BINDER READ MUTATED CAPTURED CALLED). @@ -677,7 +655,7 @@ FORM is the parent form that binds this var." ;; outside of it. (envcopy (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env)) - (byte-compile-bound-variables byte-compile-bound-variables) + (cconv--dynbound-variables cconv--dynbound-variables) (newenv envcopy)) ;; Push it before recursing, so cconv-freevars-alist contains entries in ;; the order they'll be used by closure-convert-rec. @@ -685,7 +663,7 @@ FORM is the parent form that binds this var." (when lexical-binding (dolist (arg args) (cond - ((byte-compile-not-lexical-var-p arg) + ((cconv--not-lexical-var-p arg cconv--dynbound-variables) (byte-compile-warn-x arg "Lexical argument shadows the dynamic variable %S" @@ -715,6 +693,8 @@ FORM is the parent form that binds this var." (setf (nth 3 (car env)) t)) (setq env (cdr env) envcopy (cdr envcopy)))))) +(defvar cconv--dynbindings) + (defun cconv-analyze-form (form env) "Find mutated variables and variables captured by closure. Analyze lambdas if they are suitable for lambda lifting. @@ -730,7 +710,7 @@ This function does not return anything but instead fills the (let ((orig-env env) (newvars nil) (var nil) - (byte-compile-bound-variables byte-compile-bound-variables) + (cconv--dynbound-variables cconv--dynbound-variables) (value nil)) (dolist (binder binders) (if (not (consp binder)) @@ -743,7 +723,9 @@ This function does not return anything but instead fills the (cconv-analyze-form value (if (eq letsym 'let*) env orig-env))) - (unless (or (byte-compile-not-lexical-var-p var) (not lexical-binding)) + (if (cconv--not-lexical-var-p var cconv--dynbound-variables) + (when (boundp 'cconv--dynbindings) + (push var cconv--dynbindings)) (cl-pushnew var byte-compile-lexical-variables) (let ((varstruct (list var nil nil nil nil))) (push (cons binder (cdr varstruct)) newvars) @@ -797,7 +779,8 @@ This function does not return anything but instead fills the (cconv-analyze-form protected-form env) (unless lexical-binding (setq var nil)) - (when (and var (symbolp var) (byte-compile-not-lexical-var-p var)) + (when (and var (symbolp var) + (cconv--not-lexical-var-p var cconv--dynbound-variables)) (byte-compile-warn-x var "Lexical variable shadows the dynamic variable %S" var)) (let* ((varstruct (list var nil nil nil nil))) @@ -813,9 +796,9 @@ This function does not return anything but instead fills the (cconv-analyze-form form env) (cconv--analyze-function () body env form)) - (`(defvar ,var) (push var byte-compile-bound-variables)) + (`(defvar ,var) (push var cconv--dynbound-variables)) (`(,(or 'defconst 'defvar) ,var ,value . ,_) - (push var byte-compile-bound-variables) + (push var cconv--dynbound-variables) (cconv-analyze-form value env)) (`(,(or 'funcall 'apply) ,fun . ,args) @@ -847,5 +830,49 @@ This function does not return anything but instead fills the (setf (nth 1 dv) t)))))) (define-obsolete-function-alias 'cconv-analyse-form #'cconv-analyze-form "25.1") +(defun cconv-fv (form env &optional no-macroexpand) + "Return the list of free variables in FORM. +ENV is the lexical environment from which the variables can be taken. +It should be a list of pairs of the form (VAR . VAL). +The return value is a list of those (VAR . VAL) bindings, +in the same order as they appear in ENV. +If NO-MACROEXPAND is non-nil, we do not macro-expand FORM, +which means that the result may be incorrect if there are non-expanded +macro calls in FORM." + (let* ((fun `#'(lambda () ,form)) + ;; Make dummy bindings to avoid warnings about the var being + ;; left uninitialized. + (analysis-env + (delq nil (mapcar (lambda (b) (if (consp b) + (list (car b) nil nil nil nil))) + env))) + (cconv--dynbound-variables + (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env))) + (byte-compile-lexical-variables nil) + (cconv--dynbindings nil) + (cconv-freevars-alist '()) + (cconv-var-classification '())) + (if (null analysis-env) + ;; The lexical environment is empty, so there's no need to + ;; look for free variables. + env + (let* ((fun (if no-macroexpand fun + (macroexpand-all fun macroexpand-all-environment))) + (body (cddr (cadr fun)))) + ;; Analyze form - fill these variables with new information. + (cconv-analyze-form fun analysis-env) + (setq cconv-freevars-alist (nreverse cconv-freevars-alist)) + (cl-assert (equal (if (eq :documentation (car-safe (car body))) + (cdr body) body) + (caar cconv-freevars-alist))) + (let ((fvs (nreverse (cdar cconv-freevars-alist))) + (dyns (mapcar (lambda (var) (car (memq var env))) + (delete-dups cconv--dynbindings)))) + (or (nconc (mapcar (lambda (fv) (assq fv env)) fvs) + (delq nil dyns)) + ;; Never return nil, since nil means to use the dynbind + ;; dialect of ELisp. + '(t))))))) + (provide 'cconv) ;;; cconv.el ends here diff --git a/lisp/loadup.el b/lisp/loadup.el index e940a32100..63806ae456 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -366,6 +366,10 @@ (load "emacs-lisp/shorthands") (load "emacs-lisp/eldoc") +(load "emacs-lisp/cconv") +(when (and (byte-code-function-p (symbol-function 'cconv-fv)) + (byte-code-function-p (symbol-function 'macroexpand-all))) + (setq internal-filter-closure-env-function #'cconv-fv)) (load "cus-start") ;Late to reduce customize-rogue (needs loaddefs.el anyway) (if (not (eq system-type 'ms-dos)) (load "tooltip")) diff --git a/src/eval.c b/src/eval.c index 8810136c04..d2cab006d1 100644 --- a/src/eval.c +++ b/src/eval.c @@ -484,8 +484,7 @@ usage: (setq [SYM VAL]...) */) /* Like for eval_sub, we do not check declared_special here since it's been done when let-binding. */ Lisp_Object lex_binding - = ((!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ - && SYMBOLP (sym)) + = (SYMBOLP (sym) ? Fassq (sym, Vinternal_interpreter_environment) : Qnil); if (!NILP (lex_binding)) @@ -551,8 +550,15 @@ usage: (function ARG) */) CHECK_STRING (docstring); cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr)))); } - return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, - cdr)); + Lisp_Object env + = NILP (Vinternal_filter_closure_env_function) + ? Vinternal_interpreter_environment + /* FIXME: This macroexpands the body, so we should use the resulting + macroexpanded code! */ + : call2 (Vinternal_filter_closure_env_function, + Fcons (Qprogn, CONSP (cdr) ? XCDR (cdr) : cdr), + Vinternal_interpreter_environment); + return Fcons (Qclosure, Fcons (env, cdr)); } else /* Simply quote the argument. */ @@ -2374,9 +2380,7 @@ eval_sub (Lisp_Object form) We do not pay attention to the declared_special flag here, since we already did that when let-binding the variable. */ Lisp_Object lex_binding - = (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ - ? Fassq (form, Vinternal_interpreter_environment) - : Qnil); + = Fassq (form, Vinternal_interpreter_environment); return !NILP (lex_binding) ? XCDR (lex_binding) : Fsymbol_value (form); } @@ -2392,7 +2396,7 @@ eval_sub (Lisp_Object form) if (max_lisp_eval_depth < 100) max_lisp_eval_depth = 100; if (lisp_eval_depth > max_lisp_eval_depth) - xsignal0 (Qexcessive_lisp_nesting); + xsignal1 (Qexcessive_lisp_nesting, make_fixnum (lisp_eval_depth)); } Lisp_Object original_fun = XCAR (form); @@ -2966,7 +2970,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) if (max_lisp_eval_depth < 100) max_lisp_eval_depth = 100; if (lisp_eval_depth > max_lisp_eval_depth) - xsignal0 (Qexcessive_lisp_nesting); + xsignal1 (Qexcessive_lisp_nesting, make_fixnum (lisp_eval_depth)); } count = record_in_backtrace (args[0], &args[1], nargs - 1); @@ -4357,6 +4361,11 @@ alist of active lexical bindings. */); (Just imagine if someone makes it buffer-local). */ Funintern (Qinternal_interpreter_environment, Qnil); + DEFVAR_LISP ("internal-filter-closure-env-function", + Vinternal_filter_closure_env_function, + doc: /* Function to filter the env when constructing a closure. */); + Vinternal_filter_closure_env_function = Qnil; + Vrun_hooks = intern_c_string ("run-hooks"); staticpro (&Vrun_hooks); commit 7e60246ab3cb7a3c40ca48d8ea9c107f00a6aea6 Author: Filipp Gunbin Date: Tue Oct 25 17:59:33 2022 +0300 Move required options out of ldap-ldapsearch-args * lisp/net/ldap.el (ldap-ldapsearch-args, ldap-search-internal): Move "-LLL" and "-tt" options as they're required for the code to work properly. diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index ccad8c4edb..de553468b1 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -156,7 +156,7 @@ Valid properties include: "The name of the ldapsearch command line program." :type '(string :tag "`ldapsearch' Program")) -(defcustom ldap-ldapsearch-args '("-LLL" "-tt") +(defcustom ldap-ldapsearch-args nil "A list of additional arguments to pass to `ldapsearch'." :type '(repeat :tag "`ldapsearch' Arguments" (string :tag "Argument"))) @@ -609,7 +609,8 @@ an alist of attribute/value pairs." (sizelimit (plist-get search-plist 'sizelimit)) (withdn (plist-get search-plist 'withdn)) (numres 0) - arglist dn name value record result) + (arglist (list "-LLL" "-tt")) + dn name value record result) (if (or (null filter) (equal "" filter)) (error "No search filter")) commit c8fe6aae0ac352e48fff2bdec966a0605be63bac Author: Stefan Kangas Date: Tue Oct 25 16:42:58 2022 +0200 eglot: Prefer ensure-list on Emacs 28 or later * lisp/progmodes/eglot.el (eglot--ensure-list): Make into alias for 'ensure-list' on Emacs 28 or later. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 201fafb671..1b983e94d7 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1632,6 +1632,8 @@ and just return it. PROMPT shouldn't end with a question mark." (cl-loop for (k _v) on plist by #'cddr collect k)) (defun eglot--ensure-list (x) (if (listp x) x (list x))) +(when (fboundp 'ensure-list) ; Emacs 28 or later + (define-obsolete-function-alias 'eglot--ensure-list #'ensure-list "29.1")) ;;; Minor modes commit fe816fc679ead2100cddb4e51bc81c329bcb4265 Author: Michael Albinus Date: Tue Oct 25 16:34:42 2022 +0200 Handle context changes in Tramp kubernetes method * doc/misc/tramp.texi (Inline methods): Remove note about cache reset. (File name completion): Add tramp-completion-use-cache. * etc/NEWS: Add 'tramp-completion-use-cache'. * lisp/net/tramp-cache.el (tramp-completion-use-cache): New defcustom. (tramp-parse-connection-properties): Use it. * lisp/net/tramp-container.el (tramp-docker--completion-function) (tramp-kubernetes--completion-function): Ensure the processes run locally. (tramp-kubernetes--current-context-data): New defun. (tramp-methods) : Add `tramp-config-check'. * lisp/net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): Handle `tramp-login-args'. * lisp/net/tramp.el (tramp-methods): Adapt docstring. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index e74d382fa1..99a268367b 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -925,12 +925,6 @@ Integration for containers in Kubernetes pods. The host name is a pod name returned by @samp{kubectl get pods}. The first container in a pod is used. -@samp{kubectl get pods} returns pods in the current context and -namespace. Current namespace can be changed with @samp{kubectl config -set-context --current --namespace=}. After invoking this or -other command which modifies Kubernetes environment outside of Emacs, -call @code{tramp-cleanup-all-connections} to reset Tramp cache data. - This method does not support user names. @end table @@ -3538,9 +3532,14 @@ the @file{~/.authinfo.gpg} authentication file. The user option @code{tramp-completion-use-auth-sources} controls, whether such a search is performed during completion. +@vindex tramp-completion-use-cache Remote hosts previously visited or hosts whose connections are kept persistently (@pxref{Connection caching}) will be included in the -completion lists. +completion lists. If you want to suppress this completion because +there are invalid entries in the persistency file, for example if the +host configuration changes often, or if you plug your laptop to +different networks frequently, you can set the user option +@code{tramp-completion-use-cache} to nil. After remote host name completion comes completion of file names on the remote host. It works the same as with local host file completion diff --git a/etc/NEWS b/etc/NEWS index aacad8bc4d..6622f2d4ad 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2517,6 +2517,12 @@ the user requesting such a connection, and not of the user who is the target. This has always been needed, just the password prompt and the related 'auth-sources' entry were wrong. ++++ +*** New user option 'tramp-completion-use-cache'. +During user and host name completion in the minibuffer, results from +Tramp's connection cache are taken into account. This can be disabled +by setting the user option 'tramp-completion-use-cache' to nil. + ** Browse URL --- diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 4d7d35a4de..912ea5f8bb 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -601,19 +601,30 @@ PROPERTIES is a list of file properties (strings)." (remove-hook 'kill-emacs-hook #'tramp-dump-connection-properties))) +;;;###tramp-autoload +(defcustom tramp-completion-use-cache t + "Whether to use the Tramp cache for completion of user and host names. +Set it to nil if there are invalid entries in the cache, for +example if the host configuration changes often, or if you plug +your laptop to different networks frequently." + :group 'tramp + :version "29.1" + :type 'boolean) + ;;;###tramp-autoload (defun tramp-parse-connection-properties (method) "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' for all methods. Resulting data are derived from connection history." - (mapcar - (lambda (key) - (and (tramp-file-name-p key) - (string-equal method (tramp-file-name-method key)) - (not (tramp-file-name-localname key)) - (list (tramp-file-name-user key) - (tramp-file-name-host key)))) - (hash-table-keys tramp-cache-data))) + (and tramp-completion-use-cache + (mapcar + (lambda (key) + (and (tramp-file-name-p key) + (string-equal method (tramp-file-name-method key)) + (not (tramp-file-name-localname key)) + (list (tramp-file-name-user key) + (tramp-file-name-host key)))) + (hash-table-keys tramp-cache-data)))) ;; When "emacs -Q" has been called, both variables are nil. We do not ;; load the persistency file then, in order to have a clean test environment. diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index e104babed2..0879d6f185 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -101,7 +101,8 @@ This function is used by `tramp-set-completion-function', please see its function help for a description of the format." - (when-let ((raw-list (shell-command-to-string + (when-let ((default-directory tramp-compat-temporary-file-directory) + (raw-list (shell-command-to-string (concat tramp-docker-program " ps --format '{{.ID}}\t{{.Names}}'"))) (lines (split-string raw-list "\n" 'omit)) @@ -121,7 +122,8 @@ see its function help for a description of the format." This function is used by `tramp-set-completion-function', please see its function help for a description of the format." - (when-let ((raw-list (shell-command-to-string + (when-let ((default-directory tramp-compat-temporary-file-directory) + (raw-list (shell-command-to-string (concat tramp-kubernetes-program " get pods --no-headers " "-o custom-columns=NAME:.metadata.name"))) @@ -130,6 +132,24 @@ see its function help for a description of the format." (list nil name)) names))) +(defun tramp-kubernetes--current-context-data (vec) + "Return Kubernetes current context data as JSONPATH string." + (with-temp-buffer + (when (zerop + (tramp-call-process + vec tramp-kubernetes-program nil t nil + "config" "current-context")) + (goto-char (point-min)) + (let ((current-context (buffer-substring (point) (line-end-position)))) + (erase-buffer) + (when (zerop + (tramp-call-process + vec tramp-kubernetes-program nil t nil + "config" "view" "-o" + (format + "jsonpath='{.contexts[?(@.name == \"%s\")]}'" current-context))) + (buffer-string)))))) + ;;;###tramp-autoload (defvar tramp-default-remote-shell) ;; Silence byte compiler. @@ -165,6 +185,7 @@ see its function help for a description of the format." ("-it") ("--") ("%l"))) + (tramp-config-check tramp-kubernetes--current-context-data) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index d74afc8412..3904348232 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4472,7 +4472,8 @@ process to set up. VEC specifies the connection." ;; Check whether the output of "uname -sr" has been changed. If ;; yes, this is a strong indication that we must expire all ;; connection properties. We start again with - ;; `tramp-maybe-open-connection', it will be caught there. + ;; `tramp-maybe-open-connection', it will be caught there. The same + ;; check will be applied with the function kept in`tramp-config-check'. (tramp-message vec 5 "Checking system information") (let* ((old-uname (tramp-get-connection-property vec "uname")) (uname @@ -4481,8 +4482,23 @@ process to set up. VEC specifies the connection." old-uname (tramp-set-connection-property vec "uname" - (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))) - (when (and (stringp old-uname) (not (string-equal old-uname uname))) + (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))) + (config-check-function + (tramp-get-method-parameter vec 'tramp-config-check)) + (old-config-check + (and config-check-function + (tramp-get-connection-property vec "config-check-data"))) + (config-check + (and config-check-function + ;; If we are in `make-process', we don't need to recompute. + (if (and old-config-check + (tramp-get-connection-property vec "process-name")) + old-config-check + (tramp-set-connection-property + vec "config-check-data" + (tramp-compat-funcall config-check-function vec)))))) + (when (and (stringp old-uname) (stringp uname) + (not (string-equal old-uname uname))) (tramp-message vec 3 "Connection reset, because remote host changed from `%s' to `%s'" @@ -4490,6 +4506,15 @@ process to set up. VEC specifies the connection." ;; We want to keep the password. (tramp-cleanup-connection vec t t) (throw 'uname-changed (tramp-maybe-open-connection vec))) + (when (and (stringp old-config-check) (stringp config-check) + (not (string-equal old-config-check config-check))) + (tramp-message + vec 3 + "Connection reset, because remote configuration changed from `%s' to `%s'" + old-config-check config-check) + ;; We want to keep the password. + (tramp-cleanup-connection vec t t) + (throw 'uname-changed (tramp-maybe-open-connection vec))) ;; Try to set up the coding system correctly. ;; CCC this can't be the right way to do it. Hm. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c06adb01e8..63f313dc50 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -281,6 +281,13 @@ pair of the form (KEY VALUE). The following KEYs are defined: Until now, just \"ssh\"-based, \"sshfs\"-based and \"adb\"-based methods do. + * `tramp-config-check' + A function to be called with one argument, VEC. It should + return a string which is used to check, whether the + configuration of the remote host has been changed (which + would require to flush the cache data). This string is kept + as connection property \"config-check-data\". + * `tramp-copy-program' This specifies the name of the program to use for remotely copying the file; this might be the absolute filename of scp or the name of commit 8c3b8c36677eedfc3839488e3cef9f6a5937baa3 Author: Robert Pluim Date: Tue Oct 25 15:18:51 2022 +0200 Fix eglot defcustom types * lisp/progmodes/eglot.el (eglot-autoreconnect): Allow for 'nil'. (eglot-connect-timeout): Allow for 'nil' and add descriptions. (eglot-sync-connect): Split boolean into 'nil' and 't' and add descriptions. (eglot-confirm-server-initiated-edits): Change 'symbol' type to 'const'. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 662c233f30..201fafb671 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -323,13 +323,15 @@ never reconnect automatically after unexpected server shutdowns, crashes or network failures. A positive integer number says to only autoreconnect if the previous successful connection attempt lasted more than that many seconds." - :type '(choice (boolean :tag "Whether to inhibit autoreconnection") + :type '(choice (const :tag "Reconnect automatically" t) + (const :tag "Never reconnect" nil) (integer :tag "Number of seconds"))) (defcustom eglot-connect-timeout 30 "Number of seconds before timing out LSP connection attempts. If nil, never time out." - :type 'number) + :type '(choice (number :tag "Number of seconds") + (const :tag "Never time out" nil))) (defcustom eglot-sync-connect 3 "Control blocking of LSP connection attempts. @@ -337,8 +339,9 @@ If t, block for `eglot-connect-timeout' seconds. A positive integer number means block for that many seconds, and then wait for the connection in the background. nil has the same meaning as 0, i.e. don't block at all." - :type '(choice (boolean :tag "Whether to inhibit autoreconnection") - (integer :tag "Number of seconds"))) + :type '(choice (const :tag "Block for `eglot-connect-timeout' seconds" t) + (const :tag "Never block" nil) + (integer :tag "Number of seconds to block"))) (defcustom eglot-autoshutdown nil "If non-nil, shut down server after killing last managed buffer." @@ -363,7 +366,7 @@ done by `eglot-reconnect'." (defcustom eglot-confirm-server-initiated-edits 'confirm "Non-nil if server-initiated edits should be confirmed with user." :type '(choice (const :tag "Don't show confirmation prompt" nil) - (symbol :tag "Show confirmation prompt" 'confirm))) + (const :tag "Show confirmation prompt" confirm))) (defcustom eglot-extend-to-xref nil "If non-nil, activate Eglot in cross-referenced non-project files." commit 1e1be54156108a25ba78ca4268af3113945d574e Author: Alan Mackenzie Date: Tue Oct 25 13:28:57 2022 +0000 Test face name variables are bound before using them in cc-fonts.el This fixes bug #58641. Also, set c-reference-face-name to font-lock-constant face in preference to c-label-face-name. * lisp/progmodes/cc-fonts.el (c-preprocessor-face-name, c-label-face-name) (c-constant-face-name, c-reference-face-name): Test variables with the same name as font-lock faces are bound before accessing their values. (c-reference-face-name): Use font-lock-constant face in preference to c-label-face-name. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index aa16da7070..5bb3e2e0b4 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1,4 +1,4 @@ -;;; cc-fonts.el --- font lock support for CC Mode -*- lexical-binding: t -*- +;; cc-fonts.el --- font lock support for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 2002-2022 Free Software Foundation, Inc. @@ -115,6 +115,7 @@ ;; used for preprocessor directives. 'font-lock-builtin-face) ((and (c-face-name-p 'font-lock-reference-face) + (boundp 'font-lock-reference-face) (eq font-lock-reference-face 'font-lock-reference-face)) 'font-lock-reference-face) (t 'font-lock-constant-face))) @@ -128,6 +129,7 @@ ;; suite.) 'font-lock-label-face) ((and (c-face-name-p 'font-lock-constant-face) + (boundp 'font-lock-constant-face) (eq font-lock-constant-face 'font-lock-constant-face)) ;; Test both if font-lock-constant-face exists and that it's ;; not an alias for something else. This is important since @@ -138,20 +140,24 @@ (defconst c-constant-face-name (if (and (c-face-name-p 'font-lock-constant-face) + (boundp 'font-lock-constant-face) (eq font-lock-constant-face 'font-lock-constant-face)) ;; This doesn't exist in some earlier versions of XEmacs 21. 'font-lock-constant-face c-label-face-name)) (defconst c-reference-face-name - (with-no-warnings - (if (and (c-face-name-p 'font-lock-reference-face) - (eq font-lock-reference-face 'font-lock-reference-face)) - ;; This is considered obsolete in Emacs, but it still maps well - ;; to this use. (Another reason to do this is to get unique - ;; faces for the test suite.) - 'font-lock-reference-face - c-label-face-name))) + (cond + ((and (c-face-name-p 'font-lock-reference-face) + (boundp 'font-lock-reference-face) + (eq font-lock-reference-face 'font-lock-reference-face)) + ;; This is considered obsolete in Emacs, but it still maps well + ;; to this use. (Another reason to do this is to get unique + ;; faces for the test suite.) + 'font-lock-reference-face) + ((c-face-name-p 'font-lock-constant-face) + 'font-lock-constant-face) + (t c-label-face-name))) ;; This should not mapped to a face that also is used to fontify things ;; that aren't comments or string literals. @@ -586,7 +592,8 @@ stuff. Used on level 1 and higher." (c-lang-const c-opt-cpp-macro-define) (c-lang-const c-nonempty-syntactic-ws) "\\(" (c-lang-const ; 1 + ncle + nsws - c-symbol-key) "\\)" + c-symbol-key) + "\\)" (concat "\\(" ; 2 + ncle + nsws + c-sym-key ;; Macro with arguments - a "function". "\\((\\)" ; 3 + ncle + nsws + c-sym-key commit 5b90a718ee6674544f892aa572ff042c1ae2a21f Author: Robert Pluim Date: Tue Oct 25 15:15:34 2022 +0200 * lisp/progmodes/eglot.el: Remove not very funny joke. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index a28df6c2d5..662c233f30 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -81,7 +81,8 @@ ;; in place during Eglot's LSP-enriched tenure over a project. Even ;; so, some of those decisions will invariably aggravate a minority ;; of Emacs power users, but these users can use `eglot-stay-out-of' -;; and `eglot-managed-mode-hook' to quench their OCD. +;; and `eglot-managed-mode-hook' to adjust things to their +;; preferences. ;; ;; * On occasion, to enable new features, Eglot can have soft ;; dependencies on popular libraries that are not in Emacs core. commit 92ec31a48c7fa2a700eb3a5c618fe015843e6875 Merge: 095dadf277 b6097fe279 Author: Eli Zaretskii Date: Tue Oct 25 14:59:39 2022 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 095dadf27781b5f7916db0b5d669d7ced8f76d7e Author: Lin Sun Date: Sat Oct 22 00:00:06 2022 +0000 lisp.h: Remove unnecessary preprocessor conditions This removes the HAVE_PDUMPER || HAVE_UNEXEC condition of gflags.will_dump_, which gets in the way when Emacs is built without any dumping method. (Bug#58708) diff --git a/src/lisp.h b/src/lisp.h index 5f6721595c..1eed323133 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -643,10 +643,8 @@ extern bool initialized; extern struct gflags { /* True means this Emacs instance was born to dump. */ -#if defined HAVE_PDUMPER || defined HAVE_UNEXEC bool will_dump_ : 1; bool will_bootstrap_ : 1; -#endif #ifdef HAVE_PDUMPER /* Set in an Emacs process that will likely dump with pdumper; all Emacs processes may dump with pdumper, however. */ commit b6097fe279b03e2fb50fc6af063d7c8f1e55fe8b Author: Po Lu Date: Tue Oct 25 19:50:57 2022 +0800 Fix drag-and-drop bugs on Lucid build Also, optimize Fx_translate_coordinates to avoid excessive calls to _XReply. * lisp/x-dnd.el (x-dnd-get-drop-rectangle): Return empty drop rectangle if posn-area. * src/xfns.c (Fx_translate_coordinates): Accept arg `require_child'. If not set, allow optimizations based on cached position data. * src/xselect.c (x_handle_dnd_message): Use x_translate_coordinates. * src/xterm.c (x_translate_coordinates): Export function. (x_handle_translate_coordinates): New function. (handle_one_xevent): Fix coding style. * src/xterm.h: Update prototypes. diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index ee80e41a22..058ab99f5c 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -675,7 +675,15 @@ with coordinates relative to the root window." (defun x-dnd-get-drop-rectangle (window posn) "Return the drag-and-drop rectangle at POSN on WINDOW." (if (or dnd-scroll-margin - (not (windowp window))) + (not (windowp window)) + ;; Drops on the scroll bar aren't allowed, but the mouse + ;; rectangle can be set while still on the scroll bar, + ;; causing the drag initiator to never send an XdndPosition + ;; event that will an XdndStatus message with the accept + ;; flag set to be set, even after the mouse enters the + ;; window text area. To prevent that, simply don't generate + ;; a mouse rectangle when an area is set. + (posn-area posn)) '(0 0 0 0) (let ((window-rectangle (x-dnd-get-window-rectangle window)) object-rectangle) diff --git a/src/xfns.c b/src/xfns.c index e8732986eb..3ff7a8c286 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -7913,7 +7913,7 @@ Otherwise, the return value is a vector with the following fields: DEFUN ("x-translate-coordinates", Fx_translate_coordinates, Sx_translate_coordinates, - 1, 5, 0, doc: /* Translate coordinates from FRAME. + 1, 6, 0, doc: /* Translate coordinates from FRAME. Translate the given coordinates SOURCE-X and SOURCE-Y from SOURCE-WINDOW's coordinate space to that of DEST-WINDOW, on FRAME. @@ -7929,16 +7929,21 @@ Return a list of (X Y CHILD) if the given coordinates are on the same screen, or nil otherwise, where X and Y are the coordinates in DEST-WINDOW's coordinate space, and CHILD is the window ID of any mapped child in DEST-WINDOW at those coordinates, or nil if there is -no such window. */) +no such window. If REQUIRE-CHILD is nil, avoid fetching CHILD if it +would result in an avoidable request to the X server, thereby +improving performance when the X connection is over a slow network. +Otherwise, always obtain the mapped child window from the X +server. */) (Lisp_Object frame, Lisp_Object source_window, Lisp_Object dest_window, Lisp_Object source_x, - Lisp_Object source_y) + Lisp_Object source_y, Lisp_Object require_child) { struct x_display_info *dpyinfo; struct frame *source_frame; int dest_x, dest_y; Window child_return, src, dest; Bool rc; + Lisp_Object temp_result; dpyinfo = check_x_display_info (frame); dest_x = 0; @@ -7956,6 +7961,8 @@ no such window. */) dest_y = XFIXNUM (source_y); } + source_frame = NULL; + if (!NILP (source_window)) CONS_TO_INTEGER (source_window, Window, src); else @@ -7964,6 +7971,17 @@ no such window. */) src = FRAME_X_WINDOW (source_frame); } + /* If require_child is nil, try to avoid an avoidable roundtrip to + the X server. */ + if (NILP (require_child) && source_frame) + { + temp_result + = x_handle_translate_coordinates (source_frame, dest_window, dest_x, + dest_y); + if (!NILP (temp_result)) + return temp_result; + } + if (!src) src = dpyinfo->root_window; diff --git a/src/xselect.c b/src/xselect.c index 498c28af53..db5c7853e7 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -2787,7 +2787,6 @@ x_handle_dnd_message (struct frame *f, const XClientMessageEvent *event, unsigned char *data = (unsigned char *) event->data.b; int idata[5]; ptrdiff_t i; - Window child_return; for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i) if (dpyinfo->x_dnd_atoms[i] == event->message_type) break; @@ -2822,11 +2821,7 @@ x_handle_dnd_message (struct frame *f, const XClientMessageEvent *event, if (!root_window_coords) x_relative_mouse_position (f, &x, &y); else - XTranslateCoordinates (dpyinfo->display, - dpyinfo->root_window, - FRAME_X_WINDOW (f), - root_x, root_y, - &x, &y, &child_return); + x_translate_coordinates (f, root_x, root_y, &x, &y); bufp->kind = DRAG_N_DROP_EVENT; bufp->frame_or_window = frame; diff --git a/src/xterm.c b/src/xterm.c index 205c948c46..b061383a2e 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1143,7 +1143,6 @@ static Window x_get_window_below (Display *, Window, int, int, int *, int *); #ifndef USE_TOOLKIT_SCROLL_BARS static void x_scroll_bar_redraw (struct scroll_bar *); #endif -static void x_translate_coordinates (struct frame *, int, int, int *, int *); /* Global state maintained during a drag-and-drop operation. */ @@ -13658,7 +13657,7 @@ x_compute_root_window_offset (struct frame *f, int root_x, int root_y, many cases while handling events, which would otherwise result in slowdowns over slow network connections. */ -static void +void x_translate_coordinates (struct frame *f, int root_x, int root_y, int *x_out, int *y_out) { @@ -13731,6 +13730,31 @@ x_translate_coordinates_to_root (struct frame *f, int x, int y, } } +/* Do x-translate-coordinates, but try to avoid a roundtrip to the X + server at the cost of not returning `child', which most callers + have no reason to use. */ + +Lisp_Object +x_handle_translate_coordinates (struct frame *f, Lisp_Object dest_window, + int source_x, int source_y) +{ + if (NILP (dest_window)) + { + /* We are translating coordinates from a frame to the root + window. Avoid a roundtrip if possible by using cached + coordinates. */ + + if (!FRAME_X_OUTPUT (f)->window_offset_certain_p) + return Qnil; + + return list3 (make_fixnum (source_x + FRAME_X_OUTPUT (f)->root_x), + make_fixnum (source_y + FRAME_X_OUTPUT (f)->root_y), + Qnil); + } + + return Qnil; +} + /* The same, but for an XIDeviceEvent. */ #ifdef HAVE_XINPUT2 @@ -20826,7 +20850,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, event->xbutton.time); } else if (x_dnd_last_seen_window != None - && x_dnd_last_protocol_version != -1) + && x_dnd_last_protocol_version != -1) { x_dnd_pending_finish_target = x_dnd_last_seen_toplevel; x_dnd_waiting_for_finish_proto = x_dnd_last_protocol_version; diff --git a/src/xterm.h b/src/xterm.h index 2967d105ea..537cabc957 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1695,8 +1695,12 @@ extern void x_xr_apply_ext_clip (struct frame *, GC); extern void x_xr_reset_ext_clip (struct frame *); #endif +extern void x_translate_coordinates (struct frame *, int, int, int *, int *); extern void x_translate_coordinates_to_root (struct frame *, int, int, int *, int *); +extern Lisp_Object x_handle_translate_coordinates (struct frame *, Lisp_Object, + int, int); + extern Bool x_query_pointer (Display *, Window, Window *, Window *, int *, int *, int *, int *, unsigned int *); commit bb95e597a9adcba0080cba85b2270fdf80696b3a Author: Brian Leung Date: Mon Oct 24 20:46:41 2022 -0700 eglot-server-programs: Account for new ts-mode At the time of writing, this exists only in the unmerged tree-sitter branch. It is not harmful to include, however. * lisp/progmodes/eglot.el (eglot-server-programs): Add new major mode to be used with the typescript-language-server. (Bug#58769) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 9264a5b0f0..a28df6c2d5 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -187,7 +187,7 @@ chosen (interactively or automatically)." . ,(eglot-alternatives '("pylsp" "pyls" ("pyright-langserver" "--stdio") "jedi-language-server"))) ((js-json-mode json-mode) . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("json-languageserver" "--stdio")))) - ((js-mode typescript-mode) + ((js-mode ts-mode typescript-mode) . ("typescript-language-server" "--stdio")) (sh-mode . ("bash-language-server" "start")) ((php-mode phps-mode) commit 566e410287d9898f90c81131bfa8c85462fab55e Author: Brian Leung Date: Mon Oct 24 20:43:50 2022 -0700 eglot-server-programs: Account for new js-json-mode js-json-mode derives from js-mode, so this reordering is necessary to prevent js-mode's eglot server from starting if a user has something like this in their config: (add-to-hook 'js-json-mode #'eglot-ensure) (add-to-hook 'js-mode #'eglot-ensure) * lisp/progmodes/eglot.el (eglot-server-programs): Move the json-language-server info before the entry for js-mode, and add on js-json-mode. (Bug#58769) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 827a5e9848..9264a5b0f0 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -186,6 +186,7 @@ chosen (interactively or automatically)." (python-mode . ,(eglot-alternatives '("pylsp" "pyls" ("pyright-langserver" "--stdio") "jedi-language-server"))) + ((js-json-mode json-mode) . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("json-languageserver" "--stdio")))) ((js-mode typescript-mode) . ("typescript-language-server" "--stdio")) (sh-mode . ("bash-language-server" "start")) @@ -227,7 +228,6 @@ language-server/bin/php-language-server.php")) (zig-mode . ("zls")) (css-mode . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") ("css-languageserver" "--stdio")))) (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio")))) - (json-mode . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("json-languageserver" "--stdio")))) (dockerfile-mode . ("docker-langserver" "--stdio")) ((clojure-mode clojurescript-mode clojurec-mode) . ("clojure-lsp")) commit 72a94f91fd0570556ce770dc3a39e658f7588f7e Author: Robert Pluim Date: Tue Oct 25 10:54:22 2022 +0200 Improve the eglot info documentation * doc/misc/eglot.texi (Eglot and Buffers): Improve phrasing. (Eglot Commands): 'reference of' -> 'reference for' and a typo fix. (Eglot Variables): Add markup for values. (Customizing Eglot): Grammar fixes. (Troubleshooting Eglot): Improve text. diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 0d82239c58..cf9607e3b7 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -525,7 +525,7 @@ Emacs Development Environment (@pxref{EDE,,, emacs, GNU Emacs Manual}). @end itemize -Eglot uses the Emacs's project management infrastructure to figure out +Eglot uses Emacs's project management infrastructure to figure out which files and buffers belong to what project, so any kind of project supported by that infrastructure is automatically supported by Eglot. @@ -588,8 +588,8 @@ and also arranges for other Emacs features supported by Eglot (@pxref{Eglot Features}) to receive information from the language server, by changing the settings of these features. Unlike other minor-modes, this special minor mode is not activated manually by the -user, but automatically as result of starting an Eglot session for the -buffer. However, this minor mode provides a hook variable +user, but automatically, as the result of starting an Eglot session +for the buffer. However, this minor mode provides a hook variable @code{eglot-managed-mode-hook} that can be used to customize the Eglot management of the buffer. This hook is run both when the minor mode is turned on and when it's turned off; use the variable @@ -614,7 +614,7 @@ visiting the file. @section Eglot Commands @cindex commands, Eglot -This section provides a reference of the most commonly used Eglot +This section provides a reference for the most commonly used Eglot commands: @ftable @code @@ -672,7 +672,7 @@ communications with the language servers. @item M-x eglot-rename This command renames the program symbol (a.k.a.@: @dfn{identifier}) at point to another name. It prompts for the new name of the symbol, and -then modifies all the files in the project which arte managed by the +then modifies all the files in the project which are managed by the language server of the current buffer to implement the renaming. @item M-x eglot-format @@ -775,13 +775,13 @@ Request completion of the symbol at point. @section Eglot Variables @cindex variables, Eglot -This section provides a reference of the Eglot' user options. +This section provides a reference for the Eglot user options. @vtable @code @item eglot-autoreconnect This option controls the ability to reconnect automatically to the language server when Eglot detects that the server process terminated -unexpectedly. The default value 3 means to attempt reconnection only +unexpectedly. The default value @code{3} means to attempt reconnection only if the previous successful connection lasted for more than that number of seconds; a different positive value changes the minimal length of the connection to trigger reconnection. A value of @code{t} means @@ -798,10 +798,10 @@ out. The default is 30 seconds. This setting is mainly important for connections which are slow to establish. Whereas the variable @code{eglot-connect-timeout} controls how long to wait for, this variable controls whether to block Emacs's -user interface while waiting. The default value is 3; a positive +user interface while waiting. The default value is @code{3}; a positive value means block for that many seconds, then wait for the connection in the background. The value of @code{t} means block during the whole -waiting period. The value of @code{nil} or zero means don't block at +waiting period. The value of @code{nil} or @code{0} means don't block at all during the waiting period. @item eglot-events-buffer-size @@ -885,7 +885,7 @@ destination, customize the ElDoc variable @code{eldoc-display-functions}. @end itemize -For this reason, this manual describes only how to customize the +For this reason, this manual describes only how to customize Eglot's own operation, which mainly has to do with the server connections and the server features to be used by Eglot. @@ -919,12 +919,12 @@ A hook run after Eglot started or stopped managing a buffer. @vindex eglot-stay-out-of @item eglot-stay-out-of This variable's value lists Emacs features that Eglot shouldn't -automatically try to manage on user's behalf. It is useful, for +automatically try to manage on the user's behalf. It is useful, for example, when you need to use non-LSP Flymake or Company back-ends. -To have Eglot stay away of some Emacs feature, add that feature's +To have Eglot stay away from some Emacs feature, add that feature's symbol or a regexp that will match a symbol's name to the list: for example, the symbol @code{xref} to leave Xref alone, or the string -@samp{company} to stay away of your Company customizations. Here's an +@samp{company} to stay away from your Company customizations. Here's an example: @lisp @@ -949,7 +949,7 @@ tuning of per-project settings via the variable settings contained in this variable to each server for which such settings were defined in the variable. These settings are communicated to the server initially (upon establishing the -connection) or when the settings are changed, or in response to the +connection) or when the settings are changed, or in response to a configuration request from the server. In many cases, servers can be configured globally using a @@ -958,12 +958,12 @@ directory, which the language server reads. For example, the @command{pylsp} server for Python reads the file @file{~/.config/pycodestyle} and the @command{clangd} server reads the file @file{.clangd} anywhere in the current project's directory tree. -If possible, we recommend to use these configuration files that are +If possible, we recommend using those configuration files that are independent of Eglot and Emacs; they have the advantage that they will work with other LSP clients as well. If you do need to provide Emacs-specific configuration for a language -server, we recommend to define the appropriate value in the +server, we recommend defining the appropriate value in the @file{.dir-locals.el} file in the project's directory. The value of this variable should be a property list of the following format: @@ -1104,9 +1104,9 @@ sure to repeat the process after toggling @code{debug-on-error} on backtrace of the error that should also be attached to the bug report. @item -An explanation how to obtain and install the language server you used. -If possible, try to replicate the problem with the C/C@t{++} or Python -servers, as these are very easy to install. +An explanation of how to obtain, install, and configure the language +server you used. If possible, try to replicate the problem with the +C/C@t{++} or Python servers, as these are very easy to install. @item A description of how to setup the @emph{minimal} project (one or two commit 0b1eda215d32839c9f6281d20f8a347f34bb5ab5 Author: João Távora Date: Tue Oct 25 10:34:08 2022 +0100 Fix M-x eglot breakage due to typo * lisp/progmodes/eglot.el (eglot): Fix bug. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 432631691c..827a5e9848 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1078,7 +1078,7 @@ MANAGED-MAJOR-MODE, which matters to a minority of servers. INTERACTIVE is t if called interactively." (interactive (append (eglot--guess-contact t) '(t))) - (setq managed-major-mode (eglot--ensure-list managed-mode)) + (setq managed-major-mode (eglot--ensure-list managed-major-mode)) (let* ((current-server (eglot-current-server)) (live-p (and current-server (jsonrpc-running-p current-server)))) (if (and live-p commit 31945b6c3fcbdb6f242f0063811d2fb91e4520cd Author: Stephen Leake Date: Tue Oct 25 02:15:13 2022 -0700 * lisp/progmodes/eglot.el (eglot): Ensure managed-major-mode is a list diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 71001ba680..432631691c 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -229,7 +229,7 @@ language-server/bin/php-language-server.php")) (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio")))) (json-mode . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("json-languageserver" "--stdio")))) (dockerfile-mode . ("docker-langserver" "--stdio")) - ((clojure-mode clojurescript-mode clojurec-mode) + ((clojure-mode clojurescript-mode clojurec-mode) . ("clojure-lsp")) (csharp-mode . ("omnisharp" "-lsp")) (purescript-mode . ("purescript-language-server" "--stdio")) @@ -1078,6 +1078,7 @@ MANAGED-MAJOR-MODE, which matters to a minority of servers. INTERACTIVE is t if called interactively." (interactive (append (eglot--guess-contact t) '(t))) + (setq managed-major-mode (eglot--ensure-list managed-mode)) (let* ((current-server (eglot-current-server)) (live-p (and current-server (jsonrpc-running-p current-server)))) (if (and live-p @@ -2898,7 +2899,7 @@ for which LSP on-type-formatting should be requested." (defun eglot--hover-info (contents &optional _range) (mapconcat #'eglot--format-markup (if (vectorp contents) contents (list contents)) "\n")) - + (defun eglot--sig-info (sigs active-sig sig-help-active-param) (cl-loop for (sig . moresigs) on (append sigs nil) for i from 0