: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
+ :type '(choice (const :tag "None" nil)
+ regexp))
+
(defcustom message-ignored-cited-headers "."
"*Delete these headers from the messages you yank."
:group 'message-insertion
:group 'message
:type 'symbol)
+(defcustom message-dont-reply-to-names rmail-dont-reply-to-names
+ "*A regexp specifying names to prune when doing wide replies.
+A value of nil means exclude your own name only."
+ :group 'message
+ :type '(choice (const :tag "Yourself" nil)
+ regexp))
+
;;; Internal variables.
;;; Well, not really internal.
"Coding system to encode outgoing mail.")
(defvar message-draft-coding-system
- (cond
- ((not (fboundp 'coding-system-p)) nil)
- ((coding-system-p 'emacs-mule)
- (if (string-match "nt\\|windows" system-configuration)
- 'emacs-mule-dos 'emacs-mule))
- ((memq 'escape-quoted (mm-get-coding-system-list)) 'escape-quoted)
- ((coding-system-p 'no-conversion) 'no-conversion)
- (t nil))
+ mm-auto-save-coding-system
"Coding system to compose mail.")
;;; Internal variables.
"^ *---+ +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.")
(file-readable-p file)
(file-regular-p file))
(with-temp-buffer
- (mm-insert-file-contents file)
+ (nnheader-insert-file-contents file)
(goto-char (point-min))
(looking-at message-unix-mail-delimiter))))
(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 ()
(insert (car headers) ?\n))))
(setq headers (cdr headers))))
+
(defun message-fetch-reply-field (header)
"Fetch FIELD from the message we're replying to."
(when (and message-reply-buffer
(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\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)
'(message-font-lock-keywords t)))
(make-local-variable 'adaptive-fill-regexp)
(setq adaptive-fill-regexp
- (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-regexp))
+ (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|" adaptive-fill-regexp))
(unless (boundp 'adaptive-fill-first-line-regexp)
(setq adaptive-fill-first-line-regexp nil))
(make-local-variable 'adaptive-fill-first-line-regexp)
(setq adaptive-fill-first-line-regexp
- (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|"
+ (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
adaptive-fill-first-line-regexp))
(mm-enable-multibyte)
(make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
"Move point to the end of the headers."
(interactive)
(message-goto-body)
- (forward-line -2))
+ (forward-line -1))
(defun message-goto-signature ()
"Move point to the beginning of the message signature.
(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)
- (setq quoted (looking-at (regexp-quote message-yank-prefix))))
- (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 message-yank-prefix))
+ (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))
elem sent)
(while (and success
(setq elem (pop alist)))
- (when (and (or (not (funcall (cadr elem)))
- (and (or (not (memq (car elem)
- message-sent-message-via))
- (y-or-n-p
- (format
- "Already sent message via %s; resend? "
- (car elem))))
- (setq success (funcall (caddr elem) arg)))))
+ (when (or (not (funcall (cadr elem)))
+ (and (or (not (memq (car elem)
+ message-sent-message-via))
+ (y-or-n-p
+ (format
+ "Already sent message via %s; resend? "
+ (car elem))))
+ (setq success (funcall (caddr elem) arg))))
(setq sent t)))
- (unless sent
+ (unless (or sent (not success))
(error "No methods specified to send by"))
(when (and success sent)
(message-do-fcc)
- ;;(when (fboundp 'mail-hist-put-headers-into-history)
- ;; (mail-hist-put-headers-into-history))
(save-excursion
(run-hooks 'message-sent-hook))
(message "Sending...done")
parse-time-months))))
(format-time-string "%Y %H:%M:%S " now)
;; We do all of this because XEmacs doesn't have the %z spec.
- (format "%s%02d%02d" sign (/ zone 3600) (% zone 3600)))))
+ (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60)))))
(defun message-make-message-id ()
"Make a unique Message-ID."
(while (re-search-forward "[ \t]+" nil t)
(replace-match " " t t))
;; Remove addresses that match `rmail-dont-reply-to-names'.
- (insert (prog1 (rmail-dont-reply-to (buffer-string))
- (erase-buffer)))
+ (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
+ (insert (prog1 (rmail-dont-reply-to (buffer-string))
+ (erase-buffer))))
(goto-char (point-min))
;; Perhaps Mail-Copies-To: never removed the only address?
(when (eobp)
;; Put point where we want it before inserting the forwarded
;; message.
(message-goto-body)
- (insert "\n\n<#part type=message/rfc822 disposition=inline>\n")
- (mml-insert-buffer cur)
- (insert "<#/part>\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))
+ (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)
+ (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))
contains some mail you have written which has been bounced back to
you."
(interactive)
- (let ((cur (current-buffer))
+ (let ((handles (mm-dissect-buffer t))
boundary)
(message-pop-to-buffer (message-buffer-name "bounce"))
- (insert-buffer-substring cur)
- (undo-boundary)
- (message-narrow-to-head)
- (if (and (message-fetch-field "Mime-Version")
- (setq boundary (message-fetch-field "Content-Type")))
- (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary)
- (setq boundary (concat (match-string 1 boundary) " *\n"
- "Content-Type: message/rfc822"))
- (setq boundary nil)))
- (widen)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (or (and boundary
- (re-search-forward boundary nil t)
- (forward-line 2))
- (and (re-search-forward message-unsent-separator nil t)
- (forward-line 1))
- (re-search-forward "^Return-Path:.*\n" nil t))
- ;; We remove everything before the bounced mail.
- (delete-region
- (point-min)
- (if (re-search-forward "^[^ \n\t]+:" nil t)
- (match-beginning 0)
- (point)))
+ (if (stringp (car handles))
+ ;; This is a MIME bounce.
+ (mm-insert-part (car (last handles)))
+ ;; This is a non-MIME bounce, so we try to remove things
+ ;; manually.
+ (mm-insert-part handles)
+ (undo-boundary)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (or (and (re-search-forward message-unsent-separator nil t)
+ (forward-line 1))
+ (re-search-forward "^Return-Path:.*\n" nil t))
+ ;; We remove everything before the bounced mail.
+ (delete-region
+ (point-min)
+ (if (re-search-forward "^[^ \n\t]+:" nil t)
+ (match-beginning 0)
+ (point))))
(save-restriction
(message-narrow-to-head)
(message-remove-header message-ignored-bounced-headers t)
(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 / elisp / gnus.git- / blobdiff