(require 'mml))
(require 'rfc822)
-(eval-and-compile
- (autoload 'customize-save-variable "cus-edit") ;; for Mule 2.
- (autoload 'sha1 "sha1-el")
- (autoload 'gnus-find-method-for-group "gnus")
- (autoload 'nnvirtual-find-group-art "nnvirtual")
- (autoload 'gnus-group-decoded-name "gnus-group"))
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
:type '(choice (function)
(repeat string)))
-(defvar message-cater-to-broken-inn t
- "Non-nil means Gnus should not fold the `References' header.
-Folding `References' makes ancient versions of INN create incorrect
-NOV lines.")
-
(eval-when-compile
(defvar gnus-post-method)
(defvar gnus-select-method))
;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138
(defcustom message-generate-headers-first '(references)
"Which headers should be generated before starting to compose a message.
-If `t', generate all required headers. This can also be a list of headers to
+If t, generate all required headers. This can also be a list of headers to
generate. The variables `message-required-news-headers' and
`message-required-mail-headers' specify which headers to generate.
:type 'regexp)
(eval-and-compile
- (autoload 'message-setup-toolbar "messagexmas")
- (autoload 'mh-new-draft-name "mh-comp")
- (autoload 'mh-send-letter "mh-comp")
- (autoload 'gnus-output-to-rmail "gnus-util")
- (autoload 'gnus-output-to-mail "gnus-util")
- (autoload 'nndraft-request-associate-buffer "nndraft")
- (autoload 'nndraft-request-expire-articles "nndraft")
- (autoload 'gnus-open-server "gnus-int")
- (autoload 'gnus-request-post "gnus-int")
- (autoload 'gnus-copy-article-buffer "gnus-msg")
(autoload 'gnus-alive-p "gnus-util")
- (autoload 'gnus-server-string "gnus")
+ (autoload 'gnus-delay-article "gnus-delay")
+ (autoload 'gnus-extract-address-components "gnus-util")
+ (autoload 'gnus-find-method-for-group "gnus")
+ (autoload 'gnus-group-decoded-name "gnus-group")
(autoload 'gnus-group-name-charset "gnus-group")
(autoload 'gnus-group-name-decode "gnus-group")
(autoload 'gnus-groups-from-server "gnus")
- (autoload 'rmail-output "rmailout")
- (autoload 'gnus-delay-article "gnus-delay")
(autoload 'gnus-make-local-hook "gnus-util")
- (autoload 'gnus-extract-address-components "gnus-util"))
+ (autoload 'gnus-open-server "gnus-int")
+ (autoload 'gnus-output-to-mail "gnus-util")
+ (autoload 'gnus-output-to-rmail "gnus-util")
+ (autoload 'gnus-request-post "gnus-int")
+ (autoload 'gnus-server-string "gnus")
+ (autoload 'idna-to-ascii "idna")
+ (autoload 'message-setup-toolbar "messagexmas")
+ (autoload 'mh-new-draft-name "mh-comp")
+ (autoload 'mh-send-letter "mh-comp")
+ (autoload 'mu-cite-original "mu-cite")
+ (autoload 'nndraft-request-associate-buffer "nndraft")
+ (autoload 'nndraft-request-expire-articles "nndraft")
+ (autoload 'nnvirtual-find-group-art "nnvirtual")
+ (autoload 'rmail-dont-reply-to "mail-utils")
+ (autoload 'rmail-msg-is-pruned "rmail")
+ (autoload 'rmail-msg-restore-non-pruned-header "rmail")
+ (autoload 'rmail-output "rmailout"))
-(eval-and-compile
- (autoload 'mu-cite-original "mu-cite"))
+(eval-when-compile
+ (autoload 'sha1 "sha1-el"))
\f
The buffer is expected to be narrowed to just the header of the message;
see `message-narrow-to-headers-or-head'."
(let* ((inhibit-point-motion-hooks t)
- (case-fold-search t)
(value (mail-fetch-field header nil (not not-all))))
(when value
(while (string-match "\n[\t ]+" value)
(progn
(forward-line 1)
(if (re-search-forward "^[^ \n\t]" nil t)
- (progn
- (beginning-of-line)
- (point))
+ (point-at-bol)
(point-max))))
(goto-char (point-min)))
(1+ max)))))
(message-sort-headers-1))))
+(defun message-delete-address ()
+ "Delete the address under point."
+ (interactive)
+ (let ((start (point))
+ (quote nil))
+ (message-narrow-to-field)
+ (while (and (not (eobp))
+ (or (not (eq (setq char (following-char)) ?,))
+ (not quote)))
+ ())))
+
\f
;;;
(setq message-parameter-alist
(copy-sequence message-startup-parameter-alist))
(message-setup-fill-variables)
- (set
- (make-local-variable 'paragraph-separate)
- (format "\\(%s\\)\\|\\(%s\\)"
- paragraph-separate
- "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)"))
;; Allow using comment commands to add/remove quoting.
(set (make-local-variable 'comment-start) message-yank-prefix)
(if (featurep 'xemacs)
"---+$\\|" ; delimiters for forwarded messages
page-delimiter "$\\|" ; spoiler warnings
".*wrote:$\\|" ; attribution lines
- quote-prefix-regexp "$")) ; empty lines in quoted text
+ quote-prefix-regexp "$\\|" ; empty lines in quoted text
+ mime-edit-tag-regexp)) ; MIME-Edit tags
(setq paragraph-separate paragraph-start)
(setq adaptive-fill-regexp
(concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
(when (message-goto-signature)
(forward-line -2)))
-(defun message-kill-to-signature ()
- "Deletes all text up to the signature."
- (interactive)
- (let ((point (point)))
- (message-goto-signature)
- (unless (eobp)
- (end-of-line -1))
- (kill-region point (point))
- (unless (bolp)
- (insert "\n"))))
+(defun message-kill-to-signature (&optional arg)
+ "Kill all text up to the signature.
+If a numberic argument or prefix arg is given, leave that number
+of lines before the signature intact."
+ (interactive "p")
+ (save-excursion
+ (save-restriction
+ (let ((point (point)))
+ (narrow-to-region point (point-max))
+ (message-goto-signature)
+ (unless (eobp)
+ (if (and arg (numberp arg))
+ (forward-line (- -1 arg))
+ (end-of-line -1)))
+ (unless (= point (point))
+ (kill-region point (point))
+ (insert "\n"))))))
(defun message-newline-and-reformat (&optional arg not-break)
"Insert four newlines, and then reformat if inside quoted text.
"Send the prepared message buffer with `smtpmail-send-it'.
This only differs from `smtpmail-send-it' that this command evaluates
`message-send-mail-hook' just before sending a message. It is useful
-if your ISP requires the POP-before-SMTP authentication. See the
-documentation for the function `mail-source-touch-pop'."
+if your ISP requires the POP-before-SMTP authentication. See the Gnus
+manual for details."
(run-hooks 'message-send-mail-hook)
(smtpmail-send-it))
(delete-region (match-beginning 0) (1+ (std11-field-end)))))))
message-user-agent)
-(defun message-idna-inside-rhs-p ()
- "Return t iff point is inside a RHS (heuristically).
-Only works properly if header contains mailbox-list or address-list.
-I.e., calling it on a Subject: header is useless."
- (save-restriction
- (narrow-to-region (save-excursion (or (re-search-backward "^[^ \t]" nil t)
- (point-min)))
- (save-excursion (or (re-search-forward "^[^ \t]" nil t)
- (point-max))))
- (if (re-search-backward "[\\\n\r\t ]"
- (save-excursion (search-backward "@" nil t)) t)
- ;; whitespace between @ and point
- nil
- (let ((dquote 1) (paren 1))
- (while (save-excursion (re-search-backward "[^\\]\"" nil t dquote))
- (incf dquote))
- (while (save-excursion (re-search-backward "[^\\]\(" nil t paren))
- (incf paren))
- (and (= (% dquote 2) 1) (= (% paren 2) 1))))))
-
-(autoload 'idna-to-ascii "idna")
-
(defun message-idna-to-ascii-rhs-1 (header)
"Interactively potentially IDNA encode domain names in HEADER."
- (let (rhs ace start startpos endpos ovl)
- (goto-char (point-min))
- (while (re-search-forward (concat "^" header) nil t)
- (while (re-search-forward "@\\([^ \t\r\n>,]+\\)"
- (or (save-excursion
- (re-search-forward "^[^ \t]" nil t))
- (point-max))
- t)
- (setq rhs (match-string-no-properties 1)
- startpos (match-beginning 1)
- endpos (match-end 1))
- (when (save-match-data
- (and (message-idna-inside-rhs-p)
- (setq ace (idna-to-ascii rhs))
- (not (string= rhs ace))
- (if (eq message-use-idna 'ask)
- (unwind-protect
- (progn
- (setq ovl (message-make-overlay startpos
- endpos))
- (message-overlay-put ovl 'face 'highlight)
- (y-or-n-p
- (format "Replace with `%s'? " ace)))
- (message "")
- (message-delete-overlay ovl))
- message-use-idna)))
- (replace-match (concat "@" ace)))))))
+ (let ((field (message-fetch-field header))
+ rhs ace address)
+ (when field
+ (dolist (address (mail-header-parse-addresses field))
+ (setq address (car address)
+ rhs (cadr (split-string address "@"))
+ ace (idna-to-ascii rhs))
+ (when (and (not (equalp rhs ace))
+ (or (not (eq message-use-idna 'ask))
+ (y-or-n-p (format "Replace %s with %s? " rhs ace))))
+ (goto-char (point-min))
+ (while (re-search-forward (concat "^" header ":") nil t)
+ (message-narrow-to-field)
+ (while (search-forward (concat "@" rhs) nil t)
+ (replace-match (concat "@" ace) t t))
+ (goto-char (point-max))
+ (widen)))))))
(defun message-idna-to-ascii-rhs ()
"Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers.
(defun message-shorten-references (header references)
"Trim REFERENCES to be 21 Message-ID long or less, and fold them.
-If folding is disallowed, also check that the REFERENCES are less
-than 988 characters long, and if they are not, trim them until they are."
+When sending via news, also check that the REFERENCES are less
+than 988 characters long, and if they are not, trim them until
+they are."
(let ((maxcount 21)
(count 0)
(cut 2)
(message-shorten-1 refs cut surplus)
(decf count surplus)))
- ;; If folding is disallowed, make sure the total length (including
- ;; the spaces between) will be less than MAXSIZE characters.
+ ;; When sending via news, make sure the total folded length will
+ ;; be less than 998 characters. This is to cater to broken INN
+ ;; 2.3 which counts the total number of characters in a header
+ ;; rather than the physical line length of each line, as it shuld.
;;
- ;; Only disallow folding for News messages. At this point the headers
- ;; have not been generated, thus we use message-this-is-news directly.
- (when (and message-this-is-news message-cater-to-broken-inn)
- (let ((maxsize 988)
- (totalsize (+ (apply #'+ (mapcar #'length refs))
- (1- count)))
- (surplus 0)
- (ptr (nthcdr (1- cut) refs)))
- ;; Decide how many elements to cut off...
- (while (> totalsize maxsize)
- (decf totalsize (1+ (length (car ptr))))
- (incf surplus)
- (setq ptr (cdr ptr)))
- ;; ...and do it.
- (when (> surplus 0)
- (message-shorten-1 refs cut surplus))))
-
+ ;; This hack should be removed when it's believed than INN 2.3 is
+ ;; no longer widely used.
+ ;;
+ ;; At this point the headers have not been generated, thus we use
+ ;; message-this-is-news directly.
+ (when message-this-is-news
+ (while (< 998
+ (with-temp-buffer
+ (message-fill-header header (mapconcat #'identity refs " "))
+ (buffer-size)))
+ (message-shorten-1 refs cut 1)))
;; Finally, collect the references back into a string and insert
;; it into the buffer.
- (let ((refstring (mapconcat #'identity refs " ")))
- (if (and message-this-is-news message-cater-to-broken-inn)
- (insert (capitalize (symbol-name header)) ": "
- refstring "\n")
- (message-fill-header header refstring)))))
+ (message-fill-header header (mapconcat #'identity refs " "))))
(defun message-position-point ()
"Move point to where the user probably wants to find it."
(when message-default-headers
(insert message-default-headers)
(or (bolp) (insert ?\n)))
- (put-text-property
- (point)
- (progn
- (insert mail-header-separator "\n")
- (1- (point)))
- 'read-only nil)
+ (insert mail-header-separator "\n")
(forward-line -1)
(when (message-news-p)
(when message-default-news-headers
(defun message-forward-rmail-make-body (forward-buffer)
(save-window-excursion
(set-buffer forward-buffer)
- ;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs
- ;; 20. FIXIT, or we drop support for rmail in Emacs 20.
(if (rmail-msg-is-pruned)
(rmail-msg-restore-non-pruned-header)))
(message-forward-make-body forward-buffer))
(if (eq (char-after) (char-after (- (point) 2)))
(delete-char -2))))))
-(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
+(defun message-exchange-point-and-mark ()
+ "Exchange point and mark, but don't activate region if it was inactive."
+ (unless (prog1
+ (message-mark-active-p)
+ (exchange-point-and-mark))
+ (setq mark-active nil)))
+
(defalias 'message-make-overlay 'make-overlay)
(defalias 'message-delete-overlay 'delete-overlay)
(defalias 'message-overlay-put 'overlay-put)