commit 9848ae17161828190cc0ba31e89ae54a2f08a2ef (HEAD, refs/remotes/origin/master) Author: João Távora Date: Fri Apr 7 23:00:44 2023 +0100 Eglot: fix problems after changes to eglot-imenu (bug#62718) * lisp/progmodes/eglot.el (eglot--imenu-SymbolInformation) (eglot--imenu-DocumentSymbol): Fix. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 99b3925f05f..6134ab9150c 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3247,7 +3247,8 @@ eglot--imenu-SymbolInformation (let ((elems (mapcar (eglot--lambda ((SymbolInformation) kind name location) (let ((reg (eglot--range-region - (plist-get location :range)))) + (plist-get location :range))) + (kind (alist-get kind eglot--symbol-kind-names))) (cons (propertize name 'breadcrumb-region reg 'breadcrumb-kind kind) @@ -3262,13 +3263,14 @@ eglot--imenu-DocumentSymbol "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)) + (kind (alist-get kind eglot--symbol-kind-names)) (name (propertize name 'breadcrumb-region reg 'breadcrumb-kind kind))) - (if children - (cons name - (mapcar (lambda (c) (apply #'dfs c)) children)) - (cons name (car reg)))))) + (if (seq-empty-p children) + (cons name (car reg)) + (cons name + (mapcar (lambda (c) (apply #'dfs c)) children)))))) (mapcar (lambda (s) (apply #'dfs s)) res))) (defun eglot-imenu () commit cc288a0e331d09e3e0aebcb83769a513ecad236f Author: João Távora Date: Fri Apr 7 22:47:15 2023 +0100 Eglot: version strings must start with numbers (bug#62718) Even though Eglot is a :core ELPA package and as such is on a different release cycle than Emacs proper, the version strings used in 'defcustom' and 'make-obsolete' must still follow the numeric format. * lisp/progmodes/eglot.el (eglot-report-progress): Adjust :version. (eglot-lsp-abiding-column) (eglot-current-column) (eglot-current-column-function) (eglot-move-to-current-column) (eglot-move-to-lsp-abiding-column) (eglot-move-to-column-function) (eglot-ignored-server-capabilites) (eglot-manual) (eglot--managed-mode-hook): Update "obsolete" spec. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 1328c03a979..99b3925f05f 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -403,7 +403,7 @@ eglot-report-progress If set to `messages', use *Messages* buffer, else use Eglot's mode line indicator." :type 'boolean - :version "Eglot 1.10") + :version "1.10") (defvar eglot-withhold-process-id nil "If non-nil, Eglot will not send the Emacs process id to the language server. @@ -1480,11 +1480,11 @@ eglot--request ;;; Encoding fever ;;; (define-obsolete-function-alias - 'eglot-lsp-abiding-column 'eglot-utf-16-linepos "Eglot 1.12") + 'eglot-lsp-abiding-column 'eglot-utf-16-linepos "1.12") (define-obsolete-function-alias - 'eglot-current-column 'eglot-utf-32-linepos "Eglot 1.12") + 'eglot-current-column 'eglot-utf-32-linepos "1.12") (define-obsolete-variable-alias - 'eglot-current-column-function 'eglot-current-linepos-function "Eglot 1.12") + '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. @@ -1525,11 +1525,11 @@ eglot--pos-to-lsp-position (funcall eglot-current-linepos-function))))) (define-obsolete-function-alias - 'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "Eglot 1.12") + '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 "Eglot 1.12") + '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 "Eglot 1.12") +'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. @@ -1681,7 +1681,7 @@ eglot--format-markup (string-trim (buffer-string)))))) (define-obsolete-variable-alias 'eglot-ignored-server-capabilites - 'eglot-ignored-server-capabilities "Eglot 1.8") + 'eglot-ignored-server-capabilities "1.8") (defcustom eglot-ignored-server-capabilities (list) "LSP server capabilities that Eglot could use, but won't. @@ -1989,7 +1989,7 @@ eglot--mouse-call (force-mode-line-update t))))))) (defun eglot-manual () "Read Eglot's manual." - (declare (obsolete info "Eglot 1.10")) + (declare (obsolete info "1.10")) (interactive) (info "(eglot)")) (easy-menu-define eglot-menu nil "Eglot" @@ -3758,7 +3758,7 @@ eglot-inlay-hints-mode ;;; (make-obsolete-variable 'eglot--managed-mode-hook - 'eglot-managed-mode-hook "Eglot 1.6") + 'eglot-managed-mode-hook "1.6") (provide 'eglot) commit 621e732ade0f3dc165498ebde4d55d5aacb05b56 Author: João Távora Date: Fri Apr 7 19:54:57 2023 +0100 Eglot: use Eglot versions, not Emacs's in obsolete specs * lisp/progmodes/eglot.el (eglot-report-progress): Adjust :version. (eglot-lsp-abiding-column) (eglot-current-column) (eglot-current-column-function) (eglot-move-to-current-column) (eglot-move-to-lsp-abiding-column) (eglot-move-to-column-function) (eglot-ignored-server-capabilites) (eglot-manual) (eglot--managed-mode-hook): Update "obsolete" spec. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 8e665e28a53..1328c03a979 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -403,7 +403,7 @@ eglot-report-progress If set to `messages', use *Messages* buffer, else use Eglot's mode line indicator." :type 'boolean - :version "29.1") + :version "Eglot 1.10") (defvar eglot-withhold-process-id nil "If non-nil, Eglot will not send the Emacs process id to the language server. @@ -1480,11 +1480,11 @@ eglot--request ;;; Encoding fever ;;; (define-obsolete-function-alias - 'eglot-lsp-abiding-column 'eglot-utf-16-linepos "29.1") + 'eglot-lsp-abiding-column 'eglot-utf-16-linepos "Eglot 1.12") (define-obsolete-function-alias - 'eglot-current-column 'eglot-utf-32-linepos "29.1") + 'eglot-current-column 'eglot-utf-32-linepos "Eglot 1.12") (define-obsolete-variable-alias - 'eglot-current-column-function 'eglot-current-linepos-function "29.1") + 'eglot-current-column-function 'eglot-current-linepos-function "Eglot 1.12") (defvar eglot-current-linepos-function #'eglot-utf-16-linepos "Function calculating position relative to line beginning. @@ -1525,11 +1525,11 @@ eglot--pos-to-lsp-position (funcall eglot-current-linepos-function))))) (define-obsolete-function-alias - 'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "29.1") + 'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "Eglot 1.12") (define-obsolete-function-alias - 'eglot-move-to-lsp-abiding-column 'eglot-move-to-utf-16-linepos "29.1") + 'eglot-move-to-lsp-abiding-column 'eglot-move-to-utf-16-linepos "Eglot 1.12") (define-obsolete-variable-alias -'eglot-move-to-column-function 'eglot-move-to-linepos-function "29.1") +'eglot-move-to-column-function 'eglot-move-to-linepos-function "Eglot 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. @@ -1681,7 +1681,7 @@ eglot--format-markup (string-trim (buffer-string)))))) (define-obsolete-variable-alias 'eglot-ignored-server-capabilites - 'eglot-ignored-server-capabilities "1.8") + 'eglot-ignored-server-capabilities "Eglot 1.8") (defcustom eglot-ignored-server-capabilities (list) "LSP server capabilities that Eglot could use, but won't. @@ -1988,8 +1988,8 @@ eglot--mouse-call (when update-mode-line (force-mode-line-update t))))))) -(defun eglot-manual () "Open documentation." - (declare (obsolete info "29.1")) +(defun eglot-manual () "Read Eglot's manual." + (declare (obsolete info "Eglot 1.10")) (interactive) (info "(eglot)")) (easy-menu-define eglot-menu nil "Eglot" @@ -3758,7 +3758,7 @@ eglot-inlay-hints-mode ;;; (make-obsolete-variable 'eglot--managed-mode-hook - 'eglot-managed-mode-hook "1.6") + 'eglot-managed-mode-hook "Eglot 1.6") (provide 'eglot) commit 6cc5fe77244b76f00ec680873087b17ca38f776f Author: João Távora Date: Fri Apr 7 19:45:28 2023 +0100 Eglot: require optional text-property-search.el Originally reported in https://github.com/joaotavora/eglot/discussions/1201. Also check for text-property-search-forward before using it, so we won't break on Emacs 26.3. At this point, better start relying on compat.el, I guess. * lisp/progmodes/eglot.el (eglot--format-markup): Check for text-property-search-forward. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index da7e53730e7..8e665e28a53 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -107,6 +107,7 @@ (require 'subr-x)) (require 'filenotify) (require 'ert) +(require 'text-property-search nil t) ;; These dependencies are also GNU ELPA core packages. Because of ;; bug#62576, since there is a risk that M-x package-install, despite @@ -1673,9 +1674,10 @@ eglot--format-markup (font-lock-ensure) (goto-char (point-min)) (let ((inhibit-read-only t)) - (while (setq match (text-property-search-forward 'invisible)) - (delete-region (prop-match-beginning match) - (prop-match-end match)))) + (when (fboundp 'text-property-search-forward) ;; FIXME: use compat + (while (setq match (text-property-search-forward 'invisible)) + (delete-region (prop-match-beginning match) + (prop-match-end match))))) (string-trim (buffer-string)))))) (define-obsolete-variable-alias 'eglot-ignored-server-capabilites commit 7239098ad436a10afddce117ab224189f6bd6b7f Author: João Távora Date: Fri Apr 7 19:40:27 2023 +0100 Eglot: be careful about gfm-view-mode read-only buffers Although in most situations this doesn't error, it's only because of the very wide binding of inhibit-read-only in jsonrpc--process-filter. That binding will soon be narrowed, so better not rely on it. Originally reported in https://github.com/joaotavora/eglot/discussions/1202. * lisp/progmodes/eglot.el (eglot--format-markup): Inhibit read-only before touching buffer potentially in gfm-view-mode. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index db57b122a94..da7e53730e7 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1672,9 +1672,10 @@ eglot--format-markup (ignore-errors (delay-mode-hooks (funcall mode))) (font-lock-ensure) (goto-char (point-min)) - (while (setq match (text-property-search-forward 'invisible)) - (delete-region (prop-match-beginning match) - (prop-match-end match))) + (let ((inhibit-read-only t)) + (while (setq match (text-property-search-forward 'invisible)) + (delete-region (prop-match-beginning match) + (prop-match-end match)))) (string-trim (buffer-string)))))) (define-obsolete-variable-alias 'eglot-ignored-server-capabilites commit 3aedd5c920560fe6456a860a900be40a35e850d2 Author: João Távora Date: Fri Apr 7 18:52:06 2023 +0100 ; Eglot: fix misplaced parenthesis in last commit to eglot-tests.el * test/lisp/progmodes/eglot-tests.el (eglot-test-eldoc-after-completions): Fix misplaced parenthesis. diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index aa0b71a3ae7..62e04539ebf 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -665,7 +665,7 @@ eglot-test-eldoc-after-completions (completion-at-point) (message (buffer-string)) (should (looking-back "fprintf(?")) - (unless (= (char-before) ?\()) (insert "()") (backward-char) + (unless (= (char-before) ?\() (insert "()") (backward-char)) (eglot--signal-textDocument/didChange) (should (string-match "^fprintf" (eglot--tests-force-full-eldoc)))))) commit 4489d89783b688c3ec2794cb1b676ffc31648bca Author: Mattias Engdegård Date: Fri Apr 7 19:19:58 2023 +0200 ; * test/src/comp-tests.el (61917-1): Underscore unused parameter. diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index c5e5b346adb..4682cac450e 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -536,7 +536,7 @@ 61917-1 "Verify we can compile calls to redefined primitives with dedicated byte-op code." (let (x - (f (lambda (fn &rest args) + (f (lambda (_fn &rest args) (setq comp-test-primitive-redefine-args args)))) (advice-add #'delete-region :around f) (unwind-protect commit 7c0c2b1bb539424af1bb72bd9caefedd66cfd3da Author: Mattias Engdegård Date: Fri Apr 7 16:29:32 2023 +0200 Remove useless unwind-protect forms, or make them useful as intended * lisp/imenu.el (imenu--generic-function): * lisp/mail/yenc.el (yenc-decode-region): * lisp/textmodes/table.el (table-recognize-region): * test/lisp/dired-tests.el (dired-test-directory-files): * test/lisp/hl-line-tests.el (hl-line-tests-sticky): Fix unwind-protect bracketing mistakes that caused the unwind code to be misplaced. * lisp/strokes.el (strokes-read-stroke): Fix a bracketing mistake that misplaced the unwind code, and another one that misplaced the else-clause of an `if` form. * test/lisp/gnus/mml-sec-tests.el (mml-secure-test-fixture): Fix a bracketing mistake that misplaced the unwind code, and remove superfluous condition-case. * lisp/mwheel.el (mouse-wheel-global-text-scale): * lisp/speedbar.el (speedbar-stealthy-updates) (speedbar-fetch-dynamic-etags): * lisp/emacs-lisp/edebug.el (edebug--recursive-edit): * lisp/emacs-lisp/package.el (package--read-pkg-desc): * lisp/cedet/semantic.el (semantic-refresh-tags-safe): * lisp/emulation/viper-cmd.el (viper-escape-to-state): * lisp/emulation/viper-cmd.el (viper-file-add-suffix): * lisp/gnus/mail-source.el (mail-source-movemail): * lisp/mail/feedmail.el (feedmail-send-it-immediately) (feedmail-deduce-address-list): * lisp/mail/mailclient.el (mailclient-send-it): * lisp/mail/smtpmail.el (smtpmail-deduce-address-list): * lisp/mh-e/mh-print.el (mh-ps-print-range): * lisp/textmodes/reftex-index.el (reftex-index-this-phrase): * test/lisp/emacs-lisp/ert-tests.el (ert-test-run-tests-batch): (ert-test-run-tests-batch-expensive): Remove unwind-protect forms that are apparently useless, some since a prior edit that removed their purpose, some since their first appearance. * test/lisp/subr-tests.el (subr-test--frames-2): Insert dummy unwind form in backtrace test code. diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 1c9228b0123..0c15a2a453e 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -618,21 +618,18 @@ semantic-refresh-tags-safe (lexically-safe t) ) - (unwind-protect - ;; Perform the parsing. - (progn - (when (semantic-lex-catch-errors safe-refresh - (save-excursion (semantic-fetch-tags)) - nil) - ;; If we are here, it is because the lexical step failed, - ;; probably due to unterminated lists or something like that. - - ;; We do nothing, and just wait for the next idle timer - ;; to go off. In the meantime, remember this, and make sure - ;; no other idle services can get executed. - (setq lexically-safe nil)) - ) - ) + ;; Perform the parsing. + (when (semantic-lex-catch-errors safe-refresh + (save-excursion (semantic-fetch-tags)) + nil) + ;; If we are here, it is because the lexical step failed, + ;; probably due to unterminated lists or something like that. + + ;; We do nothing, and just wait for the next idle timer + ;; to go off. In the meantime, remember this, and make sure + ;; no other idle services can get executed. + (setq lexically-safe nil)) + ;; Return if we are lexically safe lexically-safe)))) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 552526b6efc..9a06807bcdc 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2853,81 +2853,81 @@ edebug--recursive-edit edebug-inside-windows ) - (unwind-protect - (let ( - ;; Declare global values local but using the same global value. - ;; We could set these to the values for previous edebug call. - (last-command last-command) - (this-command this-command) - (current-prefix-arg nil) - - (last-input-event nil) - (last-command-event nil) - (last-event-frame nil) - (last-nonmenu-event nil) - (track-mouse nil) - - (standard-output t) - (standard-input t) - - ;; Don't keep reading from an executing kbd macro - ;; within edebug unless edebug-continue-kbd-macro is - ;; non-nil. Again, local binding may not be best. - (executing-kbd-macro - (if edebug-continue-kbd-macro executing-kbd-macro)) - - ;; Don't get confused by the user's keymap changes. - (overriding-local-map nil) - (overriding-terminal-local-map nil) - ;; Override other minor modes that may bind the keys - ;; edebug uses. - (minor-mode-overriding-map-alist - (list (cons 'edebug-mode edebug-mode-map))) - - ;; Bind again to outside values. - (debug-on-error edebug-outside-debug-on-error) - (debug-on-quit edebug-outside-debug-on-quit) - - ;; Don't keep defining a kbd macro. - (defining-kbd-macro - (if edebug-continue-kbd-macro defining-kbd-macro)) - - ;; others?? - ) - (if (and (eq edebug-execution-mode 'go) - (not (memq arg-mode '(after error)))) - (message "Break")) - - (setq signal-hook-function nil) - - (edebug-mode 1) - (unwind-protect - (recursive-edit) ; <<<<<<<<<< Recursive edit - - ;; Do the following, even if quit occurs. - (setq signal-hook-function #'edebug-signal) - (if edebug-backtrace-buffer - (kill-buffer edebug-backtrace-buffer)) - - ;; Remember selected-window after recursive-edit. - ;; (setq edebug-inside-window (selected-window)) - - (set-match-data edebug-outside-match-data) - - ;; Recursive edit may have changed buffers, - ;; so set it back before exiting let. - (if (buffer-name edebug-buffer) ; if it still exists - (progn - (set-buffer edebug-buffer) - (when (memq edebug-execution-mode '(go Go-nonstop)) - (edebug-overlay-arrow) - (sit-for 0)) - (edebug-mode -1)) - ;; gotta have a buffer to let its buffer local variables be set - (get-buffer-create " bogus edebug buffer")) - ));; inner let - ))) + (let ( + ;; Declare global values local but using the same global value. + ;; We could set these to the values for previous edebug call. + (last-command last-command) + (this-command this-command) + (current-prefix-arg nil) + + (last-input-event nil) + (last-command-event nil) + (last-event-frame nil) + (last-nonmenu-event nil) + (track-mouse nil) + + (standard-output t) + (standard-input t) + + ;; Don't keep reading from an executing kbd macro + ;; within edebug unless edebug-continue-kbd-macro is + ;; non-nil. Again, local binding may not be best. + (executing-kbd-macro + (if edebug-continue-kbd-macro executing-kbd-macro)) + + ;; Don't get confused by the user's keymap changes. + (overriding-local-map nil) + (overriding-terminal-local-map nil) + ;; Override other minor modes that may bind the keys + ;; edebug uses. + (minor-mode-overriding-map-alist + (list (cons 'edebug-mode edebug-mode-map))) + + ;; Bind again to outside values. + (debug-on-error edebug-outside-debug-on-error) + (debug-on-quit edebug-outside-debug-on-quit) + + ;; Don't keep defining a kbd macro. + (defining-kbd-macro + (if edebug-continue-kbd-macro defining-kbd-macro)) + + ;; others?? + ) + + (if (and (eq edebug-execution-mode 'go) + (not (memq arg-mode '(after error)))) + (message "Break")) + + (setq signal-hook-function nil) + + (edebug-mode 1) + (unwind-protect + (recursive-edit) ; <<<<<<<<<< Recursive edit + + ;; Do the following, even if quit occurs. + (setq signal-hook-function #'edebug-signal) + (if edebug-backtrace-buffer + (kill-buffer edebug-backtrace-buffer)) + + ;; Remember selected-window after recursive-edit. + ;; (setq edebug-inside-window (selected-window)) + + (set-match-data edebug-outside-match-data) + + ;; Recursive edit may have changed buffers, + ;; so set it back before exiting let. + (if (buffer-name edebug-buffer) ; if it still exists + (progn + (set-buffer edebug-buffer) + (when (memq edebug-execution-mode '(go Go-nonstop)) + (edebug-overlay-arrow) + (sit-for 0)) + (edebug-mode -1)) + ;; gotta have a buffer to let its buffer local variables be set + (get-buffer-create " bogus edebug buffer")) + ));; inner let + )) ;;; Display related functions diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 0258ed52bee..685f983e285 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1218,15 +1218,14 @@ package--read-pkg-desc "Read a `define-package' form in current buffer. Return the pkg-desc, with desc-kind set to KIND." (goto-char (point-min)) - (unwind-protect - (let* ((pkg-def-parsed (read (current-buffer))) - (pkg-desc - (when (eq (car pkg-def-parsed) 'define-package) - (apply #'package-desc-from-define - (append (cdr pkg-def-parsed)))))) - (when pkg-desc - (setf (package-desc-kind pkg-desc) kind) - pkg-desc)))) + (let* ((pkg-def-parsed (read (current-buffer))) + (pkg-desc + (when (eq (car pkg-def-parsed) 'define-package) + (apply #'package-desc-from-define + (append (cdr pkg-def-parsed)))))) + (when pkg-desc + (setf (package-desc-kind pkg-desc) kind) + pkg-desc))) (declare-function tar-get-file-descriptor "tar-mode" (file)) (declare-function tar--extract "tar-mode" (descriptor)) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 2a37c383f81..c0aa9dd7b46 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -722,16 +722,12 @@ viper-escape-to-state (let (viper-vi-kbd-minor-mode viper-insert-kbd-minor-mode viper-emacs-kbd-minor-mode) - (unwind-protect - (progn - (setq com - (key-binding (setq key (read-key-sequence nil)))) - ;; In case of binding indirection--chase definitions. - ;; Have to do it here because we execute this command under - ;; different keymaps, so command-execute may not do the - ;; right thing there - (while (vectorp com) (setq com (key-binding com)))) - nil) + (setq com (key-binding (setq key (read-key-sequence nil)))) + ;; In case of binding indirection--chase definitions. + ;; Have to do it here because we execute this command under + ;; different keymaps, so command-execute may not do the + ;; right thing there + (while (vectorp com) (setq com (key-binding com))) ;; Execute command com in the original Viper state, not in state ;; `state'. Otherwise, if we switch buffers while executing the ;; escaped to command, Viper's mode vars will remain those of @@ -1950,16 +1946,16 @@ viper-file-add-suffix (if found () (viper-tmp-insert-at-eob " [Please complete file name]") - (unwind-protect - (while (not (memq cmd - '(exit-minibuffer viper-exit-minibuffer))) - (setq cmd - (key-binding (setq key (read-key-sequence nil)))) - (cond ((eq cmd 'self-insert-command) - (insert key)) - ((memq cmd '(exit-minibuffer viper-exit-minibuffer)) - nil) - (t (command-execute cmd)))))))))) + + (while (not (memq cmd + '(exit-minibuffer viper-exit-minibuffer))) + (setq cmd + (key-binding (setq key (read-key-sequence nil)))) + (cond ((eq cmd 'self-insert-command) + (insert key)) + ((memq cmd '(exit-minibuffer viper-exit-minibuffer)) + nil) + (t (command-execute cmd))))))))) (defun viper-minibuffer-trim-tail () diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 639a29582b3..582c598ac22 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -658,50 +658,49 @@ mail-source-movemail ;; If getting from mail spool directory, use movemail to move ;; rather than just renaming, so as to interlock with the ;; mailer. - (unwind-protect - (save-excursion - (setq errors (generate-new-buffer " *mail source loss*")) - (let ((default-directory "/")) - (setq result - ;; call-process looks in exec-path, which - ;; contains exec-directory, so will find - ;; Mailutils movemail if it exists, else it will - ;; find "our" movemail in exec-directory. - ;; Bug#31737 - (apply - #'call-process - (append - (list - mail-source-movemail-program - nil errors nil from to))))) - (when (file-exists-p to) - (set-file-modes to mail-source-default-file-modes 'nofollow)) - (if (and (or (not (buffer-modified-p errors)) - (zerop (buffer-size errors))) - (and (numberp result) - (zerop result))) - ;; No output => movemail won. - t - (set-buffer errors) - ;; There may be a warning about older revisions. We - ;; ignore that. - (goto-char (point-min)) - (if (search-forward "older revision" nil t) - t - ;; Probably a real error. - (subst-char-in-region (point-min) (point-max) ?\n ?\ ) - (goto-char (point-max)) - (skip-chars-backward " \t") - (delete-region (point) (point-max)) - (goto-char (point-min)) - (when (looking-at "movemail: ") - (delete-region (point-min) (match-end 0))) - ;; Result may be a signal description string. - (unless (yes-or-no-p - (format "movemail: %s (%s return). Continue? " - (buffer-string) result)) - (error "%s" (buffer-string))) - (setq to nil))))))) + (save-excursion + (setq errors (generate-new-buffer " *mail source loss*")) + (let ((default-directory "/")) + (setq result + ;; call-process looks in exec-path, which + ;; contains exec-directory, so will find + ;; Mailutils movemail if it exists, else it will + ;; find "our" movemail in exec-directory. + ;; Bug#31737 + (apply + #'call-process + (append + (list + mail-source-movemail-program + nil errors nil from to))))) + (when (file-exists-p to) + (set-file-modes to mail-source-default-file-modes 'nofollow)) + (if (and (or (not (buffer-modified-p errors)) + (zerop (buffer-size errors))) + (and (numberp result) + (zerop result))) + ;; No output => movemail won. + t + (set-buffer errors) + ;; There may be a warning about older revisions. We + ;; ignore that. + (goto-char (point-min)) + (if (search-forward "older revision" nil t) + t + ;; Probably a real error. + (subst-char-in-region (point-min) (point-max) ?\n ?\ ) + (goto-char (point-max)) + (skip-chars-backward " \t") + (delete-region (point) (point-max)) + (goto-char (point-min)) + (when (looking-at "movemail: ") + (delete-region (point-min) (match-end 0))) + ;; Result may be a signal description string. + (unless (yes-or-no-p + (format "movemail: %s (%s return). Continue? " + (buffer-string) result)) + (error "%s" (buffer-string))) + (setq to nil)))))) (when (buffer-live-p errors) (kill-buffer errors)) ;; Return whether we moved successfully or not. diff --git a/lisp/imenu.el b/lisp/imenu.el index fd23a65c7b3..c51824b7ef3 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -674,8 +674,8 @@ imenu--generic-function (cons item (cdr menu))))) ;; Go to the start of the match, to make sure we ;; keep making progress backwards. - (goto-char start)))) - (set-syntax-table old-table))) + (goto-char start))))) + (set-syntax-table old-table)) ;; Sort each submenu by position. ;; This is in case one submenu gets items from two different regexps. (dolist (item index-alist) diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 97d20cca151..165aafae1f7 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -2511,22 +2511,20 @@ feedmail-send-it-immediately feedmail-force-binary-write) 'no-conversion coding-system-for-write))) - (unwind-protect - (progn - (insert fcc) - (unless feedmail-nuke-bcc-in-fcc - (if bcc-holder (insert bcc-holder)) - (if resent-bcc-holder - (insert resent-bcc-holder))) - - (run-hooks 'feedmail-before-fcc-hook) - - (when feedmail-nuke-body-in-fcc - (goto-char eoh-marker) - (if (natnump feedmail-nuke-body-in-fcc) - (forward-line feedmail-nuke-body-in-fcc)) - (delete-region (point) (point-max))) - (mail-do-fcc eoh-marker)))))) + (insert fcc) + (unless feedmail-nuke-bcc-in-fcc + (if bcc-holder (insert bcc-holder)) + (if resent-bcc-holder + (insert resent-bcc-holder))) + + (run-hooks 'feedmail-before-fcc-hook) + + (when feedmail-nuke-body-in-fcc + (goto-char eoh-marker) + (if (natnump feedmail-nuke-body-in-fcc) + (forward-line feedmail-nuke-body-in-fcc)) + (delete-region (point) (point-max))) + (mail-do-fcc eoh-marker)))) ;; User bailed out of one-last-look. (if feedmail-queue-runner-is-active (throw 'skip-me-q 'skip-me-q) @@ -3046,30 +3044,30 @@ feedmail-deduce-address-list (address-blob) (this-line) (this-line-end)) - (unwind-protect - (with-current-buffer (get-buffer-create " *FQM scratch*") - (erase-buffer) - (insert-buffer-substring message-buffer header-start header-end) - (goto-char (point-min)) - (let ((case-fold-search t)) - (while (re-search-forward addr-regexp (point-max) t) - (replace-match "") - (setq this-line (match-beginning 0)) - (forward-line 1) - ;; get any continuation lines - (while (and (looking-at "^[ \t]+") (< (point) (point-max))) - (forward-line 1)) - (setq this-line-end (point-marker)) - ;; only keep if we don't have it already - (setq address-blob - (mail-strip-quoted-names (buffer-substring-no-properties this-line this-line-end))) - (while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob) - (setq simple-address (substring address-blob (match-beginning 2) (match-end 2))) - (setq address-blob (replace-match "" t t address-blob)) - (if (not (member simple-address address-list)) - (push simple-address address-list))) - )) - (kill-buffer nil))) + + (with-current-buffer (get-buffer-create " *FQM scratch*") + (erase-buffer) + (insert-buffer-substring message-buffer header-start header-end) + (goto-char (point-min)) + (let ((case-fold-search t)) + (while (re-search-forward addr-regexp (point-max) t) + (replace-match "") + (setq this-line (match-beginning 0)) + (forward-line 1) + ;; get any continuation lines + (while (and (looking-at "^[ \t]+") (< (point) (point-max))) + (forward-line 1)) + (setq this-line-end (point-marker)) + ;; only keep if we don't have it already + (setq address-blob + (mail-strip-quoted-names (buffer-substring-no-properties this-line this-line-end))) + (while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob) + (setq simple-address (substring address-blob (match-beginning 2) (match-end 2))) + (setq address-blob (replace-match "" t t address-blob)) + (if (not (member simple-address address-list)) + (push simple-address address-list))) + )) + (kill-buffer nil)) (identity address-list))) diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el index 21ddef4b0fd..613541e5dc4 100644 --- a/lisp/mail/mailclient.el +++ b/lisp/mail/mailclient.el @@ -111,104 +111,103 @@ mailclient-send-it (let ((case-fold-search nil) delimline (mailbuf (current-buffer))) - (unwind-protect - (with-temp-buffer - (insert-buffer-substring mailbuf) - ;; Move to header delimiter - (mail-sendmail-undelimit-header) - (setq delimline (point-marker)) - (if mail-aliases - (expand-mail-aliases (point-min) delimline)) - (goto-char (point-min)) - ;; ignore any blank lines in the header - (while (and (re-search-forward "\n\n\n*" delimline t) - (< (point) delimline)) - (replace-match "\n")) - (let ((case-fold-search t) - (mime-charset-pattern - (concat - "^content-type:[ \t]*text/plain;" - "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*" - "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?")) - coding-system - character-coding - ;; Use the external browser function to send the - ;; message. - (browse-url-default-handlers nil)) - ;; initialize limiter - (setq mailclient-delim-static "?") - ;; construct and call up mailto URL - (browse-url + (with-temp-buffer + (insert-buffer-substring mailbuf) + ;; Move to header delimiter + (mail-sendmail-undelimit-header) + (setq delimline (point-marker)) + (if mail-aliases + (expand-mail-aliases (point-min) delimline)) + (goto-char (point-min)) + ;; ignore any blank lines in the header + (while (and (re-search-forward "\n\n\n*" delimline t) + (< (point) delimline)) + (replace-match "\n")) + (let ((case-fold-search t) + (mime-charset-pattern (concat - (save-excursion - (narrow-to-region (point-min) delimline) - ;; We can't send multipart/* messages (i. e. with - ;; attachments or the like) via this method. - (when-let ((type (mail-fetch-field "content-type"))) - (when (and (string-match "multipart" - (car (mail-header-parse-content-type - type))) - (not (y-or-n-p "Message with attachments can't be sent via mailclient; continue anyway?"))) - (error "Choose a different `send-mail-function' to send attachments"))) - (goto-char (point-min)) - (setq coding-system - (if (re-search-forward mime-charset-pattern nil t) - (coding-system-from-name (match-string 1)) - 'undecided)) - (setq character-coding - (mail-fetch-field "content-transfer-encoding")) - (when character-coding - (setq character-coding (downcase character-coding))) - (concat - "mailto:" - ;; Some of the headers according to RFC 822 (or later). - (mailclient-gather-addresses "To" - 'drop-first-name) - (mailclient-gather-addresses "cc" ) - (mailclient-gather-addresses "bcc" ) - (mailclient-gather-addresses "Resent-To" ) - (mailclient-gather-addresses "Resent-cc" ) - (mailclient-gather-addresses "Resent-bcc" ) - (mailclient-gather-addresses "Reply-To" ) - ;; The From field is not honored for now: it's - ;; not necessarily configured. The mail client - ;; knows the user's address(es) - ;; (mailclient-gather-addresses "From" ) - ;; subject line - (let ((subj (mail-fetch-field "Subject" nil t))) - (widen) ;; so we can read the body later on - (if subj ;; if non-blank - ;; the mail client will deal with - ;; warning the user etc. - (concat (mailclient-url-delim) "subject=" - (mailclient-encode-string-as-url subj)) - "")))) - ;; body - (mailclient-url-delim) "body=" - (progn - (delete-region (point-min) delimline) - (unless (null character-coding) - ;; mailto: and clipboard need UTF-8 and cannot deal with - ;; Content-Transfer-Encoding or Content-Type. - ;; FIXME: There is code duplication here with rmail.el. - (set-buffer-multibyte nil) - (cond - ((string= character-coding "base64") - (base64-decode-region (point-min) (point-max))) - ((string= character-coding "quoted-printable") - (mail-unquote-printable-region (point-min) (point-max) - nil nil t)) - (t (error "Unsupported Content-Transfer-Encoding: %s" - character-coding))) - (decode-coding-region (point-min) (point-max) coding-system)) - (mailclient-encode-string-as-url - (if mailclient-place-body-on-clipboard-flag - (progn - (clipboard-kill-ring-save (point-min) (point-max)) - (concat - "*** E-Mail body has been placed on clipboard, " - "please paste it here! ***")) - (buffer-string))))))))))) + "^content-type:[ \t]*text/plain;" + "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*" + "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?")) + coding-system + character-coding + ;; Use the external browser function to send the + ;; message. + (browse-url-default-handlers nil)) + ;; initialize limiter + (setq mailclient-delim-static "?") + ;; construct and call up mailto URL + (browse-url + (concat + (save-excursion + (narrow-to-region (point-min) delimline) + ;; We can't send multipart/* messages (i. e. with + ;; attachments or the like) via this method. + (when-let ((type (mail-fetch-field "content-type"))) + (when (and (string-match "multipart" + (car (mail-header-parse-content-type + type))) + (not (y-or-n-p "Message with attachments can't be sent via mailclient; continue anyway?"))) + (error "Choose a different `send-mail-function' to send attachments"))) + (goto-char (point-min)) + (setq coding-system + (if (re-search-forward mime-charset-pattern nil t) + (coding-system-from-name (match-string 1)) + 'undecided)) + (setq character-coding + (mail-fetch-field "content-transfer-encoding")) + (when character-coding + (setq character-coding (downcase character-coding))) + (concat + "mailto:" + ;; Some of the headers according to RFC 822 (or later). + (mailclient-gather-addresses "To" + 'drop-first-name) + (mailclient-gather-addresses "cc" ) + (mailclient-gather-addresses "bcc" ) + (mailclient-gather-addresses "Resent-To" ) + (mailclient-gather-addresses "Resent-cc" ) + (mailclient-gather-addresses "Resent-bcc" ) + (mailclient-gather-addresses "Reply-To" ) + ;; The From field is not honored for now: it's + ;; not necessarily configured. The mail client + ;; knows the user's address(es) + ;; (mailclient-gather-addresses "From" ) + ;; subject line + (let ((subj (mail-fetch-field "Subject" nil t))) + (widen) ;; so we can read the body later on + (if subj ;; if non-blank + ;; the mail client will deal with + ;; warning the user etc. + (concat (mailclient-url-delim) "subject=" + (mailclient-encode-string-as-url subj)) + "")))) + ;; body + (mailclient-url-delim) "body=" + (progn + (delete-region (point-min) delimline) + (unless (null character-coding) + ;; mailto: and clipboard need UTF-8 and cannot deal with + ;; Content-Transfer-Encoding or Content-Type. + ;; FIXME: There is code duplication here with rmail.el. + (set-buffer-multibyte nil) + (cond + ((string= character-coding "base64") + (base64-decode-region (point-min) (point-max))) + ((string= character-coding "quoted-printable") + (mail-unquote-printable-region (point-min) (point-max) + nil nil t)) + (t (error "Unsupported Content-Transfer-Encoding: %s" + character-coding))) + (decode-coding-region (point-min) (point-max) coding-system)) + (mailclient-encode-string-as-url + (if mailclient-place-body-on-clipboard-flag + (progn + (clipboard-kill-ring-save (point-min) (point-max)) + (concat + "*** E-Mail body has been placed on clipboard, " + "please paste it here! ***")) + (buffer-string)))))))))) (provide 'mailclient) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index f0aa0c6ecf5..78688d170cc 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -1068,52 +1068,51 @@ smtpmail-send-data (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) "Get address list suitable for smtp RCPT TO:
." - (unwind-protect - (with-current-buffer smtpmail-address-buffer - (erase-buffer) - (let ((case-fold-search t) - (simple-address-list "") - this-line - this-line-end - addr-regexp) - (insert-buffer-substring smtpmail-text-buffer header-start header-end) - (goto-char (point-min)) - ;; RESENT-* fields should stop processing of regular fields. - (save-excursion - (setq addr-regexp - (if (re-search-forward "^Resent-\\(To\\|Cc\\|Bcc\\):" - header-end t) - "^Resent-\\(To\\|Cc\\|Bcc\\):" - "^\\(To:\\|Cc:\\|Bcc:\\)"))) - - (while (re-search-forward addr-regexp header-end t) - (replace-match "") - (setq this-line (match-beginning 0)) - (forward-line 1) - ;; get any continuation lines - (while (and (looking-at "^[ \t]+") (< (point) header-end)) - (forward-line 1)) - (setq this-line-end (point-marker)) - (setq simple-address-list - (concat simple-address-list " " - (mail-strip-quoted-names (buffer-substring this-line this-line-end))))) - (erase-buffer) - (insert " " simple-address-list "\n") - (subst-char-in-region (point-min) (point-max) 10 ? t) ; newline --> blank - (subst-char-in-region (point-min) (point-max) ?, ? t) ; comma --> blank - (subst-char-in-region (point-min) (point-max) 9 ? t) ; tab --> blank + (with-current-buffer smtpmail-address-buffer + (erase-buffer) + (let ((case-fold-search t) + (simple-address-list "") + this-line + this-line-end + addr-regexp) + (insert-buffer-substring smtpmail-text-buffer header-start header-end) + (goto-char (point-min)) + ;; RESENT-* fields should stop processing of regular fields. + (save-excursion + (setq addr-regexp + (if (re-search-forward "^Resent-\\(To\\|Cc\\|Bcc\\):" + header-end t) + "^Resent-\\(To\\|Cc\\|Bcc\\):" + "^\\(To:\\|Cc:\\|Bcc:\\)"))) + + (while (re-search-forward addr-regexp header-end t) + (replace-match "") + (setq this-line (match-beginning 0)) + (forward-line 1) + ;; get any continuation lines + (while (and (looking-at "^[ \t]+") (< (point) header-end)) + (forward-line 1)) + (setq this-line-end (point-marker)) + (setq simple-address-list + (concat simple-address-list " " + (mail-strip-quoted-names (buffer-substring this-line this-line-end))))) + (erase-buffer) + (insert " " simple-address-list "\n") + (subst-char-in-region (point-min) (point-max) 10 ? t) ; newline --> blank + (subst-char-in-region (point-min) (point-max) ?, ? t) ; comma --> blank + (subst-char-in-region (point-min) (point-max) 9 ? t) ; tab --> blank - (goto-char (point-min)) - ;; tidiness in case hook is not robust when it looks at this - (while (re-search-forward "[ \t]+" header-end t) (replace-match " ")) + (goto-char (point-min)) + ;; tidiness in case hook is not robust when it looks at this + (while (re-search-forward "[ \t]+" header-end t) (replace-match " ")) - (goto-char (point-min)) - (let (recipient-address-list) - (while (re-search-forward " \\([^ ]+\\) " (point-max) t) - (backward-char 1) - (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1)) - recipient-address-list))) - (setq smtpmail-recipient-address-list recipient-address-list)))))) + (goto-char (point-min)) + (let (recipient-address-list) + (while (re-search-forward " \\([^ ]+\\) " (point-max) t) + (backward-char 1) + (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1)) + recipient-address-list))) + (setq smtpmail-recipient-address-list recipient-address-list))))) (defun smtpmail-do-bcc (header-end) "Delete [Resent-]Bcc: and their continuation lines from the header area. diff --git a/lisp/mail/yenc.el b/lisp/mail/yenc.el index de1e1ee283a..a836f5b71bd 100644 --- a/lisp/mail/yenc.el +++ b/lisp/mail/yenc.el @@ -111,8 +111,8 @@ yenc-decode-region (message "Warning: Size mismatch while decoding.")) (goto-char start) (delete-region start end) - (insert-buffer-substring work-buffer)))) - (and work-buffer (kill-buffer work-buffer)))))) + (insert-buffer-substring work-buffer))))) + (and work-buffer (kill-buffer work-buffer))))) ;;;###autoload (defun yenc-extract-filename () diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el index 76116010b33..eeea94a69e5 100644 --- a/lisp/mh-e/mh-print.el +++ b/lisp/mh-e/mh-print.el @@ -79,8 +79,7 @@ mh-ps-print-range This is the function that actually does the work. If FILE is nil, then the messages are spooled to the printer." (mh-iterate-on-range msg range - (unwind-protect - (mh-ps-spool-msg msg)) + (mh-ps-spool-msg msg) (mh-notate msg mh-note-printed mh-cmd-note)) (ps-despool file)) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 1be52d24e34..caa74159ecd 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -447,13 +447,12 @@ mouse-wheel-global-text-scale This invokes `global-text-scale-adjust', which see." (interactive (list last-input-event)) (let ((button (mwheel-event-button event))) - (unwind-protect - (cond ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) - (global-text-scale-adjust 1)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) - (global-text-scale-adjust -1)))))) + (cond ((memq button (list mouse-wheel-down-event + mouse-wheel-down-alternate-event)) + (global-text-scale-adjust 1)) + ((memq button (list mouse-wheel-up-event + mouse-wheel-up-alternate-event)) + (global-text-scale-adjust -1))))) (defun mouse-wheel--add-binding (key fun) "Bind mouse wheel button KEY to function FUN. diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 60113ca1410..29f351ca021 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -2591,13 +2591,12 @@ speedbar-stealthy-updates (if (not speedbar-stealthy-update-recurse) (let ((l (speedbar-initial-stealthy-functions)) (speedbar-stealthy-update-recurse t)) - (unwind-protect - (speedbar-with-writable - (while (and l (funcall (car l))) - ;;(sit-for 0) - (setq l (cdr l)))) - ;;(dframe-message "Exit with %S" (car l)) - )))) + (speedbar-with-writable + (while (and l (funcall (car l))) + ;;(sit-for 0) + (setq l (cdr l)))) + ;;(dframe-message "Exit with %S" (car l)) + ))) (defun speedbar-reset-scanners () "Reset any variables used by functions in the stealthy list as state. @@ -3572,38 +3571,36 @@ speedbar-fetch-dynamic-etags "For FILE, run etags and create a list of symbols extracted. Each symbol will be associated with its line position in FILE." (let ((newlist nil)) - (unwind-protect - (save-excursion - (if (get-buffer "*etags tmp*") - (kill-buffer "*etags tmp*")) ;kill to clean it up - (if (<= 1 speedbar-verbosity-level) - (dframe-message "Fetching etags...")) - (set-buffer (get-buffer-create "*etags tmp*")) - (apply 'call-process speedbar-fetch-etags-command nil - (current-buffer) nil - (append speedbar-fetch-etags-arguments (list file))) - (goto-char (point-min)) - (if (<= 1 speedbar-verbosity-level) - (dframe-message "Fetching etags...")) - (let ((expr - (let ((exprlst speedbar-fetch-etags-parse-list) - (ans nil)) - (while (and (not ans) exprlst) - (if (string-match (car (car exprlst)) file) - (setq ans (car exprlst))) - (setq exprlst (cdr exprlst))) - (cdr ans)))) - (if expr - (let (tnl) - (set-buffer (get-buffer-create "*etags tmp*")) - (while (not (save-excursion (end-of-line) (eobp))) - (save-excursion - (setq tnl (speedbar-extract-one-symbol expr))) - (if tnl (setq newlist (cons tnl newlist))) - (forward-line 1))) - (dframe-message - "Sorry, no support for a file of that extension")))) - ) + (save-excursion + (if (get-buffer "*etags tmp*") + (kill-buffer "*etags tmp*")) ;kill to clean it up + (if (<= 1 speedbar-verbosity-level) + (dframe-message "Fetching etags...")) + (set-buffer (get-buffer-create "*etags tmp*")) + (apply 'call-process speedbar-fetch-etags-command nil + (current-buffer) nil + (append speedbar-fetch-etags-arguments (list file))) + (goto-char (point-min)) + (if (<= 1 speedbar-verbosity-level) + (dframe-message "Fetching etags...")) + (let ((expr + (let ((exprlst speedbar-fetch-etags-parse-list) + (ans nil)) + (while (and (not ans) exprlst) + (if (string-match (car (car exprlst)) file) + (setq ans (car exprlst))) + (setq exprlst (cdr exprlst))) + (cdr ans)))) + (if expr + (let (tnl) + (set-buffer (get-buffer-create "*etags tmp*")) + (while (not (save-excursion (end-of-line) (eobp))) + (save-excursion + (setq tnl (speedbar-extract-one-symbol expr))) + (if tnl (setq newlist (cons tnl newlist))) + (forward-line 1))) + (dframe-message + "Sorry, no support for a file of that extension")))) (if speedbar-sort-tags (sort newlist (lambda (a b) (string< (car a) (car b)))) (reverse newlist)))) diff --git a/lisp/strokes.el b/lisp/strokes.el index fe244d448d8..293bdf0f369 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -760,27 +760,27 @@ strokes-read-stroke (setq safe-to-draw-p t)) (push (cdr (mouse-pixel-position)) pix-locs))) - (setq event (read--potential-mouse-event))))) - ;; protected - ;; clean up strokes buffer and then bury it. - (when (equal (buffer-name) strokes-buffer-name) - (subst-char-in-region (point-min) (point-max) - strokes-character ?\s) - (goto-char (point-min)) - (bury-buffer)))) - ;; Otherwise, don't use strokes buffer and read stroke silently - (when prompt - (message "%s" prompt) - (setq event (read--potential-mouse-event)) - (or (strokes-button-press-event-p event) - (error "You must draw with the mouse"))) - (track-mouse - (or event (setq event (read--potential-mouse-event))) - (while (not (strokes-button-release-event-p event)) - (if (strokes-mouse-event-p event) - (push (cdr (mouse-pixel-position)) - pix-locs)) - (setq event (read--potential-mouse-event)))) + (setq event (read--potential-mouse-event)))) + ;; protected + ;; clean up strokes buffer and then bury it. + (when (equal (buffer-name) strokes-buffer-name) + (subst-char-in-region (point-min) (point-max) + strokes-character ?\s) + (goto-char (point-min)) + (bury-buffer)))) + ;; Otherwise, don't use strokes buffer and read stroke silently + (when prompt + (message "%s" prompt) + (setq event (read--potential-mouse-event)) + (or (strokes-button-press-event-p event) + (error "You must draw with the mouse"))) + (track-mouse + (or event (setq event (read--potential-mouse-event))) + (while (not (strokes-button-release-event-p event)) + (if (strokes-mouse-event-p event) + (push (cdr (mouse-pixel-position)) + pix-locs)) + (setq event (read--potential-mouse-event))))) (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs))) (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs))))) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 778591a8069..c7a297d5dac 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -1445,20 +1445,19 @@ reftex-index-this-phrase (as-words reftex-index-phrases-search-whole-words)) (unless macro-data (error "No macro associated with key %c" char)) - (unwind-protect - (let ((overlay-arrow-string "=>") - (overlay-arrow-position - reftex-index-phrases-marker) - (replace-count 0)) - ;; Show the overlay arrow - (move-marker reftex-index-phrases-marker - (match-beginning 0) (current-buffer)) - ;; Start the query-replace - (reftex-query-index-phrase-globally - files phrase macro-fmt - index-key repeat as-words) - (message "%s replaced" - (reftex-number replace-count "occurrence")))))) + (let ((overlay-arrow-string "=>") + (overlay-arrow-position + reftex-index-phrases-marker) + (replace-count 0)) + ;; Show the overlay arrow + (move-marker reftex-index-phrases-marker + (match-beginning 0) (current-buffer)) + ;; Start the query-replace + (reftex-query-index-phrase-globally + files phrase macro-fmt + index-key repeat as-words) + (message "%s replaced" + (reftex-number replace-count "occurrence"))))) (t (error "Cannot parse this line"))))) (defun reftex-index-all-phrases () diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 2271d83eff5..50c3f461bcc 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -1935,8 +1935,8 @@ table-recognize-region (if (and cell table-detect-cell-alignment) (table--detect-cell-alignment cell))) (unless (re-search-forward border end t) - (goto-char end)))))))))) - (restore-buffer-modified-p modified-flag))) + (goto-char end)))))) + (restore-buffer-modified-p modified-flag))))))) ;;;###autoload (defun table-unrecognize-region (beg end) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 347bdfc0d7b..0701b229edd 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -477,9 +477,9 @@ dired-test-directory-files ;;(should (= 0 (length (directory-files testdir nil "[0-9]" t -1)))) (should (= 5 (length (directory-files testdir nil "[0-9]" t)))) (should (= 5 (length (directory-files testdir nil "[0-9]" t 50)))) - (should-not (directory-empty-p testdir))) + (should-not (directory-empty-p testdir)))) - (delete-directory testdir t))))) + (delete-directory testdir t)))) (ert-deftest dired-test-directory-files-and-attributes () "Test for `directory-files-and-attributes'." diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 3e499fc6f59..7713a0f6e38 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -577,13 +577,12 @@ ert-test-run-tests-batch (lambda (format-string &rest args) (push (apply #'format format-string args) messages)))) (save-window-excursion - (unwind-protect - (let ((case-fold-search nil) - (ert-batch-backtrace-right-margin nil) - (ert-batch-print-level 10) - (ert-batch-print-length 11)) - (ert-run-tests-batch - `(member ,failing-test-1 ,failing-test-2)))))) + (let ((case-fold-search nil) + (ert-batch-backtrace-right-margin nil) + (ert-batch-print-level 10) + (ert-batch-print-length 11)) + (ert-run-tests-batch + `(member ,failing-test-1 ,failing-test-2))))) (let ((long-text "(different-types[ \t\n]+(1 1 1 1 1 1 1 1 1 1 1)[ \t\n]+1)))[ \t\n]*$") (complex-text "(different-types[ \t\n]+((:1[ \t\n]+(:2[ \t\n]+(:3[ \t\n]+(:4[ \t\n]+(:5[ \t\n]+(:6[ \t\n]+\"abc\")))))))[ \t\n]+1)))[ \t\n]*$") found-long @@ -609,14 +608,13 @@ ert-test-run-tests-batch-expensive (lambda (format-string &rest args) (push (apply #'format format-string args) messages)))) (save-window-excursion - (unwind-protect - (let ((case-fold-search nil) - (ert-batch-backtrace-right-margin nil) - (ert-batch-backtrace-line-length nil) - (ert-batch-print-level 6) - (ert-batch-print-length 11)) - (ert-run-tests-batch - `(member ,failing-test-1)))))) + (let ((case-fold-search nil) + (ert-batch-backtrace-right-margin nil) + (ert-batch-backtrace-line-length nil) + (ert-batch-print-level 6) + (ert-batch-print-length 11)) + (ert-run-tests-batch + `(member ,failing-test-1))))) (let ((frame "ert-fail(((should (equal complex-list 1)) :form (equal ((:1 (:2 (:3 (:4 (:5 (:6 \"abc\"))))))) 1) :value nil :explanation (different-types ((:1 (:2 (:3 (:4 (:5 (:6 \"abc\"))))))) 1)))") found-frame) (cl-loop for msg in (reverse messages) diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el index 37e84c148af..a5dadf21c8c 100644 --- a/test/lisp/gnus/mml-sec-tests.el +++ b/test/lisp/gnus/mml-sec-tests.el @@ -66,34 +66,29 @@ mml-secure-test-fixture which will neither work with gpgsm nor GnuPG 2.1 any longer, I guess. Actually, I'm not sure why people would want to cache passwords in Emacs instead of gpg-agent." - (unwind-protect - (let ((agent-info (getenv "GPG_AGENT_INFO")) - (gpghome (getenv "GNUPGHOME"))) - (condition-case error - (let ((epg-gpg-home-directory (ert-resource-directory)) - (mml-smime-use 'epg) - ;; Create debug output in empty epg-debug-buffer. - (epg-debug t) - (epg-debug-buffer (get-buffer-create " *epg-test*")) - (mml-secure-fail-when-key-problem (not interactive))) - (with-current-buffer epg-debug-buffer - (erase-buffer)) - ;; Unset GPG_AGENT_INFO to enable passphrase caching inside Emacs. - ;; Just for testing. Jens does not recommend this for daily use. - (setenv "GPG_AGENT_INFO") - ;; Set GNUPGHOME as gpg-agent started by gpgsm does - ;; not look in the proper places otherwise, see: - ;; https://bugs.gnupg.org/gnupg/issue2126 - (setenv "GNUPGHOME" epg-gpg-home-directory) - (unwind-protect - (funcall body) - (mml-sec-test--kill-gpg-agent))) - (error - (setenv "GPG_AGENT_INFO" agent-info) - (setenv "GNUPGHOME" gpghome) - (signal (car error) (cdr error)))) - (setenv "GPG_AGENT_INFO" agent-info) - (setenv "GNUPGHOME" gpghome)))) + (let ((agent-info (getenv "GPG_AGENT_INFO")) + (gpghome (getenv "GNUPGHOME"))) + (unwind-protect + (let ((epg-gpg-home-directory (ert-resource-directory)) + (mml-smime-use 'epg) + ;; Create debug output in empty epg-debug-buffer. + (epg-debug t) + (epg-debug-buffer (get-buffer-create " *epg-test*")) + (mml-secure-fail-when-key-problem (not interactive))) + (with-current-buffer epg-debug-buffer + (erase-buffer)) + ;; Unset GPG_AGENT_INFO to enable passphrase caching inside Emacs. + ;; Just for testing. Jens does not recommend this for daily use. + (setenv "GPG_AGENT_INFO") + ;; Set GNUPGHOME as gpg-agent started by gpgsm does + ;; not look in the proper places otherwise, see: + ;; https://bugs.gnupg.org/gnupg/issue2126 + (setenv "GNUPGHOME" epg-gpg-home-directory) + (unwind-protect + (funcall body) + (mml-sec-test--kill-gpg-agent))) + (setenv "GPG_AGENT_INFO" agent-info) + (setenv "GNUPGHOME" gpghome)))) (defun mml-secure-test-message-setup (method to from &optional text bcc) "Setup a buffer with MML METHOD, TO, and FROM headers. diff --git a/test/lisp/hl-line-tests.el b/test/lisp/hl-line-tests.el index 56924ff8e3e..9c120e0d7ff 100644 --- a/test/lisp/hl-line-tests.el +++ b/test/lisp/hl-line-tests.el @@ -104,10 +104,10 @@ hl-line-tests-sticky (run-hooks 'post-command-hook) (should (hl-line-tests-verify 257 t)) (with-current-buffer second-buffer - (should (hl-line-tests-verify 999 nil))))) - (let (kill-buffer-query-functions) - (ignore-errors (kill-buffer first-buffer)) - (ignore-errors (kill-buffer second-buffer))))) + (should (hl-line-tests-verify 999 nil)))) + (let (kill-buffer-query-functions) + (ignore-errors (kill-buffer first-buffer)) + (ignore-errors (kill-buffer second-buffer)))))) (provide 'hl-line-tests) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 050ee22ac18..8f46c2af136 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -579,7 +579,8 @@ subr-test--frames-2 (cons (mapcar (pcase-lambda (`(,evald ,func ,args ,_)) `(,evald ,func ,@args)) (backtrace-frames base)) - (subr-test--backtrace-frames-with-backtrace-frame base)))))) + (subr-test--backtrace-frames-with-backtrace-frame base)) + (sit-for 0))))) ; dummy unwind form (defun subr-test--frames-1 (base) (subr-test--frames-2 base)) commit 211618293d9fd620f9f8971090e049d98c05f546 Author: Michael Albinus Date: Fri Apr 7 17:08:46 2023 +0200 * test/infra/Dockerfile.emba (emacs-eglot): Adapt software selection. diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index 722a449b636..689573236da 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -71,10 +71,10 @@ RUN apt-get update && \ libdbus-1-dev libacl1-dev acl git texinfo gdb \ && rm -rf /var/lib/apt/lists/* -# Some language servers. +# Install clangd. RUN apt-get update && \ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \ - clangd python3-pylsp python3-autopep8 python3-yapf \ + clangd \ && rm -rf /var/lib/apt/lists/* COPY . /checkout commit fc8230f3362b12955152f48565a6c670b4c4cc88 Author: João Távora Date: Fri Apr 7 14:55:01 2023 +0100 Eglot: no more tests based on Pylsp (bug#62694) The functionality under test in eglot.el is exactly the same, but use the clangd server only, as that is used in more tests, and it is much easier to check if it misbehaves or not. Tests pass with clangd version 15. * test/lisp/progmodes/eglot-tests.el (python): Don't require it. (eglot--call-with-fixture): Simplify. (eglot--wait-for-clangd): New helper. (eglot-test-basic-completions) (eglot-test-non-unique-completions, eglot-test-basic-xref) (eglot-test-snippet-completions) (eglot-test-snippet-completions-with-company) (eglot-test-eldoc-after-completions, eglot-test-multiline-eldoc): Use clangd, not pylsp. (eglot-test-formatting): Renamed from eglot-test-python-autopep-formatting. (eglot-test-python-yapf-formatting): Remove. diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index b11ce942b7d..aa0b71a3ae7 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -47,7 +47,6 @@ (require 'tramp) (require 'ert-x) ; ert-simulate-command (require 'edebug) -(require 'python) ; some tests use pylsp (require 'cc-mode) ; c-mode-hook (require 'company nil t) (require 'yasnippet nil t) @@ -122,8 +121,6 @@ eglot--call-with-fixture ,(format "HOME=%s" (expand-file-name (format "~%s" (user-login-name))))) process-environment)) - ;; Prevent "Can't guess python-indent-offset ..." messages. - (python-indent-guess-indent-offset-verbose . nil) (eglot-server-initialized-hook (lambda (server) (push server new-servers)))) (setq created-files (mapcan #'eglot--make-file-or-dir file-specs)) @@ -551,90 +548,101 @@ eglot-test-rename-a-symbol (should (equal (buffer-string) "int bar() {return 42;} int main() {return bar();}"))))) +(defun eglot--wait-for-clangd () + (eglot--sniffing (:server-notifications s-notifs) + (should (eglot--tests-connect)) + (eglot--wait-for (s-notifs 20) (&key method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")))) + (ert-deftest eglot-test-basic-completions () - "Test basic autocompletion in a python LSP." - (skip-unless (executable-find "pylsp")) + "Test basic autocompletion in a clangd LSP." + (skip-unless (executable-find "clangd")) (eglot--with-fixture - `(("project" . (("something.py" . "import sys\nsys.exi")))) + `(("project" . (("coiso.c" . "#include \nint main () {fprin")))) (with-current-buffer - (eglot--find-file-noselect "project/something.py") - (should (eglot--tests-connect)) + (eglot--find-file-noselect "project/coiso.c") + (eglot--sniffing (:server-notifications s-notifs) + (eglot--wait-for-clangd) + (eglot--wait-for (s-notifs 20) (&key method &allow-other-keys) + (string= method "textDocument/publishDiagnostics"))) (goto-char (point-max)) (completion-at-point) - (should (looking-back "sys.exit"))))) + (message (buffer-string)) + (should (looking-back "fprintf.?"))))) (ert-deftest eglot-test-non-unique-completions () "Test completion resulting in 'Complete, but not unique'." - (skip-unless (executable-find "pylsp")) + (skip-unless (executable-find "clangd")) (eglot--with-fixture - '(("project" . (("something.py" . "foo=1\nfoobar=2\nfoo")))) + `(("project" . (("coiso.c" . + ,(concat "int foo; int fooey;" + "int main() {foo"))))) (with-current-buffer - (eglot--find-file-noselect "project/something.py") - (should (eglot--tests-connect)) + (eglot--find-file-noselect "project/coiso.c") + (eglot--wait-for-clangd) (goto-char (point-max)) - (completion-at-point)) - ;; FIXME: `current-message' doesn't work here :-( + (completion-at-point) + ;; FIXME: `current-message' doesn't work here :-( (with-current-buffer (messages-buffer) (save-excursion (goto-char (point-max)) (forward-line -1) - (should (looking-at "Complete, but not unique")))))) + (should (looking-at "Complete, but not unique"))))))) (ert-deftest eglot-test-basic-xref () - "Test basic xref functionality in a python LSP." - (skip-unless (executable-find "pylsp")) + "Test basic xref functionality in a clangd LSP." + (skip-unless (executable-find "clangd")) (eglot--with-fixture - `(("project" . (("something.py" . "def foo(): pass\ndef bar(): foo()")))) + `(("project" . (("coiso.c" . + ,(concat "int foo=42; int fooey;" + "int main() {foo=82;}"))))) (with-current-buffer - (eglot--find-file-noselect "project/something.py") + (eglot--find-file-noselect "project/coiso.c") (should (eglot--tests-connect)) - (search-forward "bar(): f") + (search-forward "{foo") (call-interactively 'xref-find-definitions) - (should (looking-at "foo(): pass"))))) + (should (looking-at "foo=42"))))) -(defvar eglot--test-python-buffer +(defvar eglot--test-c-buffer "\ -def foobarquux(a, b, c=True): pass -def foobazquuz(d, e, f): pass +void foobarquux(int a, int b, int c){}; +void foobazquuz(int a, int b, int f){}; +int main() { ") (declare-function yas-minor-mode nil) (ert-deftest eglot-test-snippet-completions () - "Test simple snippet completion in a python LSP." - (skip-unless (and (executable-find "pylsp") + "Test simple snippet completion in a clangd LSP." + (skip-unless (and (executable-find "clangd") (functionp 'yas-minor-mode))) (eglot--with-fixture - `(("project" . (("something.py" . ,eglot--test-python-buffer)))) + `(("project" . (("coiso.c" . ,eglot--test-c-buffer)))) (with-current-buffer - (eglot--find-file-noselect "project/something.py") + (eglot--find-file-noselect "project/coiso.c") (yas-minor-mode 1) - (let ((eglot-workspace-configuration - `((:pylsp . (:plugins (:jedi_completion (:include_params t))))))) - (should (eglot--tests-connect))) + (eglot--wait-for-clangd) (goto-char (point-max)) (insert "foobar") (completion-at-point) (should (looking-back "foobarquux(")) - (should (looking-at "a, b)"))))) + (should (looking-at "int a, int b, int c)"))))) (defvar company-candidates) (declare-function company-mode nil) (declare-function company-complete nil) (ert-deftest eglot-test-snippet-completions-with-company () - "Test simple snippet completion in a python LSP." - (skip-unless (and (executable-find "pylsp") + "Test simple snippet completion in a clangd LSP." + (skip-unless (and (executable-find "clangd") (functionp 'yas-minor-mode) (functionp 'company-complete))) (eglot--with-fixture - `(("project" . (("something.py" . ,eglot--test-python-buffer)))) + `(("project" . (("coiso.c" . ,eglot--test-c-buffer)))) (with-current-buffer - (eglot--find-file-noselect "project/something.py") + (eglot--find-file-noselect "project/coiso.c") (yas-minor-mode 1) - (let ((eglot-workspace-configuration - `((:pylsp . (:plugins (:jedi_completion (:include_params t))))))) - (should (eglot--tests-connect))) + (eglot--wait-for-clangd) (goto-char (point-max)) (insert "foo") (company-mode) @@ -642,98 +650,63 @@ eglot-test-snippet-completions-with-company (should (looking-back "fooba")) (should (= 2 (length company-candidates))) ;; this last one is brittle, since there it is possible that - ;; pylsp will change the representation of this candidate - (should (member "foobazquuz(d, e, f)" company-candidates))))) + ;; clangd will change the representation of this candidate + (should (member "foobazquuz(int a, int b, int f)" company-candidates))))) (ert-deftest eglot-test-eldoc-after-completions () - "Test documentation echo in a python LSP." - (skip-unless (executable-find "pylsp")) + "Test documentation echo in a clangd LSP." + (skip-unless (executable-find "clangd")) (eglot--with-fixture - `(("project" . (("something.py" . "import sys\nsys.exi")))) + `(("project" . (("coiso.c" . "#include \nint main () {fprin")))) (with-current-buffer - (eglot--find-file-noselect "project/something.py") - (should (eglot--tests-connect)) + (eglot--find-file-noselect "project/coiso.c") + (eglot--wait-for-clangd) (goto-char (point-max)) (completion-at-point) - (should (looking-back "sys.exit")) - (should (string-match "^exit" (eglot--tests-force-full-eldoc)))))) + (message (buffer-string)) + (should (looking-back "fprintf(?")) + (unless (= (char-before) ?\()) (insert "()") (backward-char) + (eglot--signal-textDocument/didChange) + (should (string-match "^fprintf" (eglot--tests-force-full-eldoc)))))) (ert-deftest eglot-test-multiline-eldoc () - "Test if suitable amount of lines of hover info are shown." - (skip-unless (executable-find "pylsp")) + "Test Eldoc documentation from multiple osurces." + (skip-unless (executable-find "clangd")) (eglot--with-fixture - `(("project" . (("hover-first.py" . "from datetime import datetime")))) + `(("project" . (("coiso.c" . + "#include \nint main () {fprintf(blergh);}")))) (with-current-buffer - (eglot--find-file-noselect "project/hover-first.py") - (should (eglot--tests-connect)) - (goto-char (point-max)) - ;; one-line - (let* ((eldoc-echo-area-use-multiline-p t) - (captured-message (eglot--tests-force-full-eldoc))) - (should (string-match "datetim" captured-message)) + (eglot--find-file-noselect "project/coiso.c") + (search-forward "fprintf(ble") + (eglot--wait-for-clangd) + (flymake-start nil t) ;; thing brings in the "unknown identifier blergh" + (let* ((captured-message (eglot--tests-force-full-eldoc))) + ;; check for signature and error message in the result + (should (string-match "fprintf" captured-message)) + (should (string-match "blergh" captured-message)) (should (cl-find ?\n captured-message)))))) -(ert-deftest eglot-test-single-line-eldoc () - "Test if suitable amount of lines of hover info are shown." - (skip-unless (executable-find "pylsp")) - (eglot--with-fixture - `(("project" . (("hover-first.py" . "from datetime import datetime")))) - (with-current-buffer - (eglot--find-file-noselect "project/hover-first.py") - (should (eglot--tests-connect)) - (goto-char (point-max)) - ;; one-line - (let* ((eldoc-echo-area-use-multiline-p nil) - (captured-message (eglot--tests-force-full-eldoc))) - (should (string-match "datetim" captured-message)) - (should (not (cl-find ?\n eldoc-last-message))))))) - -(ert-deftest eglot-test-python-autopep-formatting () - "Test formatting in the pylsp python LSP. -pylsp prefers autopep over yafp, despite its README stating the contrary." +(ert-deftest eglot-test-formatting () + "Test formatting in the clangd server." ;; Beware, default autopep rules can change over time, which may ;; affect this test. - (skip-unless (and (executable-find "pylsp") - (executable-find "autopep8"))) - (eglot--with-fixture - `(("project" . (("something.py" . "def a():pass\n\ndef b():pass")))) - (with-current-buffer - (eglot--find-file-noselect "project/something.py") - (should (eglot--tests-connect)) - ;; Try to format just the second line - (search-forward "b():pa") - (eglot-format (line-beginning-position) (line-end-position)) - (should (looking-at "ss")) - (should - (or (string= (buffer-string) "def a():pass\n\n\ndef b(): pass\n") - ;; autopep8 2.0.0 (pycodestyle: 2.9.1) - (string= (buffer-string) "def a():pass\n\ndef b(): pass"))) - ;; now format the whole buffer - (eglot-format-buffer) - (should - (string= (buffer-string) "def a(): pass\n\n\ndef b(): pass\n"))))) - -(ert-deftest eglot-test-python-yapf-formatting () - "Test formatting in the pylsp python LSP." - (skip-unless (and (executable-find "pylsp") - (not (executable-find "autopep8")) - (or (executable-find "yapf") - (executable-find "yapf3")))) + (skip-unless (executable-find "clangd")) (eglot--with-fixture - `(("project" . (("something.py" . "def a():pass\ndef b():pass")))) + `(("project" . (("coiso.c" . ,(concat "#include \n" + "int main(){fprintf(blergh);}" + "int ble{\n\nreturn 0;}"))))) (with-current-buffer - (eglot--find-file-noselect "project/something.py") - (should (eglot--tests-connect)) + (eglot--find-file-noselect "project/coiso.c") + (eglot--wait-for-clangd) + (forward-line) ;; Try to format just the second line - (search-forward "b():pa") (eglot-format (line-beginning-position) (line-end-position)) - (should (looking-at "ss")) - (should - (string= (buffer-string) "def a():pass\n\n\ndef b():\n pass\n")) - ;; now format the whole buffer + (should (looking-at "int main() { fprintf(blergh); }")) + ;; ;; now format the whole buffer (eglot-format-buffer) (should - (string= (buffer-string) "def a():\n pass\n\n\ndef b():\n pass\n"))))) + (string= (buffer-string) + "#include \nint main() { fprintf(blergh); }\nint ble { return 0; }"))))) (ert-deftest eglot-test-rust-on-type-formatting () "Test textDocument/onTypeFormatting against rust-analyzer." commit b1f8d98a119ab8845d25d80c480cde6e385d8749 Author: João Távora Date: Fri Apr 7 12:54:39 2023 +0100 Eglot: rework eglot-imenu Most newer servers return a vector of 'DocumentSymbol' as a response to 'textDocument/documentSymbol'. It's not worth trying to dumb this down to imenu format of 'SymbolInformation' vectors. This lays groundwork for the forthcoming "breadcrumb" feature of bug#58431. * lisp/progmodes/eglot.el (eglot--imenu-SymbolInformation, eglot--imenu-DocumentSymbol): New helpers. (eglot-imenu): Rework. diff --git a/lisp/electric.el b/lisp/electric.el index bac3f5a2b3c..cef5326852c 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -409,9 +409,7 @@ electric-layout-post-self-insert-function-1 (goto-char pos) (funcall probe last-command-event)))) (when res (throw 'done res)))))))))) - (when (and rule - ;; Not in a string or comment. - (not (nth 8 (save-excursion (syntax-ppss pos))))) + (when rule (goto-char pos) (when (functionp rule) (setq rule (funcall rule))) (dolist (sym (if (symbolp rule) (list rule) rule)) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index f3b806e5613..db57b122a94 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -486,9 +486,7 @@ eglot--accepted-formats (SymbolInformation (:name :kind :location) (:deprecated :containerName)) (DocumentSymbol (:name :range :selectionRange :kind) - ;; `:containerName' isn't really allowed , but - ;; it simplifies the impl of `eglot-imenu'. - (:detail :deprecated :children :containerName)) + (:detail :deprecated :children)) (TextDocumentEdit (:textDocument :edits) ()) (TextEdit (:range :newText)) (VersionedTextDocumentIdentifier (:uri :version) ()) @@ -3235,49 +3233,53 @@ eglot--highlight-piggyback :deferred :textDocument/documentHighlight) nil))) +(defun eglot--imenu-SymbolInformation (res) + "Compute `imenu--index-alist' for RES vector of SymbolInformation." + (mapcar + (pcase-lambda (`(,kind . ,objs)) + (cons + (alist-get kind eglot--symbol-kind-names "Unknown") + (mapcan + (pcase-lambda (`(,container . ,objs)) + (let ((elems (mapcar + (eglot--lambda ((SymbolInformation) kind name location) + (let ((reg (eglot--range-region + (plist-get location :range)))) + (cons (propertize name + 'breadcrumb-region reg + 'breadcrumb-kind kind) + (car reg)))) + objs))) + (if container (list (cons container elems)) elems))) + (seq-group-by + (eglot--lambda ((SymbolInformation) containerName) containerName) objs)))) + (seq-group-by (eglot--lambda ((SymbolInformation) kind) kind) res))) + +(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)) + (name (propertize name + 'breadcrumb-region reg + 'breadcrumb-kind kind))) + (if children + (cons name + (mapcar (lambda (c) (apply #'dfs c)) children)) + (cons name (car reg)))))) + (mapcar (lambda (s) (apply #'dfs s)) res))) + (defun eglot-imenu () "Eglot's `imenu-create-index-function'. Returns a list as described in docstring of `imenu--index-alist'." - (cl-labels - ((unfurl (obj) - (eglot--dcase obj - (((SymbolInformation)) (list obj)) - (((DocumentSymbol) name children) - (cons obj - (mapcar - (lambda (c) - (plist-put - c :containerName - (let ((existing (plist-get c :containerName))) - (if existing (format "%s::%s" name existing) - name)))) - (mapcan #'unfurl children))))))) - (mapcar - (pcase-lambda (`(,kind . ,objs)) - (cons - (alist-get kind eglot--symbol-kind-names "Unknown") - (mapcan (pcase-lambda (`(,container . ,objs)) - (let ((elems (mapcar - (lambda (obj) - (cons (plist-get obj :name) - (car (eglot--range-region - (eglot--dcase obj - (((SymbolInformation) location) - (plist-get location :range)) - (((DocumentSymbol) selectionRange) - selectionRange)))))) - objs))) - (if container (list (cons container elems)) elems))) - (seq-group-by - (lambda (e) (plist-get e :containerName)) objs)))) - (seq-group-by - (lambda (obj) (plist-get obj :kind)) - (mapcan #'unfurl - (eglot--request (eglot--current-server-or-lose) + (let* ((res (eglot--request (eglot--current-server-or-lose) :textDocument/documentSymbol `(:textDocument ,(eglot--TextDocumentIdentifier)) - :cancel-on-input non-essential)))))) + :cancel-on-input non-essential)) + (head (and res (elt res 0)))) + (eglot--dcase head + (((SymbolInformation)) (eglot--imenu-SymbolInformation res)) + (((DocumentSymbol)) (eglot--imenu-DocumentSymbol res))))) (cl-defun eglot--apply-text-edits (edits &optional version) "Apply EDITS for current buffer if at VERSION, or if it's nil."