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.
This commit is contained in:
Mattias Engdegård
parent
211618293d
commit
7c0c2b1bb5
21 changed files with 440 additions and 465 deletions
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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: <address>."
|
||||
(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.
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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'."
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue