(eval-when-compile
(require 'cl))
-(require 'mail-header)
+(require 'mailheader)
+(require 'rmail)
(require 'nnheader)
(require 'timezone)
(require 'easymenu)
(defvar message-directory "~/Mail/"
"*Directory from which all other mail file variables are derived.")
+(defvar message-max-buffers 10
+ "*How many buffers to keep before starting to kill them off.")
+
+(defvar message-send-rename-function nil
+ "Function called to rename the buffer after sending it.")
+
;;;###autoload
(defvar message-fcc-handler-function 'rmail-output
"*A function called to save outgoing articles.
"*Regexp of headers to be removed unconditionally before mailing.")
;;;###autoload
-(defvar message-ignored-supersedes-headers
- "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:"
+(defvar message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|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.")
nil means let mailer mail back a message to report errors.")
;;;###autoload
-(defvar message-generate-new-buffers nil
- "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called.")
+(defvar message-generate-new-buffers t
+ "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called.
+If this is a function, call that function with three parameters: The type,
+the to address and the group name. (Any of these may be nil.) The function
+should return the new buffer name.")
;;;###autoload
(defvar message-kill-buffer-on-exit nil
"*Non-nil means that the message buffer will be killed after sending a message.")
(defvar gnus-local-organization)
-;;;###autoload
(defvar message-user-organization
(or (and (boundp 'gnus-local-organization)
gnus-local-organization)
(defvar message-user-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
-;;;###autoload
-(defvar message-autosave-directory
- (concat (file-name-as-directory message-directory) "drafts/")
+(defvar message-autosave-directory "~/"
+ ; (concat (file-name-as-directory message-directory) "drafts/")
"*Directory where message autosaves buffers.
If nil, message won't autosave.")
(defvar message-send-news-function 'message-send-news
"Function to call to send the current buffer as news.
The headers should be delimited by a line whose contents match the
-variable `message-header-separator'.")
+variable `mail-header-separator'.")
;;;###autoload
(defvar message-reply-to-function nil
(defvar message-generate-headers-first nil
"*If non-nil, generate all possible headers before composing.")
-;;;###autoload
-(defvar message-header-separator "--text follows this line--"
- "*Line used to separate headers from text in messages being composed.")
-
(defvar message-setup-hook nil
"Normal hook, run each time a new outgoing message is initialized.
The function `message-setup' runs this hook.")
+(defvar message-signature-setup-hook nil
+ "Normal hook, run each time a new outgoing message is initialized.
+It is run after the headers have been inserted and before
+the signature is inserted.")
+
+(defvar message-mode-hook nil
+ "Hook run in message mode buffers.")
+
+(defvar message-header-hook nil
+ "Hook run in a message mode buffer narrowed to the headers.")
+
(defvar message-header-setup-hook nil
"Hook called narrowed to the headers when setting up a message buffer.")
table)
"Syntax table used while in Message mode.")
+(defvar message-mode-abbrev-table text-mode-abbrev-table
+ "Abbrev table used in Message mode buffers.
+Defaults to `text-mode-abbrev-table'.")
+
(defvar message-font-lock-keywords
(let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-")))
(list '("^To:" . font-lock-function-name-face)
;;; Internal variables.
+(defvar message-buffer-list nil)
+
;;; Regexp matching the delimiter of messages in UNIX mail format
;;; (UNIX From lines), minus the initial ^.
(defvar message-unix-mail-delimiter
(defvar message-header-format-alist
`((Newsgroups)
- (To . message-fill-header)
- (Cc . message-fill-header)
+ (To . message-fill-address)
+ (Cc . message-fill-address)
(Subject)
(In-Reply-To)
(Fcc)
"Alist used for formatting headers.")
(eval-and-compile
- (autoload 'message-setup-toolbar "message-xmas")
+ (autoload 'message-setup-toolbar "messagexmas")
(autoload 'mh-send-letter "mh-comp"))
\f
(defun message-tokenize-header (header &optional separator)
"Split HEADER into a list of header elements.
\",\" is used as the separator."
- (let* ((beg 0)
- (separator (or separator ","))
- (regexp
- (format "[ \t]*\\([^%s]+\\)?\\([%s]+\\|\\'\\)" separator separator))
- elems)
- (while (and (string-match regexp header beg)
- (< beg (length header)))
- (when (match-beginning 1)
- (push (match-string 1 header) elems))
- (setq beg (match-end 0)))
- (nreverse elems)))
+ (let ((regexp (format "[%s]+" (or separator ",")))
+ (beg 1)
+ (first t)
+ quoted elems)
+ (save-excursion
+ (message-set-work-buffer)
+ (insert header)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if first
+ (setq first nil)
+ (forward-char 1))
+ (cond ((and (> (point) beg)
+ (or (eobp)
+ (and (looking-at regexp)
+ (not quoted))))
+ (push (buffer-substring beg (point)) elems)
+ (setq beg (match-end 0)))
+ ((= (following-char) ?\")
+ (setq quoted (not quoted)))))
+ (nreverse elems))))
(defun message-fetch-field (header)
"The same as `mail-fetch-field', only remove all newlines."
"----"
["To" message-goto-to t]
["Subject" message-goto-subject t]
+ ["Cc" message-goto-cc t]
+ ["Reply-to" message-goto-reply-to t]
["Summary" message-goto-summary t]
["Keywords" message-goto-keywords t]
["Newsgroups" message-goto-newsgroups t]
["Sort Headers" message-sort-headers t]
["Yank Original" message-yank-original t]
["Fill Yanked Message" message-fill-yanked-message t]
- ;; ["Insert Signature" news-reply-signature t]
+ ["Insert Signature" message-insert-signature t]
["Caesar (rot13) Message" message-caesar-buffer-body t]
["Rename buffer" message-rename-buffer t]
["Spellcheck" ispell-message t]
["Send Message" message-send-and-exit t]
["Abort Message" message-dont-send t]))
+(defvar facemenu-add-face-function)
+(defvar facemenu-remove-face-function)
+
;;;###autoload
(defun message-mode ()
"Major mode for editing mail and news to be sent.
(make-local-variable 'message-postpone-actions)
(set-syntax-table message-mode-syntax-table)
(use-local-map message-mode-map)
- (setq local-abbrev-table text-mode-abbrev-table)
+ (setq local-abbrev-table message-mode-abbrev-table)
(setq major-mode 'message-mode)
(setq mode-name "Message")
(setq buffer-offer-save t)
(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))
(make-local-variable 'message-reply-headers)
(setq message-reply-headers nil)
(setq message-sent-message-via nil)
(make-local-variable 'message-checksum)
(setq message-checksum nil)
- (when (fboundp 'mail-hist-define-keys)
- (mail-hist-define-keys))
+ ;;(when (fboundp 'mail-hist-define-keys)
+ ;; (mail-hist-define-keys))
(when (string-match "XEmacs\\|Lucid" emacs-version)
(message-setup-toolbar))
(easy-menu-add message-mode-menu message-mode-map)
(defun message-goto-body ()
"Move point to the beginning of the message body."
(interactive)
+ (if (looking-at "[ \t]*\n") (expand-abbrev))
(goto-char (point-min))
(search-forward (concat "\n" mail-header-separator "\n") nil t))
(defun message-insert-to ()
"Insert a To header that points to the author of the article being replied to."
(interactive)
- (when (message-position-on-field "To")
+ (when (and (message-position-on-field "To")
+ (mail-fetch-field "to")
+ (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
(insert ", "))
(insert (or (message-fetch-reply-field "reply-to")
(message-fetch-reply-field "from") "")))
(defun message-insert-newsgroups ()
"Insert the Newsgroups header from the article being replied to."
(interactive)
- (when (message-position-on-field "Newsgroups")
+ (when (and (message-position-on-field "Newsgroups")
+ (mail-fetch-field "newsgroups")
+ (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
(insert ","))
(insert (or (message-fetch-reply-field "newsgroups") "")))
(defun message-insert-signature (&optional force)
"Insert a signature. See documentation for the `message-signature' variable."
- (interactive (list t))
+ (interactive (list 0))
(let* ((signature
(cond ((and (null message-signature)
+ (eq force 0))
+ (save-excursion
+ (goto-char (point-max))
+ (not (re-search-backward
+ message-signature-separator nil t))))
+ ((and (null message-signature)
force)
t)
((message-functionp message-signature)
(file-exists-p message-signature-file))
signature))))
(when signature
- ;; Remove blank lines at the end of the message.
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (end-of-line)
- (delete-region (point) (point-max))
;; Insert the signature.
- (insert "\n\n-- \n")
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (insert "\n-- \n")
(if (eq signature t)
(insert-file-contents message-signature-file)
(insert signature))
(name (if enter-string
(read-string "New buffer name: " name-default)
name-default)))
- (rename-buffer name t)))))
+ (rename-buffer name t)
+ (setq buffer-auto-save-file-name
+ (format "%s%s"
+ (file-name-as-directory message-autosave-directory)
+ (file-name-nondirectory buffer-auto-save-file-name)))))))
(defun message-fill-yanked-message (&optional justifyp)
"Fill the paragraphs of a message yanked into this one.
Normally indents each nonblank line ARG spaces (default 3). However,
if `message-yank-prefix' is non-nil, insert that prefix on each line.
+This function uses `message-cite-function' to do the actual citing.
+
Just \\[universal-argument] as argument means don't indent, insert no
prefix, and don't delete any headers."
(interactive "P")
(delete-windows-on message-reply-buffer t)
(insert-buffer message-reply-buffer)
(funcall message-cite-function)
- (exchange-point-and-mark)
+ (message-exchange-point-and-mark)
(unless (bolp)
(insert ?\n))
(unless modified
- (setq message-checksum (message-checksum))))))
+ (setq message-checksum (cons (message-checksum) (buffer-size)))))))
(defun message-cite-original ()
(let ((start (point))
(y-or-n-p "No changes in the buffer; really send? ")))
;; Make it possible to undo the coming changes.
(undo-boundary)
+ (let ((inhibit-read-only t))
+ (put-text-property (point-min) (point-max) 'read-only nil))
(message-fix-before-sending)
(run-hooks 'message-send-hook)
(message "Sending...")
"Already sent message via mail; resend? "))
(message-send-mail arg))))
(message-do-fcc)
- (when (fboundp 'mail-hist-put-headers-into-history)
- (mail-hist-put-headers-into-history))
+ ;;(when (fboundp 'mail-hist-put-headers-into-history)
+ ;; (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))
+ ;; Delete other mail buffers and stuff.
+ (message-do-send-housekeeping)
(message-do-actions message-send-actions)
;; Return success.
t)))
(save-excursion
(set-buffer tembuf)
(erase-buffer)
- (insert-buffer-substring mailbuf)
+ ;; Avoid copying text props.
+ (insert (format
+ "%s" (save-excursion
+ (set-buffer mailbuf)
+ (buffer-string))))
;; Remove some headers.
(save-restriction
(message-narrow-to-headers)
(defun message-send-mail-with-mh ()
"Send the prepared message buffer with mh."
- (let (mh-previous-window-config)
- (mh-send-letter)))
+ (let ((mh-previous-window-config nil)
+ (name (make-temp-name
+ (concat (file-name-as-directory message-autosave-directory)
+ "msg."))))
+ (setq buffer-file-name name)
+ (mh-send-letter)
+ (condition-case ()
+ (delete-file name)
+ (error nil))))
(defun message-send-news (&optional arg)
(let ((tembuf (generate-new-buffer " *message temp*"))
(funcall message-post-method arg)
message-post-method))
(messbuf (current-buffer))
+ (message-syntax-checks
+ (if arg
+ (cons '(existing-newsgroups . disabled)
+ message-syntax-checks)
+ message-syntax-checks))
result)
(save-restriction
(message-narrow-to-headers)
(message-generate-headers message-required-news-headers)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
+ (message-cleanup-headers)
(when (message-check-news-syntax)
(unwind-protect
(save-excursion
(set-buffer tembuf)
(buffer-disable-undo (current-buffer))
(erase-buffer)
- (insert-buffer-substring messbuf)
+ ;; Avoid copying text props.
+ (insert (format
+ "%s" (save-excursion
+ (set-buffer messbuf)
+ (buffer-string))))
;; Remove some headers.
(save-restriction
(message-narrow-to-headers)
(goto-char (point-min))
(insert "Followup-To: " to "\n"))
t))
-
+ ;; Check "Shoot me".
+ (or (message-check-element 'shoot)
+ (save-excursion
+ (if (re-search-forward
+ "Message-ID.*.i-have-a-misconfigured-system-so-shoot-me"
+ nil t)
+ (y-or-n-p
+ "You appear to have a misconfigured system. Really post? ")
+ t)))
;; Check for Approved.
(or (message-check-element 'approved)
(save-excursion
(if (not hashtb)
t
(while groups
- (unless (boundp (intern (car groups) hashtb))
+ (when (and (not (boundp (intern (car groups) hashtb)))
+ (not (equal (car groups) "poster")))
(push (car groups) errors))
(pop groups))
(if (not errors)
(while (and headers (not error))
(when (setq header (mail-fetch-field (car headers)))
(if (or
- (not (string-match
- "\\`\\([-.a-zA-Z0-9]+\\)?\\(,[-.a-zA-Z0-9]+\\)*\\'"
- header))
+ (not
+ (string-match
+ "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-.a-zA-Z0-9]+\\)*\\'"
+ header))
(memq
nil (mapcar
(lambda (g)
(car headers) header)))))
;; Check the From header.
(or
- (message-check-element 'from)
(save-excursion
(let* ((case-fold-search t)
(from (message-fetch-field "from")))
(concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
(let ((b (point)))
- (or (re-search-forward message-signature-separator nil t)
- (goto-char (point-max)))
+ (goto-char (point-max))
+ (re-search-backward message-signature-separator nil t)
(beginning-of-line)
(or (re-search-backward "[^ \n\t]" b t)
(y-or-n-p "Empty article. Really post? ")))))
;; Check whether any new text has been added.
(or (message-check-element 'new-text)
(not message-checksum)
- (not (eq (message-checksum) message-checksum))
+ (not (and (eq (message-checksum) (car message-checksum))
+ (eq (buffer-size) (cdr message-checksum))))
(y-or-n-p
"It looks like no new text has been added. Really post? "))
;; Check the length of the signature.
- (or (message-check-element 'signature)
- (progn
- (goto-char (point-max))
- (if (not (re-search-backward "^-- $" nil t))
- t
- (if (> (count-lines (point) (point-max)) 5)
- (y-or-n-p
- (format
- "Your .sig is %d lines; it should be max 4. Really post? "
- (count-lines (point) (point-max))))
- t))))))
+ (or
+ (message-check-element 'signature)
+ (progn
+ (goto-char (point-max))
+ (if (or (not (re-search-backward message-signature-separator nil t))
+ (search-forward message-forward-end-separator nil t))
+ t
+ (if (> (count-lines (point) (point-max)) 5)
+ (y-or-n-p
+ (format
+ "Your .sig is %d lines; it should be max 4. Really post? "
+ (count-lines (point) (point-max))))
+ t))))))
(defun message-check-element (type)
"Returns non-nil if this type is not to be checked."
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$"))
(while (not (eobp))
- (setq sum (logxor sum (following-char)))
+ (when (not (looking-at "[ \t\n]"))
+ (setq sum (logxor (ash sum 1) (following-char))))
(forward-char 1)))
sum))
(if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
;; Pipe the article to the program in question.
(call-process-region (point-min) (point-max) shell-file-name
- nil nil nil "-c" (match-string 1 file))
+ nil nil nil shell-command-switch
+ (match-string 1 file))
;; Save the article.
(setq file (expand-file-name file))
(unless (file-exists-p (file-name-directory file))
(mail-header-subject message-reply-headers))
(message-strip-subject-re psubject))))
"_-_" ""))
- "@" (message-make-fqdm) ">"))
+ "@" (message-make-fqdn) ">"))
(defvar message-unique-id-char nil)
(defun message-make-from ()
"Make a From header."
(let* ((login (message-make-address))
- (fullname (user-full-name)))
+ (fullname
+ (or (and (boundp 'user-full-name)
+ user-full-name)
+ (user-full-name))))
(when (string= fullname "&")
(setq fullname (user-login-name)))
(save-excursion
(when user-mail-address
(nth 1 (mail-extract-address-components user-mail-address))))
-(defun message-make-fqdm ()
+(defun message-make-fqdn ()
"Return user's fully qualified domain name."
- (let ((system-name (system-name)))
+ (let ((system-name (system-name))
+ (user-mail (message-user-mail-address)))
(cond
((string-match "[^.]\\.[^.]" system-name)
;; `system-name' returned the right result.
system-name)
- ;; We try `user-mail-address' as a backup.
- ((string-match "@\\(.*\\)\\'" (message-user-mail-address))
- (match-string 1 user-mail-address))
;; Try `mail-host-address'.
((and (boundp 'mail-host-address)
- mail-host-address)
+ (stringp mail-host-address)
+ (string-match "\\." mail-host-address))
mail-host-address)
+ ;; We try `user-mail-address' as a backup.
+ ((and (string-match "\\." user-mail)
+ (string-match "@\\(.*\\)\\'" user-mail))
+ (match-string 1 user-mail))
;; Default to this bogus thing.
(t
(concat system-name ".i-have-a-misconfigured-system-so-shoot-me")))))
(defun message-make-host-name ()
"Return the name of the host."
- (let ((fqdm (message-make-fqdm)))
- (string-match "^[^.]+\\." fqdm)
- (substring fqdm 0 (1- (match-end 0)))))
+ (let ((fqdn (message-make-fqdn)))
+ (string-match "^[^.]+\\." fqdn)
+ (substring fqdn 0 (1- (match-end 0)))))
(defun message-make-domain ()
"Return the domain name."
(or mail-host-address
- (message-make-fqdm)))
+ (message-make-fqdn)))
(defun message-generate-headers (headers)
"Prepare article HEADERS.
;;; Setting up a message buffer
;;;
+(defun message-fill-address (header value)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert (capitalize (symbol-name header))
+ ": "
+ (if (consp value) (car value) value)
+ "\n")
+ (narrow-to-region (point-min) (1- (point-max)))
+ (let (quoted last)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward "^,\"" (point-max))
+ (if (or (= (following-char) ?,)
+ (eobp))
+ (when (not quoted)
+ (if (and (> (current-column) 78)
+ last)
+ (progn
+ (save-excursion
+ (goto-char last)
+ (insert "\n\t"))
+ (setq last (1+ (point))))
+ (setq last (1+ (point)))))
+ (setq quoted (not quoted)))
+ (unless (eobp)
+ (forward-char 1))))
+ (goto-char (point-max))
+ (widen)
+ (forward-line 1)))
+
(defun message-fill-header (header value)
(let ((begin (point))
(fill-column 78)
(forward-line 2)))
(sit-for 0)))
+(defun message-buffer-name (type &optional to group)
+ "Return a new (unique) buffer name based on TYPE and TO."
+ (cond
+ ;; Check whether `message-generate-new-buffers' is a function,
+ ;; and if so, call it.
+ ((message-functionp message-generate-new-buffers)
+ (funcall message-generate-new-buffers type to group))
+ ;; Generate a new buffer name The Message Way.
+ (message-generate-new-buffers
+ (generate-new-buffer-name
+ (concat "*" type
+ (if to
+ (concat " to "
+ (or (car (mail-extract-address-components to))
+ to) "")
+ "")
+ (if (and group (not (string= group ""))) (concat " on " group) "")
+ "*")))
+ ;; Use standard name.
+ (t
+ (format "*%s message*" type))))
+
(defun message-pop-to-buffer (name)
"Pop to buffer NAME, and warn if it already exists and is modified."
- (if message-generate-new-buffers
- (set-buffer (pop-to-buffer (generate-new-buffer name)))
- (let ((buffer (get-buffer name)))
- (if (and buffer
- (buffer-name buffer))
- (progn
- (set-buffer (pop-to-buffer buffer))
- (when (and (buffer-modified-p)
- (not (y-or-n-p
- "Message already being composed; erase? ")))
- (error "Message being composed")))
- (set-buffer (pop-to-buffer name)))))
+ (let ((buffer (get-buffer name)))
+ (if (and buffer
+ (buffer-name buffer))
+ (progn
+ (set-buffer (pop-to-buffer buffer))
+ (when (and (buffer-modified-p)
+ (not (y-or-n-p
+ "Message already being composed; erase? ")))
+ (error "Message being composed")))
+ (set-buffer (pop-to-buffer name))))
(erase-buffer)
(message-mode))
+(defun message-do-send-housekeeping ()
+ "Kill old message buffers."
+ ;; We might have sent this buffer already. Delete it from the
+ ;; list of buffers.
+ (setq message-buffer-list (delq (current-buffer) message-buffer-list))
+ (while (and message-max-buffers
+ (>= (length message-buffer-list) message-max-buffers))
+ ;; Kill the oldest buffer -- unless it has been changed.
+ (let ((buffer (pop message-buffer-list)))
+ (when (and (buffer-name buffer)
+ (not (buffer-modified-p buffer)))
+ (kill-buffer buffer))))
+ ;; Rename the buffer.
+ (if message-send-rename-function
+ (funcall message-send-rename-function)
+ (when (string-match "\\`\\*" (buffer-name))
+ (rename-buffer
+ (concat "*sent " (substring (buffer-name) (match-end 0))) t)))
+ ;; Push the current buffer onto the list.
+ (when message-max-buffers
+ (setq message-buffer-list
+ (nconc message-buffer-list (list (current-buffer))))))
+
+(defvar mc-modes-alist)
(defun message-setup (headers &optional replybuffer actions)
+ (when (and (boundp 'mc-modes-alist)
+ (not (assq 'message-mode mc-modes-alist)))
+ (push '(message-mode (encrypt . mc-encrypt-message)
+ (sign . mc-sign-message))
+ mc-modes-alist))
(when actions
(setq message-send-actions actions))
(setq message-reply-buffer replybuffer)
(pop h))
alist)
headers)
- (forward-line -1)
+ (delete-region (point) (progn (forward-line -1) (point)))
(when message-default-headers
(insert message-default-headers))
- (insert mail-header-separator "\n")
+ (put-text-property
+ (point)
+ (progn
+ (insert mail-header-separator "\n")
+ (1- (point)))
+ 'read-only nil)
(forward-line -1)
(when (message-news-p)
(when message-default-news-headers
(delq 'Lines
(delq 'Subject
(copy-sequence message-required-mail-headers))))))
+ (run-hooks 'message-signature-setup-hook)
(message-insert-signature)
(message-set-auto-save-file-name)
(save-restriction
(defun message-mail (&optional to subject)
"Start editing a mail message to be sent."
(interactive)
- (message-pop-to-buffer "*mail message*")
+ (message-pop-to-buffer (message-buffer-name "mail" to))
(message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
;;;###autoload
(defun message-news (&optional newsgroups subject)
"Start editing a news article to be sent."
(interactive)
- (message-pop-to-buffer "*news message*")
+ (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject "")))))
(let ((cur (current-buffer))
from subject date reply-to to cc
references message-id follow-to
+ (inhibit-point-motion-hooks t)
mct never-mct gnus-warning)
(save-restriction
(narrow-to-region
(message-set-work-buffer)
(unless never-mct
(insert (or reply-to from "")))
- (insert
- (if (bolp) "" ", ") (or to "")
- (if mct (concat (if (bolp) "" ", ") mct) "")
- (if cc (concat (if (bolp) "" ", ") cc) ""))
+ (insert (if (bolp) "" ", ") (or to ""))
+ (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
+ (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
;; Remove addresses that match `rmail-dont-reply-to-names'.
(insert (prog1 (rmail-dont-reply-to (buffer-string))
(erase-buffer)))
(mapcar
(lambda (addr)
(cons (mail-strip-quoted-names addr) addr))
- (nreverse (mail-parse-comma-list))))
+ (message-tokenize-header (buffer-string))))
(let ((s ccalist))
(while s
(setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
follow-to)))))
(widen))
- (message-pop-to-buffer "*mail message*")
+ (message-pop-to-buffer (message-buffer-name
+ (if wide "wide reply" "reply") from
+ (if wide to-address nil)))
(setq message-reply-headers
(vector 0 subject from date message-id references 0 0 ""))
(let ((cur (current-buffer))
from subject date reply-to mct
references message-id follow-to
+ (inhibit-point-motion-hooks t)
followup-to distribution newsgroups gnus-warning)
(save-restriction
(narrow-to-region
(setq subject (concat "Re: " subject))
(widen))
- (message-pop-to-buffer "*news message*")
+ (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
(message-setup
`((Subject . ,subject)
distribution (message-fetch-field "distribution")))
;; Make sure that this article was written by the user.
(unless (string-equal
- (downcase (mail-strip-quoted-names from))
+ (downcase (cadr (mail-extract-address-components from)))
(downcase (message-make-address)))
(error "This article is not yours"))
;; Make control message.
(let ((cur (current-buffer)))
;; Check whether the user owns the article that is to be superseded.
(unless (string-equal
- (downcase (mail-strip-quoted-names (message-fetch-field "from")))
- (downcase (mail-strip-quoted-names (message-make-address))))
+ (downcase (cadr (mail-extract-address-components
+ (message-fetch-field "from"))))
+ (downcase (message-make-address)))
(error "This article is not yours"))
;; Get a normal message buffer.
- (message-pop-to-buffer "*supersede message*")
+ (message-pop-to-buffer (message-buffer-name "supersede"))
(insert-buffer-substring cur)
(message-narrow-to-head)
;; Remove unwanted headers.
(if message-signature-before-forwarded-message
(goto-char (point-max))
(message-goto-body))
+ ;; Make sure we're at the start of the line.
+ (unless (eolp)
+ (insert "\n"))
;; Narrow to the area we are to insert.
(narrow-to-region (point) (point))
;; Insert the separators and the forwarded buffer.
(interactive)
(let ((cur (current-buffer))
boundary)
- (message-pop-to-buffer "*mail message*")
+ (message-pop-to-buffer (message-buffer-name "bounce"))
(insert-buffer-substring cur)
(undo-boundary)
(message-narrow-to-head)
;; We remove everything before the bounced mail.
(delete-region
(point-min)
- (if (re-search-forward "[^ \t]*:" nil t)
+ (if (re-search-forward "^[^ \n\t]+:" nil t)
(match-beginning 0)
(point)))
(save-restriction
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (message-pop-to-buffer "*mail message*"))
+ (message-pop-to-buffer (message-buffer-name "mail" to)))
(message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
;;;###autoload
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (message-pop-to-buffer "*mail message*"))
+ (message-pop-to-buffer (message-buffer-name "mail" to)))
(message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
;;;###autoload
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (message-pop-to-buffer "*news message*"))
+ (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject "")))))
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (message-pop-to-buffer "*news message*"))
+ (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject "")))))
(if (eq (following-char) (char-after (- (point) 2)))
(delete-char -2))))))
+(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
+
;; Support for toolbar
(when (string-match "XEmacs\\|Lucid" emacs-version)
- (require 'message-xmas))
+ (require 'messagexmas))
;;; Group name completion.
(message "No matching groups")
(pop-to-buffer "*Completions*")
(buffer-disable-undo (current-buffer))
- (erase-buffer)
- (let ((standard-output (current-buffer)))
- (display-completion-list (sort completions 'string<)))
- (goto-char (point-min))
- (pop-to-buffer cur))))))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (let ((standard-output (current-buffer)))
+ (display-completion-list (sort completions 'string<)))
+ (goto-char (point-min))
+ (pop-to-buffer cur)))))))
;;; Help stuff.
(defmacro message-y-or-n-p (question show &rest text)
- "Ask QUESTION, displaying the rest of the arguments in a temporary buffer."
+ "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
`(message-talkative-question 'y-or-n-p ,question ,show ,@text))
(defun message-talkative-question (ask question show &rest text)
(list
(list list))))
+(run-hooks 'message-load-hook)
+
(provide 'message)
;;; message.el ends here
projects / gnus / blobdiff