;;; Code:
-(require 'cl)
+(eval-when-compile (require 'cl))
+
(require 'mailheader)
-(require 'rmail)
+(condition-case nil
+ (require 'rmail)
+ (t (message "Ignore any errors about rmail from this file")))
(require 'nnheader)
(require 'timezone)
(require 'easymenu)
Checks include subject-cmsg multiple-headers sendsys message-id from
long-lines control-chars size new-text redirected-followup signature
approved sender empty empty-headers message-id from subject
-shorten-followup-to existing-newsgroups."
+shorten-followup-to existing-newsgroups buffer-file-name unchanged."
:group 'message-news)
(defcustom message-required-news-headers
:type 'sexp)
(defcustom message-ignored-news-headers
- "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:\\|^Resent-Fcc:"
+ "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:"
"*Regexp of headers to be removed unconditionally before posting."
:group 'message-news
:group 'message-headers
:type 'regexp)
-(defcustom message-ignored-mail-headers "^Gcc:\\|^Fcc:\\|^Resent-Fcc:"
+(defcustom message-ignored-mail-headers "^[GF]cc:\\|^Resent-Fcc:"
"*Regexp of headers to be removed unconditionally before mailing."
:group 'message-mail
:group 'message-headers
:type 'regexp)
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:\\|^Supersedes:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|X-Trace:\\|X-Complaints-To:\\|Return-Path:\\|^Supersedes:"
"*Header lines matching this regexp will be deleted before posting.
It's best to delete old Path and Date headers before posting to avoid
any confusion."
:type 'file
:group 'message-headers)
-(defcustom message-autosave-directory "~/"
- ; (concat (file-name-as-directory message-directory) "drafts/")
- "*Directory where message autosaves buffers.
-If nil, message won't autosave."
+(defcustom message-autosave-directory
+ (nnheader-concat message-directory "drafts/")
+ "*Directory where Message autosaves buffers.
+If nil, Message won't autosave."
:group 'message-buffers
:type 'directory)
:type 'boolean)
(defcustom message-included-forward-headers
- "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:"
+ "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:"
"*Regexp matching headers to be included in forwarded messages."
:group 'message-forwarding
:type 'regexp)
(defvar message-postpone-actions nil
"A list of actions to be performed after postponing a message.")
+(define-widget 'message-header-lines 'text
+ "All header lines must be LFD terminated."
+ :valid-regexp "^\\'"
+ :error "All header lines must be newline terminated")
+
(defcustom message-default-headers ""
"*A string containing header lines to be inserted in outgoing messages.
It is inserted before you edit the message, so you can edit or delete
these lines."
:group 'message-headers
- :type 'string)
+ :type 'message-header-lines)
(defcustom message-default-mail-headers ""
"*A string of header lines to be inserted in outgoing mails."
:group 'message-headers
:group 'message-mail
- :type 'string)
+ :type 'message-header-lines)
(defcustom message-default-news-headers ""
"*A string of header lines to be inserted in outgoing news
articles."
:group 'message-headers
:group 'message-news
- :type 'string)
+ :type 'message-header-lines)
;; Note: could use /usr/ucb/mail instead of sendmail;
;; options -t, and -v if not interactive.
:group 'message-sending
:type 'sexp)
-(ignore-errors
- (define-mail-user-agent 'message-user-agent
- 'message-mail 'message-send-and-exit
- 'message-kill-buffer 'message-send-hook))
+;; Ignore errors in case this is used in Emacs 19.
+;; Don't use ignore-errors because this is copied into loaddefs.el.
+;;;###autoload
+(condition-case nil
+ (define-mail-user-agent 'message-user-agent
+ 'message-mail 'message-send-and-exit
+ 'message-kill-buffer 'message-send-hook)
+ (error nil))
(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
"If non-nil, delete the deletable headers before feeding to mh.")
(defface message-header-other-face
'((((class color)
(background dark))
- (:foreground "red4"))
+ (:foreground "#b00000"))
(((class color)
(background light))
(:foreground "steel blue"))
(defface message-separator-face
'((((class color)
(background dark))
- (:foreground "blue4"))
+ (:foreground "blue3"))
(((class color)
(background light))
(:foreground "brown"))
(defvar message-buffer-list nil)
(defvar message-this-is-news nil)
(defvar message-this-is-mail nil)
+(defvar message-draft-article nil)
;; Byte-compiler warning
(defvar gnus-active-hashtb)
(defvar gnus-read-active-file)
;;; Regexp matching the delimiter of messages in UNIX mail format
-;;; (UNIX From lines), minus the initial ^.
+;;; (UNIX From lines), minus the initial ^. It should be a copy
+;;; of rmail.el's rmail-unix-mail-delimiter.
(defvar message-unix-mail-delimiter
(let ((time-zone-regexp
(concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
(concat
"From "
- ;; Username, perhaps with a quoted section that can contain spaces.
- "\\("
- "[^ \n]*"
- "\\(\\|\".*\"[^ \n]*\\)"
- "\\|<[^<>\n]+>"
- "\\) ?"
+ ;; Many things can happen to an RFC 822 mailbox before it is put into
+ ;; a `From' line. The leading phrase can be stripped, e.g.
+ ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g.
+ ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF
+ ;; can be removed, e.g.
+ ;; From: joe@y.z (Joe K
+ ;; User)
+ ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and
+ ;; From: Joe User
+ ;; <joe@y.z>
+ ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'.
+ ;; The mailbox can be removed or be replaced by white space, e.g.
+ ;; From: "Joe User"{space}{tab}
+ ;; <joe@y.z>
+ ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996',
+ ;; where {space} and {tab} represent the Ascii space and tab characters.
+ ;; We want to match the results of any of these manglings.
+ ;; The following regexp rejects names whose first characters are
+ ;; obviously bogus, but after that anything goes.
+ "\\([^\0-\b\n-\r\^?].*\\)? "
;; The time the message was sent.
- "\\([^ \n]*\\) *" ; day of the week
- "\\([^ ]*\\) *" ; month
- "\\([0-9]*\\) *" ; day of month
- "\\([0-9:]*\\) *" ; time of day
+ "\\([^\0-\r \^?]+\\) +" ; day of the week
+ "\\([^\0-\r \^?]+\\) +" ; month
+ "\\([0-3]?[0-9]\\) +" ; day of month
+ "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
;; Perhaps a time zone, specified by an abbreviation, or by a
;; numeric offset.
time-zone-regexp
;; The year.
- " [0-9][0-9]\\([0-9]*\\) *"
+ " \\([0-9][0-9]+\\) *"
;; On some systems the time zone can appear after the year, too.
time-zone-regexp
;; Old uucp cruft.
"\\(remote from .*\\)?"
- "\n")))
+ "\n"))
+ "Regexp matching the delimiter of messages in UNIX mail format.")
(defvar message-unsent-separator
(concat "^ *---+ +Unsent message follows +---+ *$\\|"
(eval-and-compile
(autoload 'message-setup-toolbar "messagexmas")
+ (autoload 'mh-new-draft-name "mh-comp")
(autoload 'mh-send-letter "mh-comp")
(autoload 'gnus-point-at-eol "gnus-util")
(autoload 'gnus-point-at-bol "gnus-util")
(autoload 'gnus-output-to-mail "gnus-util")
(autoload 'gnus-output-to-rmail "gnus-util")
- (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev"))
+ (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
+ (autoload 'nndraft-request-associate-buffer "nndraft")
+ (autoload 'nndraft-request-expire-articles "nndraft"))
\f
"Return non-nil if FORM is funcallable."
(or (and (symbolp form) (fboundp form))
(and (listp form) (eq (car form) 'lambda))
- (compiled-function-p form)))
+ (byte-code-function-p form)))
(defun message-strip-subject-re (subject)
"Remove \"Re:\" from subject lines."
(save-excursion
(save-restriction
(message-narrow-to-headers)
- (message-fetch-field "newsgroups")))))
+ (and (message-fetch-field "newsgroups")
+ (not (message-fetch-field "posted-to")))))))
(defun message-mail-p ()
"Say whether the current buffer contains a mail message."
(define-key message-mode-map "\C-c\C-d" 'message-dont-send)
(define-key message-mode-map "\C-c\C-e" 'message-elide-region)
+ (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
+ (define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
(define-key message-mode-map "\t" 'message-tab))
["Caesar (rot13) Message" message-caesar-buffer-body t]
["Caesar (rot13) Region" message-caesar-region (mark t)]
["Elide Region" message-elide-region (mark t)]
+ ["Delete Outside Region" message-delete-not-region (mark t)]
+ ["Newline and Reformat" message-newline-and-reformat t]
["Rename buffer" message-rename-buffer t]
["Spellcheck" ispell-message t]
"----"
(make-local-variable 'message-exit-actions)
(make-local-variable 'message-kill-actions)
(make-local-variable 'message-postpone-actions)
+ (make-local-variable 'message-draft-article)
+ (make-local-hook 'kill-buffer-hook)
(set-syntax-table message-mode-syntax-table)
(use-local-map message-mode-map)
(setq local-abbrev-table message-mode-abbrev-table)
facemenu-remove-face-function t)
(make-local-variable 'paragraph-separate)
(make-local-variable 'paragraph-start)
- (setq paragraph-start (concat (regexp-quote mail-header-separator)
- "$\\|[ \t]*[-_][-_][-_]+$\\|"
- "-- $\\|"
- paragraph-start))
- (setq paragraph-separate (concat (regexp-quote mail-header-separator)
- "$\\|[ \t]*[-_][-_][-_]+$\\|"
- "-- $\\|"
- paragraph-separate))
+ (setq paragraph-start
+ (concat (regexp-quote mail-header-separator)
+ "$\\|[ \t]*[-_][-_][-_]+$\\|"
+ "-- $\\|"
+ ;;!!! Uhm... shurely this can't be right.
+ "[> " (regexp-quote message-yank-prefix) "]+$\\|"
+ paragraph-start))
+ (setq paragraph-separate
+ (concat (regexp-quote mail-header-separator)
+ "$\\|[ \t]*[-_][-_][-_]+$\\|"
+ "-- $\\|"
+ "[> " (regexp-quote message-yank-prefix) "]+$\\|"
+ paragraph-separate))
(make-local-variable 'message-reply-headers)
(setq message-reply-headers nil)
(make-local-variable 'message-newsreader)
(if (fboundp 'mail-abbrevs-setup)
(mail-abbrevs-setup)
(funcall (intern "mail-aliases-setup"))))
+ (message-set-auto-save-file-name)
(run-hooks 'text-mode-hook 'message-mode-hook))
\f
;;; Various commands
+(defun message-delete-not-region (beg end)
+ "Delete everything in the body of the current message that is outside of the region."
+ (interactive "r")
+ (save-excursion
+ (goto-char end)
+ (delete-region (point) (progn (message-goto-signature)
+ (forward-line -2)
+ (point)))
+ (insert "\n")
+ (goto-char beg)
+ (delete-region beg (progn (message-goto-body)
+ (forward-line 2)
+ (point))))
+ (message-goto-signature)
+ (forward-line -2))
+
+(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")
+ (when quoted
+ (insert message-yank-prefix))
+ (fill-paragraph nil)
+ (goto-char point)
+ (forward-line 2)))
+
(defun message-insert-signature (&optional force)
"Insert a signature. See documentation for the `message-signature' variable."
(interactive (list 0))
(defun message-caesar-buffer-body (&optional rotnum)
"Caesar rotates all letters in the current buffer by 13 places.
-Used to encode/decode possibly offensive messages (commonly in net.jokes).
+Used to encode/decode possiblyun offensive messages (commonly in net.jokes).
With prefix arg, specifies the number of places to rotate each letter forward.
Mail and USENET news headers are not rotated."
(interactive (if current-prefix-arg
(when (or (not (buffer-modified-p))
(yes-or-no-p "Message modified; kill anyway? "))
(let ((actions message-kill-actions))
+ (setq buffer-file-name nil)
(kill-buffer (current-buffer))
(message-do-actions actions))))
Otherwise any failure is reported in a message back to
the user from the mailer."
(interactive "P")
- (when (if buffer-file-name
+ ;; Disabled test.
+ (when (if (and buffer-file-name
+ nil)
(y-or-n-p (format "Send buffer contents as %s message? "
(if (message-mail-p)
(if (message-news-p) "mail and news" "mail")
"news")))
(or (buffer-modified-p)
+ (message-check-element 'unchanged)
(y-or-n-p "No changes in the buffer; really send? ")))
;; Make it possible to undo the coming changes.
(undo-boundary)
;; (mail-hist-put-headers-into-history))
(run-hooks 'message-sent-hook)
(message "Sending...done")
- ;; If buffer has no file, mark it as unmodified and delete autosave.
- (unless buffer-file-name
- (set-buffer-modified-p nil)
- (delete-auto-save-file-if-necessary t))
+ ;; Mark the buffer as unmodified and delete autosave.
+ (set-buffer-modified-p nil)
+ (delete-auto-save-file-if-necessary t)
+ (message-disassociate-draft)
;; Delete other mail buffers and stuff.
(message-do-send-housekeeping)
(message-do-actions message-send-actions)
;; qmail-inject doesn't say anything on it's stdout/stderr,
;; we have to look at the retval instead
(0 nil)
- (1 (error "qmail-inject reported permanent failure."))
- (111 (error "qmail-inject reported transient failure."))
+ (1 (error "qmail-inject reported permanent failure"))
+ (111 (error "qmail-inject reported transient failure"))
;; should never happen
- (t (error "qmail-inject reported unknown failure."))))
+ (t (error "qmail-inject reported unknown failure"))))
(defun message-send-mail-with-mh ()
"Send the prepared message buffer with mh."
(let ((mh-previous-window-config nil)
- (name (make-temp-name
- (concat (file-name-as-directory
- (expand-file-name message-autosave-directory))
- "msg."))))
+ (name (mh-new-draft-name)))
(setq buffer-file-name name)
;; MH wants to generate these headers itself.
(when message-mh-deletable-headers
(replace-match "\n")
(backward-char 1))
(run-hooks 'message-send-news-hook)
- (require (car method))
- (funcall (intern (format "%s-open-server" (car method)))
- (cadr method) (cddr method))
- (setq result
- (funcall (intern (format "%s-request-post" (car method))))))
+ ;;(require (car method))
+ ;;(funcall (intern (format "%s-open-server" (car method)))
+ ;;(cadr method) (cddr method))
+ ;;(setq result
+ ;; (funcall (intern (format "%s-request-post" (car method)))
+ ;; (cadr method)))
+ (gnus-open-server method)
+ (setq result (gnus-request-post method)))
(kill-buffer tembuf))
(set-buffer messbuf)
(if result
(y-or-n-p
(format "The %s header looks odd: \"%s\". Really post? "
(car headers) header)))))
+ (message-check 'repeated-newsgroups
+ (let ((case-fold-search t)
+ (headers '("Newsgroups" "Followup-To"))
+ header error groups group)
+ (while (and headers
+ (not error))
+ (when (setq header (mail-fetch-field (pop headers)))
+ (setq groups (message-tokenize-header header ","))
+ (while (setq group (pop groups))
+ (when (member group groups)
+ (setq error group
+ groups nil)))))
+ (if (not error)
+ t
+ (y-or-n-p
+ (format "Group %s is repeated in headers. Really post? " error)))))
;; Check the From header.
(message-check 'from
(let* ((case-fold-search t)
(concat "^" (regexp-quote mail-header-separator) "$"))
(while (not (eobp))
(when (not (looking-at "[ \t\n]"))
- (setq sum (logxor (ash sum 1) (following-char))))
+ (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1)
+ (following-char))))
(forward-char 1)))
sum))
;; Remove empty lines in the header.
(save-restriction
(message-narrow-to-headers)
+ ;; Remove blank lines.
(while (re-search-forward "^[ \t]*\n" nil t)
- (replace-match "" t t)))
+ (replace-match "" t t))
- ;; Correct Newsgroups and Followup-To headers: change sequence of
- ;; spaces to comma and eliminate spaces around commas. Eliminate
- ;; embedded line breaks.
- (goto-char (point-min))
- (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t)
- (save-restriction
- (narrow-to-region
- (point)
- (if (re-search-forward "^[^ \t]" nil t)
- (match-beginning 0)
- (forward-line 1)
- (point)))
- (goto-char (point-min))
- (while (re-search-forward "\n[ \t]+" nil t)
- (replace-match " " t t)) ;No line breaks (too confusing)
- (goto-char (point-min))
- (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
- (replace-match "," t t))
- (goto-char (point-min))
- ;; Remove trailing commas.
- (when (re-search-forward ",+$" nil t)
- (replace-match "" t t)))))
+ ;; Correct Newsgroups and Followup-To headers: Change sequence of
+ ;; spaces to comma and eliminate spaces around commas. Eliminate
+ ;; embedded line breaks.
+ (goto-char (point-min))
+ (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t)
+ (save-restriction
+ (narrow-to-region
+ (point)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (match-beginning 0)
+ (forward-line 1)
+ (point)))
+ (goto-char (point-min))
+ (while (re-search-forward "\n[ \t]+" nil t)
+ (replace-match " " t t)) ;No line breaks (too confusing)
+ (goto-char (point-min))
+ (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
+ (replace-match "," t t))
+ (goto-char (point-min))
+ ;; Remove trailing commas.
+ (when (re-search-forward ",+$" nil t)
+ (replace-match "" t t))))))
(defun message-make-date ()
"Make a valid data header."
(defun message-make-message-id ()
"Make a unique Message-ID."
(concat "<" (message-unique-id)
- (let ((psubject (save-excursion (message-fetch-field "subject"))))
- (if (and message-reply-headers
- (mail-header-references message-reply-headers)
- (mail-header-subject message-reply-headers)
- psubject
- (mail-header-subject message-reply-headers)
- (not (string=
- (message-strip-subject-re
- (mail-header-subject message-reply-headers))
- (message-strip-subject-re psubject))))
+ (let ((psubject (save-excursion (message-fetch-field "subject")))
+ (psupersedes
+ (save-excursion (message-fetch-field "supersedes"))))
+ (if (or
+ (and message-reply-headers
+ (mail-header-references message-reply-headers)
+ (mail-header-subject message-reply-headers)
+ psubject
+ (mail-header-subject message-reply-headers)
+ (not (string=
+ (message-strip-subject-re
+ (mail-header-subject message-reply-headers))
+ (message-strip-subject-re psubject))))
+ (and psupersedes
+ (string-match "_-_@" psupersedes)))
"_-_" ""))
"@" (message-make-fqdn) ">"))
(defun message-make-organization ()
"Make an Organization header."
(let* ((organization
- (or (getenv "ORGANIZATION")
- (when message-user-organization
+ (when message-user-organization
(if (message-functionp message-user-organization)
(funcall message-user-organization)
- message-user-organization)))))
+ message-user-organization))))
(save-excursion
(message-set-work-buffer)
(cond ((stringp organization)
(let ((stop-pos
(string-match " *at \\| *@ \\| *(\\| *<" from)))
(concat (if stop-pos (substring from 0 stop-pos) from)
- "'s message of "
+ "'s message of \""
(if (or (not date) (string= date ""))
- "(unknown date)" date)))))))
+ "(unknown date)" date)
+ "\""))))))
(defun message-make-distribution ()
"Make a Distribution header."
(string-match "\\." mail-host-address))
mail-host-address)
;; We try `user-mail-address' as a backup.
- ((and (string-match "\\." user-mail)
+ ((and user-mail
+ (string-match "\\." user-mail)
(string-match "@\\(.*\\)\\'" user-mail))
(match-string 1 user-mail))
;; Default to this bogus thing.
header value elem)
;; First we remove any old generated headers.
(let ((headers message-deletable-headers))
+ (unless (buffer-modified-p)
+ (setq headers (delq 'Message-ID (copy-sequence headers))))
(while headers
(goto-char (point-min))
(and (re-search-forward
headers)
(delete-region (point) (progn (forward-line -1) (point)))
(when message-default-headers
- (insert message-default-headers))
+ (insert message-default-headers)
+ (or (bolp) (insert ?\n)))
(put-text-property
(point)
(progn
(forward-line -1)
(when (message-news-p)
(when message-default-news-headers
- (insert message-default-news-headers))
+ (insert message-default-news-headers)
+ (or (bolp) (insert ?\n)))
(when message-generate-headers-first
(message-generate-headers
(delq 'Lines
(copy-sequence message-required-news-headers))))))
(when (message-mail-p)
(when message-default-mail-headers
- (insert message-default-mail-headers))
+ (insert message-default-mail-headers)
+ (or (bolp) (insert ?\n)))
(when message-generate-headers-first
(message-generate-headers
(delq 'Lines
(copy-sequence message-required-mail-headers))))))
(run-hooks 'message-signature-setup-hook)
(message-insert-signature)
- (message-set-auto-save-file-name)
(save-restriction
(message-narrow-to-headers)
(run-hooks 'message-header-setup-hook))
(defun message-set-auto-save-file-name ()
"Associate the message buffer with a file in the drafts directory."
(when message-autosave-directory
- (unless (file-exists-p message-autosave-directory)
- (make-directory message-autosave-directory t))
- (let ((name (make-temp-name
- (expand-file-name
- (concat (file-name-as-directory message-autosave-directory)
- "msg.")))))
- (setq buffer-auto-save-file-name
- (save-excursion
- (prog1
- (progn
- (set-buffer (get-buffer-create " *draft tmp*"))
- (setq buffer-file-name name)
- (make-auto-save-file-name))
- (kill-buffer (current-buffer)))))
- (clear-visited-file-modtime))))
+ (setq message-draft-article (nndraft-request-associate-buffer "drafts"))
+ (clear-visited-file-modtime)))
+
+(defun message-disassociate-draft ()
+ "Disassociate the message buffer from the drafts directory."
+ (when message-draft-article
+ (nndraft-request-expire-articles
+ (list message-draft-article) "drafts" nil t)))
\f
(unless follow-to
(if (or (not wide)
to-address)
- (setq follow-to (list (cons 'To (or to-address reply-to from))))
+ (progn
+ (setq follow-to (list (cons 'To (or to-address reply-to from))))
+ (when (and wide mct)
+ (push (cons 'Cc mct) follow-to)))
(let (ccalist)
(save-excursion
(message-set-work-buffer)
;;; Help stuff.
(defun message-talkative-question (ask question show &rest text)
- "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW.
+ "Call FUNCTION with argument QUESTION; optionally display TEXT... args.
+If SHOW is non-nil, the arguments TEXT... are displayed in a temp buffer.
The following arguments may contain lists of values."
(if (and show
(setq text (message-flatten-list text)))
Then clone the local variables and values from the old buffer to the
new one, cloning only the locals having a substring matching the
regexp varstr."
- (let ((oldlocals (buffer-local-variables)))
+ (let ((oldbuf (current-buffer)))
(save-excursion
(set-buffer (generate-new-buffer name))
- (mapcar (lambda (dude)
- (when (and (car dude)
- (or (not varstr)
- (string-match varstr (symbol-name (car dude)))))
- (ignore-errors
- (set (make-local-variable (car dude))
- (cdr dude)))))
- oldlocals)
+ (message-clone-locals oldbuf)
(current-buffer))))
+(defun message-clone-locals (buffer)
+ "Clone the local variables from BUFFER to the current buffer."
+ (let ((locals (save-excursion
+ (set-buffer buffer)
+ (buffer-local-variables)))
+ (regexp "^gnus\\|^nn\\|^message"))
+ (mapcar
+ (lambda (local)
+ (when (and (consp local)
+ (car local)
+ (string-match regexp (symbol-name (car local))))
+ (ignore-errors
+ (set (make-local-variable (car local))
+ (cdr local)))))
+ locals)))
+
+;;; Miscellaneous functions
+
+;; stolen (and renamed) from nnheader.el
+(defun message-replace-chars-in-string (string from to)
+ "Replace characters in STRING from FROM to TO."
+ (let ((string (substring string 0)) ;Copy string.
+ (len (length string))
+ (idx 0))
+ ;; Replace all occurrences of FROM with TO.
+ (while (< idx len)
+ (when (= (aref string idx) from)
+ (aset string idx to))
+ (setq idx (1+ idx)))
+ string))
+
(run-hooks 'message-load-hook)
(provide 'message)
projects / gnus / blobdiff