diff options
Diffstat (limited to 'lisp/gnus/message.el')
| -rw-r--r-- | lisp/gnus/message.el | 132 |
1 files changed, 77 insertions, 55 deletions
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 4d4ba089434..ce0dad9cb05 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2286,13 +2286,15 @@ body, set `message-archive-note' to nil." "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP. With prefix-argument just set Follow-Up, don't cross-post." (interactive - (list ; Completion based on Gnus - (completing-read "Followup To: " - (if (boundp 'gnus-newsrc-alist) - gnus-newsrc-alist) - nil nil '("poster" . 0) - (if (boundp 'gnus-group-history) - 'gnus-group-history)))) + (list ; Completion based on Gnus + (replace-regexp-in-string + "\\`.*:" "" + (completing-read "Followup To: " + (if (boundp 'gnus-newsrc-alist) + gnus-newsrc-alist) + nil nil '("poster" . 0) + (if (boundp 'gnus-group-history) + 'gnus-group-history))))) (message-remove-header "Follow[Uu]p-[Tt]o" t) (message-goto-newsgroups) (beginning-of-line) @@ -2361,13 +2363,15 @@ been made to before the user asked for a Crosspost." "Crossposts message and set Followup-To to TARGET-GROUP. With prefix-argument just set Follow-Up, don't cross-post." (interactive - (list ; Completion based on Gnus - (completing-read "Followup To: " - (if (boundp 'gnus-newsrc-alist) - gnus-newsrc-alist) - nil nil '("poster" . 0) - (if (boundp 'gnus-group-history) - 'gnus-group-history)))) + (list ; Completion based on Gnus + (replace-regexp-in-string + "\\`.*:" "" + (completing-read "Followup To: " + (if (boundp 'gnus-newsrc-alist) + gnus-newsrc-alist) + nil nil '("poster" . 0) + (if (boundp 'gnus-group-history) + 'gnus-group-history))))) (when (fboundp 'gnus-group-real-name) (setq target-group (gnus-group-real-name target-group))) (cond ((not (or (null target-group) ; new subject not empty @@ -3108,18 +3112,29 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (looking-at "[ \t]*\n")) (expand-abbrev)) (push-mark) + (message-goto-body-1)) + +(defun message-goto-body-1 () + "Go to the body and return point." (goto-char (point-min)) (or (search-forward (concat "\n" mail-header-separator "\n") nil t) - (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))) + ;; If the message is mangled, find the end of the headers the + ;; hard way. + (progn + ;; Skip past all headers and continuation lines. + (while (looking-at "[^:]+:\\|[\t ]+[^\t ]") + (forward-line 1)) + ;; We're now at the first empty line, so perhaps move past it. + (when (and (eolp) + (not (eobp))) + (forward-line 1)) + (point)))) (defun message-in-body-p () "Return t if point is in the message body." (>= (point) (save-excursion - (goto-char (point-min)) - (or (search-forward (concat "\n" mail-header-separator "\n") nil t) - (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)) - (point)))) + (message-goto-body-1)))) (defun message-goto-eoh () "Move point to the end of the headers." @@ -3330,6 +3345,8 @@ of lines before the signature intact." "Insert four newlines, and then reformat if inside quoted text. Prefix arg means justify as well." (interactive (list (if current-prefix-arg 'full))) + (unless (message-in-body-p) + (error "This command only works in the body of the message")) (let (quoted point beg end leading-space bolp fill-paragraph-function) (setq point (point)) (beginning-of-line) @@ -4102,8 +4119,8 @@ It should typically alter the sending method in some way or other." (let ((inhibit-read-only t)) (put-text-property (point-min) (point-max) 'read-only nil)) (message-fix-before-sending) - (mml-secure-bcc-is-safe) (run-hooks 'message-send-hook) + (mml-secure-bcc-is-safe) (when message-confirm-send (or (y-or-n-p "Send message? ") (keyboard-quit))) @@ -4539,6 +4556,9 @@ This function could be useful in `message-setup-hook'." (forward-line 1) (unless (y-or-n-p "Send anyway? ") (error "Failed to send the message"))))) + ;; Fold too-long header lines. They should be no longer than + ;; 998 octets long. + (message--fold-long-headers) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) (setq options message-options) @@ -4635,6 +4655,14 @@ If you always want Gnus to send messages in one piece, set (setq message-options options) (push 'mail message-sent-message-via))) +(defun message--fold-long-headers () + (goto-char (point-min)) + (while (not (eobp)) + (when (and (looking-at "[^:]+:") + (> (- (line-end-position) (point)) 998)) + (mail-header-fold-field)) + (forward-line 1))) + (defvar sendmail-program) (defvar smtpmail-smtp-server) (defvar smtpmail-smtp-service) @@ -5380,16 +5408,13 @@ Otherwise, generate and save a value for `canlock-password' first." "Process Fcc headers in the current buffer." (let ((case-fold-search t) (buf (current-buffer)) - list file - (mml-externalize-attachments message-fcc-externalize-attachments)) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (setq file (message-fetch-field "fcc" t))) - (when file - (set-buffer (get-buffer-create " *message temp*")) - (erase-buffer) + (mml-externalize-attachments message-fcc-externalize-attachments) + (file (message-field-value "fcc" t)) + list) + (when file + (with-temp-buffer (insert-buffer-substring buf) + (message-clone-locals buf) (message-encode-message-body) (save-restriction (message-narrow-to-headers) @@ -5429,8 +5454,7 @@ Otherwise, generate and save a value for `canlock-password' first." (if (and (file-readable-p file) (mail-file-babyl-p file)) (rmail-output file 1 nil t) (let ((mail-use-rfc822 t)) - (rmail-output file 1 t t)))))) - (kill-buffer (current-buffer)))))) + (rmail-output file 1 t t)))))))))) (defun message-output (filename) "Append this article to Unix/babyl mail file FILENAME." @@ -5761,7 +5785,7 @@ give as trustworthy answer as possible." (not (string-match message-bogus-system-names message-user-fqdn))) ;; `message-user-fqdn' seems to be valid message-user-fqdn) - ((and (string-match message-bogus-system-names sysname)) + ((not (string-match message-bogus-system-names sysname)) ;; `system-name' returned the right result. sysname) ;; Try `mail-host-address'. @@ -6644,29 +6668,27 @@ OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether to continue editing a message already being composed. SWITCH-FUNCTION is a function used to switch to and display the mail buffer." (interactive) - (let ((message-this-is-mail t)) - (unless (message-mail-user-agent) - (message-pop-to-buffer - ;; Search for the existing message buffer if `continue' is non-nil. - (let ((message-generate-new-buffers - (when (or (not continue) - (eq message-generate-new-buffers 'standard) - (functionp message-generate-new-buffers)) - message-generate-new-buffers))) - (message-buffer-name "mail" to)) - switch-function)) - (message-setup - (nconc - `((To . ,(or to "")) (Subject . ,(or subject ""))) - ;; C-h f compose-mail says that headers should be specified as - ;; (string . value); however all the rest of message expects - ;; headers to be symbols, not strings (eg message-header-format-alist). - ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html - ;; We need to convert any string input, eg from rmail-start-mail. - (dolist (h other-headers other-headers) - (if (stringp (car h)) (setcar h (intern (capitalize (car h))))))) - yank-action send-actions continue switch-function - return-action))) + (let ((message-this-is-mail t) + message-buffers) + ;; Search for the existing message buffer if `continue' is non-nil. + (if (and continue + (setq message-buffers (message-buffers))) + (pop-to-buffer (car message-buffers)) + ;; Start a new buffer. + (unless (message-mail-user-agent) + (message-pop-to-buffer (message-buffer-name "mail" to) switch-function)) + (message-setup + (nconc + `((To . ,(or to "")) (Subject . ,(or subject ""))) + ;; C-h f compose-mail says that headers should be specified as + ;; (string . value); however all the rest of message expects + ;; headers to be symbols, not strings (eg message-header-format-alist). + ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html + ;; We need to convert any string input, eg from rmail-start-mail. + (dolist (h other-headers other-headers) + (if (stringp (car h)) (setcar h (intern (capitalize (car h))))))) + yank-action send-actions continue switch-function + return-action)))) ;;;###autoload (defun message-news (&optional newsgroups subject) |