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 @@ Does nothing if the current buffer doesn't need reparsing." (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. + ;; 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)) - ;; 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 @@ See `edebug-behavior-alist' for implementations.") 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) + (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) - (standard-output t) - (standard-input t) + (last-input-event nil) + (last-command-event nil) + (last-event-frame nil) + (last-nonmenu-event nil) + (track-mouse nil) - ;; 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)) + (standard-output t) + (standard-input t) - ;; 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))) + ;; 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)) - ;; Bind again to outside values. - (debug-on-error edebug-outside-debug-on-error) - (debug-on-quit edebug-outside-debug-on-quit) + ;; 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))) - ;; Don't keep defining a kbd macro. - (defining-kbd-macro - (if edebug-continue-kbd-macro defining-kbd-macro)) + ;; Bind again to outside values. + (debug-on-error edebug-outside-debug-on-error) + (debug-on-quit edebug-outside-debug-on-quit) - ;; others?? - ) + ;; Don't keep defining a kbd macro. + (defining-kbd-macro + (if edebug-continue-kbd-macro defining-kbd-macro)) - (if (and (eq edebug-execution-mode 'go) - (not (memq arg-mode '(after error)))) - (message "Break")) + ;; others?? + ) - (setq signal-hook-function nil) + (if (and (eq edebug-execution-mode 'go) + (not (memq arg-mode '(after error)))) + (message "Break")) - (edebug-mode 1) - (unwind-protect - (recursive-edit) ; <<<<<<<<<< Recursive edit + (setq signal-hook-function nil) - ;; Do the following, even if quit occurs. - (setq signal-hook-function #'edebug-signal) - (if edebug-backtrace-buffer - (kill-buffer edebug-backtrace-buffer)) + (edebug-mode 1) + (unwind-protect + (recursive-edit) ; <<<<<<<<<< Recursive edit - ;; Remember selected-window after recursive-edit. - ;; (setq edebug-inside-window (selected-window)) + ;; Do the following, even if quit occurs. + (setq signal-hook-function #'edebug-signal) + (if edebug-backtrace-buffer + (kill-buffer edebug-backtrace-buffer)) - (set-match-data edebug-outside-match-data) + ;; Remember selected-window after recursive-edit. + ;; (setq edebug-inside-window (selected-window)) - ;; 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 - ))) + (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 @@ boundaries." "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 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to (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 @@ To turn this feature off, set this variable to nil." (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 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) ;; 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 @@ depending on PATTERNS." (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 @@ mapped to mostly alphanumerics for safety." 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))) + (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) + (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)))))) + (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 @@ been weeded out." (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 @@ The mail client is taken to be the handler of mailto URLs." (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 @@ Returns an error if the server cannot be contacted." (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:\\)"))) + (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 + (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 @@ (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 @@ commands \\[mh-ps-print-toggle-color] and 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 @@ See also `text-scale-adjust'." 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 @@ interrupted by the user." (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 @@ value is \"show\" then toggle the value of "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 @@ Optional EVENT is acceptable as the starting event of the 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 @@ match, the user will be asked to confirm the replacement." (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 @@ specific features." (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 @@ ;;(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 @@ This macro is used to test if macroexpansion in `should' works." (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 @@ This macro is used to test if macroexpansion in `should' works." (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 @@ This fixture temporarily unsets GPG_AGENT_INFO to enable passphrase tests, 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 @@ (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 @@ (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))