:type '(repeat function))
(defcustom message-auto-save-directory
- (if (file-exists-p message-directory)
+ (if (file-writable-p message-directory)
(file-name-as-directory (expand-file-name "drafts" message-directory))
"~/")
"*Directory where Message auto-saves buffers if Gnus isn't running.
`quoted-text-only' Allow you to post quoted text only;
`multiple-copies' Allow you to post multiple copies;
`cancel-messages' Allow you to cancel or supersede messages from
- your other email addresses.")
+ your other email addresses;
+`canlock-verify' Allow you to cancel messages without verifying canlock.")
(defsubst message-gnksa-enable-p (feature)
(or (not (listp message-shoot-gnksa-feet))
(message-delete-line))
;; Delete blank lines at the end of the buffer.
(goto-char (point-max))
- (unless (eolp)
+ (unless (eq (preceding-char) ?\n)
(insert "\n"))
(while (and (zerop (forward-line -1))
(looking-at "$"))
"Invisible text found and made visible; continue sending? ")
(error "Invisible text found and made visible")))))
(message-check 'illegible-text
- (let (char found choice)
+ (let (char found choice nul-chars)
(message-goto-body)
+ (setq nul-chars (save-excursion
+ (search-forward "\000" nil t)))
(while (progn
(skip-chars-forward mm-7bit-chars)
(when (get-text-property (point) 'no-illegible-text)
(when found
(setq choice
(gnus-multiple-choice
- "Non-printable characters found. Continue sending?"
+ (if nul-chars
+ "NUL characters found, which may cause problems. Continue sending?"
+ "Non-printable characters found. Continue sending?")
`((?d "Remove non-printable characters and send")
(?r ,(format
"Replace non-printable characters with \"%s\" and send"
(progn
(gnus-select-frame-set-input-focus (window-frame window))
(select-window window))
- (funcall (or switch-function 'pop-to-buffer) buffer)
+ (funcall (or switch-function 'switch-to-buffer) buffer)
(set-buffer buffer))
(when (and (buffer-modified-p)
(not (prog1
"Message already being composed; erase? ")
(message nil))))
(error "Message being composed")))
- (funcall (or switch-function 'pop-to-buffer) name)
+ (funcall (or switch-function 'switch-to-buffer) name)
(set-buffer name))
(erase-buffer)
(message-mode)))
;; Rename the buffer.
(if message-send-rename-function
(funcall message-send-rename-function)
- ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus.
- (when (string-match
- "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to "
- (buffer-name))
- (let ((name (match-string 2 (buffer-name)))
- to group)
- (if (not (or (null name)
- (string-equal name "mail")
- (string-equal name "posting")))
- (setq name (concat "*sent " name "*"))
- (message-narrow-to-headers)
- (setq to (message-fetch-field "to"))
- (setq group (message-fetch-field "newsgroups"))
- (widen)
- (setq name
- (cond
- (to (concat "*sent mail to "
- (or (car (mail-extract-address-components to))
- to) "*"))
- ((and group (not (string= group "")))
- (concat "*sent posting on " group "*"))
- (t "*sent mail*"))))
- (unless (string-equal name (buffer-name))
- (rename-buffer name t)))))
+ (message-default-send-rename-function))
;; Push the current buffer onto the list.
(when message-max-buffers
(setq message-buffer-list
(nconc message-buffer-list (list (current-buffer))))))
+(defun message-default-send-rename-function ()
+ ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus.
+ (when (string-match
+ "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to "
+ (buffer-name))
+ (let ((name (match-string 2 (buffer-name)))
+ to group)
+ (if (not (or (null name)
+ (string-equal name "mail")
+ (string-equal name "posting")))
+ (setq name (concat "*sent " name "*"))
+ (message-narrow-to-headers)
+ (setq to (message-fetch-field "to"))
+ (setq group (message-fetch-field "newsgroups"))
+ (widen)
+ (setq name
+ (cond
+ (to (concat "*sent mail to "
+ (or (car (mail-extract-address-components to))
+ to) "*"))
+ ((and group (not (string= group "")))
+ (concat "*sent posting on " group "*"))
+ (t "*sent mail*"))))
+ (unless (string-equal name (buffer-name))
+ (rename-buffer name t)))))
+
(defun message-mail-user-agent ()
(let ((mua (cond
((not message-mail-user-agent) nil)
(message-position-point)
;; Allow correct handling of `message-checksum' in `message-yank-original':
(set-buffer-modified-p nil)
- (undo-boundary))
+ (undo-boundary)
+ ;; rmail-start-mail expects message-mail to return t (Bug#9392)
+ t)
(defun message-set-auto-save-file-name ()
"Associate the message buffer with a file in the drafts directory."
(save-excursion
(save-restriction
(message-narrow-to-head-1)
- (if (message-fetch-field "Cancel-Lock")
+ (if (and (message-fetch-field "Cancel-Lock")
+ (message-gnksa-enable-p 'canlock-verify))
(if (null (canlock-verify))
t
(error "Failed to verify Cancel-lock: This article is not yours"))
(with-temp-buffer
(insert-buffer-substring cur)
(when (setq handles (mm-dissect-buffer t t))
- (if (and (prog1
- (bufferp (car handles))
- (mm-destroy-parts handles))
+ (if (and (bufferp (car handles))
(equal (mm-handle-media-type handles) "text/plain"))
(progn
+ (erase-buffer)
+ (insert-buffer-substring (car handles))
(mm-decode-content-transfer-encoding
(mm-handle-encoding handles))
+ (mm-destroy-parts handles)
(setq handles (mm-uu-dissect)))
+ (mm-destroy-parts handles)
(setq handles nil))))))
(when handles
(prog1
"Like `message-mail' command, but display mail buffer in another window."
(interactive)
(unless (message-mail-user-agent)
- (let ((pop-up-windows t)
- (special-display-buffer-names nil)
- (special-display-regexps nil)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "mail" to))))
+ (message-pop-to-buffer (message-buffer-name "mail" to)
+ 'switch-to-buffer-other-window))
(let ((message-this-is-mail t))
(message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
nil nil nil 'switch-to-buffer-other-window)))
"Like `message-mail' command, but display mail buffer in another frame."
(interactive)
(unless (message-mail-user-agent)
- (let ((pop-up-frames t)
- (special-display-buffer-names nil)
- (special-display-regexps nil)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "mail" to))))
+ (message-pop-to-buffer (message-buffer-name "mail" to)
+ 'switch-to-buffer-other-frame))
(let ((message-this-is-mail t))
(message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
nil nil nil 'switch-to-buffer-other-frame)))
(defun message-news-other-window (&optional newsgroups subject)
"Start editing a news article to be sent."
(interactive)
- (let ((pop-up-windows t)
- (special-display-buffer-names nil)
- (special-display-regexps nil)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
+ (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)
+ 'switch-to-buffer-other-window)
(let ((message-this-is-news t))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
(defun message-news-other-frame (&optional newsgroups subject)
"Start editing a news article to be sent."
(interactive)
- (let ((pop-up-frames t)
- (special-display-buffer-names nil)
- (special-display-regexps nil)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
+ (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)
+ 'switch-to-buffer-other-frame)
(let ((message-this-is-news t))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
(defun message-read-from-minibuffer (prompt &optional initial-contents)
"Read from the minibuffer while providing abbrev expansion."
(if (fboundp 'mail-abbrevs-setup)
- (let ((mail-abbrev-mode-regexp "")
- (minibuffer-setup-hook 'mail-abbrevs-setup)
+ (let ((minibuffer-setup-hook 'mail-abbrevs-setup)
(minibuffer-local-map message-minibuffer-local-map))
- (read-from-minibuffer prompt initial-contents))
+ (flet ((mail-abbrev-in-expansion-header-p nil t))
+ (read-from-minibuffer prompt initial-contents)))
(let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
(minibuffer-local-map message-minibuffer-local-map))
(read-string prompt initial-contents))))
projects / gnus / blobdiff