:type 'regexp
:group 'message-various)
-(defcustom message-elide-elipsis "\n[...]\n\n"
+(defcustom message-elide-ellipsis "\n[...]\n\n"
"*The string which is inserted for elided text."
:type 'string
:group 'message-various)
:type '(radio (function-item message-forward-subject-author-subject)
(function-item message-forward-subject-fwd)))
+(defcustom message-forward-as-mime t
+ "*If non-nil, forward messages as an inline/rfc822 MIME section. Otherwise, directly inline the old message in the forwarded message."
+ :group 'message-forwarding
+ :type 'boolean)
+
(defcustom message-wash-forwarded-subjects nil
"*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
:group 'message-forwarding
:group 'message-interface
:type 'regexp)
-
(defcustom message-forward-ignored-headers nil
"*All headers that match this regexp will be deleted when forwarding a message."
:group 'message-forwarding
(const use)
(const ask)))
-;; stuff relating to broken sendmail in MMDF
(defcustom message-sendmail-f-is-evil nil
- "*Non-nil means that \"-f username\" should not be added to the sendmail
-command line, because it is even more evil than leaving it out."
+ "*Non-nil means that \"-f username\" should not be added to the sendmail command line.
+Doing so would be even more evil than leaving it out."
:group 'message-sending
:type 'boolean)
:group 'message-sending
:type '(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.")
+
(defvar gnus-post-method)
(defvar gnus-select-method)
(defcustom message-post-method
"^ *---+ +Original message +---+ *$\\|"
"^ *--+ +begin message +--+ *$\\|"
"^ *---+ +Original message follows +---+ *$\\|"
+ "^ *---+ +Undelivered message follows +---+ *$\\|"
"^|? *---+ +Message text follows: +---+ *|?$")
"A regexp that matches the separator before the text of a failed message.")
(when value
(while (string-match "\n[\t ]+" value)
(setq value (replace-match " " t t value)))
- ;; We remove all text props.delete-region
+ ;; We remove all text props.
(format "%s" value))))
(defun message-narrow-to-field ()
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
(define-key message-mode-map "\C-c\C-y" 'message-yank-original)
+ (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
(define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
(define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
(define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
C-c C-v message-delete-not-region (remove the text outside the region).
C-c C-z message-kill-to-signature (kill the text up to the signature).
C-c C-r message-caesar-buffer-body (rot13 the message body).
-C-c C-a mml-attach-file (attach a file as MIME)."
+C-c C-a mml-attach-file (attach a file as MIME).
+M-RET message-newline-and-reformat (break the line and reformat)."
(interactive)
(kill-all-local-variables)
(set (make-local-variable 'message-reply-buffer) nil)
(defun message-newline-and-reformat ()
"Insert four newlines, and then reformat if inside quoted text."
(interactive)
- (let ((point (point))
- quoted)
- (save-excursion
- (beginning-of-line)
- (if (looking-at (sc-cite-regexp))
- (setq quoted (buffer-substring (match-beginning 0) (match-end 0)))))
- (insert "\n\n\n\n")
+ (let ((prefix "[]>ยป|:}+ \t]*")
+ (supercite-thing "[-._a-zA-Z0-9]*[>]+[ \t]*")
+ quoted point)
+ (unless (bolp)
+ (save-excursion
+ (beginning-of-line)
+ (when (looking-at (concat prefix
+ supercite-thing))
+ (setq quoted (match-string 0))))
+ (insert "\n"))
+ (setq point (point))
+ (insert "\n\n\n")
(delete-region (point) (re-search-forward "[ \t]*"))
(when quoted
(insert quoted))
(fill-paragraph nil)
(goto-char point)
- (forward-line 2)))
+ (forward-line 1)))
(defun message-insert-signature (&optional force)
"Insert a signature. See documentation for the `message-signature' variable."
(defun message-elide-region (b e)
"Elide the text between point and mark.
-An ellipsis (from `message-elide-elipsis') will be inserted where the
+An ellipsis (from `message-elide-ellipsis') will be inserted where the
text was killed."
(interactive "r")
(kill-region b e)
- (unless (bolp)
- (insert "\n"))
- (insert message-elide-elipsis))
+ (insert message-elide-ellipsis))
(defvar message-caesar-translation-table nil)
(unless (equal 0 (call-process-region
(point-min) (point-max) program t t))
(insert body)
- (message "%s failed." program))))))
+ (message "%s failed" program))))))
(defun message-rename-buffer (&optional enter-string)
"Rename the *message* buffer to \"*message* RECIPIENT\".
(unless modified
(setq message-checksum (message-checksum))))))
+(defun message-yank-buffer (buffer)
+ "Insert BUFFER into the current buffer and quote it."
+ (interactive "bYank buffer: ")
+ (let ((message-reply-buffer buffer))
+ (save-window-excursion
+ (message-yank-original))))
+
+(defun message-buffers ()
+ "Return a list of active message buffers."
+ (let (buffers)
+ (save-excursion
+ (dolist (buffer (buffer-list t))
+ (set-buffer buffer)
+ (when (and (eq major-mode 'message-mode)
+ (null message-sent-message-via))
+ (push (buffer-name buffer) buffers))))
+ (nreverse buffers)))
+
(defun message-cite-original-without-signature ()
"Cite function in the standard Message manner."
(let ((start (point))
(defun message-send-mail-with-sendmail ()
"Send off the prepared buffer with sendmail."
(let ((errbuf (if message-interactive
- (generate-new-buffer " sendmail errors")
+ (message-generate-new-buffer-clone-locals " sendmail errors")
0))
resend-to-addresses delimline)
(let ((case-fold-search t))
;; But some systems are more broken with -f, so
;; we'll let users override this.
(if (null message-sendmail-f-is-evil)
- (list "-f" (user-login-name)))
+ (list "-f" (message-make-address)))
;; These mean "report errors by mail"
;; and "deliver in background".
(if (null message-interactive) '("-oem" "-odb"))
(defun message-fill-header (header value)
(let ((begin (point))
- (fill-column 990)
+ (fill-column 78)
(fill-prefix "\t"))
(insert (capitalize (symbol-name header))
": "
(replace-match " " t t))
(goto-char (point-max)))))
+(defun message-shorten-1 (list cut surplus)
+ ;; Cut SURPLUS elements out of LIST, beginning with CUTth one.
+ (setcdr (nthcdr (- cut 2) list)
+ (nthcdr (+ (- cut 2) surplus 1) list)))
+
(defun message-shorten-references (header references)
- "Limit REFERENCES to be shorter than 988 characters."
- (let ((max 988)
- (cut 4)
+ "Trim REFERENCES to be less than 31 Message-ID long, 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."
+ (let ((maxcount 31)
+ (count 0)
+ (cut 6)
refs)
(with-temp-buffer
(insert references)
(goto-char (point-min))
+ ;; Cons a list of valid references.
(while (re-search-forward "<[^>]+>" nil t)
(push (match-string 0) refs))
- (setq refs (nreverse refs))
- (while (> (length (mapconcat 'identity refs " ")) max)
- (when (< (length refs) (1+ cut))
- (decf cut))
- (setcdr (nthcdr cut refs) (cddr (nthcdr cut refs)))))
- (insert (capitalize (symbol-name header)) ": "
- (mapconcat 'identity refs " ") "\n")))
+ (setq refs (nreverse refs)
+ count (length refs)))
+
+ ;; If the list has more than MAXCOUNT elements, trim it by
+ ;; removing the CUTth element and the required number of
+ ;; elements that follow.
+ (when (> count maxcount)
+ (let ((surplus (- count maxcount)))
+ (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 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))))
+
+ ;; Finally, collect the references back into a string and insert
+ ;; it into the buffer.
+ (let ((refstring (mapconcat #'identity refs " ")))
+ (if message-cater-to-broken-inn
+ (insert (capitalize (symbol-name header)) ": "
+ refstring "\n")
+ (message-fill-header header refstring)))))
(defun message-position-point ()
"Move point to where the user probably wants to find it."
;; Put point where we want it before inserting the forwarded
;; message.
(message-goto-body)
- (insert "\n\n<#part type=message/rfc822 disposition=inline>\n")
+ (if message-forward-as-mime
+ (insert "\n\n<#part type=message/rfc822 disposition=inline>\n")
+ (insert "\n\n"))
(let ((b (point))
e)
(mml-insert-buffer cur)
(setq e (point))
- (insert "<#/part>\n")
- (when message-forward-ignored-headers
+ (and message-forward-as-mime
+ (insert "<#/part>\n"))
+ (when (and (not current-prefix-arg)
+ message-forward-ignored-headers)
(save-restriction
(narrow-to-region b e)
- (message-narrow-to-head)
+ (goto-char b)
+ (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point)))
(message-remove-header message-forward-ignored-headers t))))
(message-position-point)))
;;;###autoload
(defun message-resend (address)
"Resend the current article to ADDRESS."
- (interactive "sResend message to: ")
+ (interactive
+ (list (message-read-from-minibuffer "Resend message to: ")))
(message "Resending message to %s..." address)
(save-excursion
(let ((cur (current-buffer))
(let ((oldbuf (current-buffer)))
(save-excursion
(set-buffer (generate-new-buffer name))
- (message-clone-locals oldbuf)
+ (message-clone-locals oldbuf varstr)
(current-buffer))))
-(defun message-clone-locals (buffer)
+(defun message-clone-locals (buffer &optional varstr)
"Clone the local variables from BUFFER to the current buffer."
(let ((locals (save-excursion
(set-buffer buffer)
(buffer-local-variables)))
- (regexp "^gnus\\|^nn\\|^message"))
+ (regexp "^gnus\\|^nn\\|^message\\|^user-mail-address"))
(mapcar
(lambda (local)
(when (and (consp local)
(car local)
- (string-match regexp (symbol-name (car local))))
+ (string-match regexp (symbol-name (car local)))
+ (or (null varstr)
+ (string-match varstr (symbol-name (car local)))))
(ignore-errors
(set (make-local-variable (car local))
(cdr local)))))
(delete-char 1)
(search-forward "\n\n")
(setq lines (buffer-substring (point-min) (1- (point))))
- (delete-region (point-min) (point))))))
+ (delete-region (point-min) (point))))))
(save-restriction
(message-narrow-to-headers-or-head)
(message-remove-header "Mime-Version")
(forward-line 1)
(insert "Content-Type: text/plain; charset=us-ascii\n")))))
+(defun message-read-from-minibuffer (prompt)
+ "Read from the minibuffer while providing abbrev expansion."
+ (if (fboundp 'mail-abbrevs-setup)
+ (let ((mail-abbrev-mode-regexp "")
+ (minibuffer-setup-hook 'mail-abbrevs-setup))
+ (read-from-minibuffer prompt)))
+ (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
+ (read-string prompt)))
+
(provide 'message)
(run-hooks 'message-load-hook)
projects / gnus / blobdiff