(require 'mail-abbrevs)
(require 'mailabbrev))
-;;;###autoload
(defvar message-directory "~/Mail/"
"*Directory from which all other mail file variables are derived.")
"*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.")
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)
(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."
(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-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")
- (forward-line 1)
- (delete-region (point) (point-max))
;; Insert the signature.
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
(insert "\n-- \n")
(if (eq signature t)
(insert-file-contents message-signature-file)
(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))
"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.
(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)
(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)
;; Check "Shoot me".
(or (message-check-element 'shoot)
(save-excursion
- (if (search-forward
- ".i-have-a-misconfigured-system-so-shoot-me" nil t)
+ (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)))
(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.
(message-check-element 'signature)
(progn
(goto-char (point-max))
- (if (or (not (re-search-backward "^-- $" nil t))
+ (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)
(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))
(or (car (mail-extract-address-components to))
to) "")
"")
- (if group (concat " on " group) "")
+ (if (and group (not (string= group ""))) (concat " on " group) "")
"*")))
;; Use standard name.
(t
;; We might have sent this buffer already. Delete it from the
;; list of buffers.
(setq message-buffer-list (delq (current-buffer) message-buffer-list))
- (when (and message-max-buffers
- (>= (length message-buffer-list) message-max-buffers))
+ (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)
(pop h))
alist)
headers)
- (forward-line -1)
+ (delete-region (point) (progn (forward-line -1) (point)))
(when message-default-headers
(insert message-default-headers))
(put-text-property
(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 (message-buffer-name "reply" from))
+ (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
;; 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
(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 'messagexmas))
;;; 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)
projects / gnus / blobdiff