(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
"If non-nil, delete the deletable headers before feeding to mh.")
+(defvar message-send-method-alist
+ '((news message-news-p message-send-via-news)
+ (mail message-mail-p message-send-via-mail))
+ "Alist of ways to send outgoing messages.
+Each element has the form
+
+ \(TYPE PREDICATE FUNCTION)
+
+where TYPE is a symbol that names the method; PREDICATE is a function
+called without any parameters to determine whether the message is
+a message of type TYPE; and FUNCTION is a function to be called if
+PREDICATE returns non-nil. FUNCTION is called with one parameter --
+the prefix.")
+
+(defvar message-mail-alias-type 'abbrev
+ "*What alias expansion type to use in Message buffers.
+The default is `abbrev', which uses mailabbrev. nil switches
+mail aliases off.")
+
;;; Internal variables.
;;; Well, not really internal.
(let* ((cite-prefix "A-Za-z")
(cite-suffix (concat cite-prefix "0-9_.@-"))
(content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
- `((,(concat "^\\(To:\\)" content)
+ `((,(concat "^\\([Tt]o:\\)" content)
(1 'message-header-name-face)
(2 'message-header-to-face nil t))
- (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^Reply-To:\\)" content)
+ (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)
(1 'message-header-name-face)
(2 'message-header-cc-face nil t))
- (,(concat "^\\(Subject:\\)" content)
+ (,(concat "^\\([Ss]ubject:\\)" content)
(1 'message-header-name-face)
(2 'message-header-subject-face nil t))
- (,(concat "^\\(Newsgroups:\\|Followup-to:\\)" content)
+ (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)
(1 'message-header-name-face)
(2 'message-header-newsgroups-face nil t))
- (,(concat "^\\([^: \n\t]+:\\)" content)
+ (,(concat "^\\([A-Z][^: \n\t]+:\\)" content)
(1 'message-header-name-face)
(2 'message-header-other-face nil t))
(,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content)
(not paren))))
(push (buffer-substring beg (point)) elems)
(setq beg (match-end 0)))
- ((= (following-char) ?\")
+ ((= (char-after (point)) ?\")
(setq quoted (not quoted)))
- ((and (= (following-char) ?\()
+ ((and (= (char-after (point)) ?\()
(not quoted))
(setq paren t))
- ((and (= (following-char) ?\))
+ ((and (= (char-after (point)) ?\))
(not quoted))
(setq paren nil))))
(nreverse elems)))))
(easy-menu-add message-mode-menu message-mode-map)
(easy-menu-add message-mode-field-menu message-mode-map)
;; Allow mail alias things.
- (if (fboundp 'mail-abbrevs-setup)
- (mail-abbrevs-setup)
- (funcall (intern "mail-aliases-setup")))
+ (when (eq message-mail-alias-type 'abbrev)
+ (if (fboundp 'mail-abbrevs-setup)
+ (mail-abbrevs-setup)
+ (funcall (intern "mail-aliases-setup"))))
(run-hooks 'text-mode-hook 'message-mode-hook))
\f
\f
-(defun message-insert-to ()
- "Insert a To header that points to the author of the article being replied to."
- (interactive)
+(defun message-insert-to (&optional force)
+ "Insert a To header that points to the author of the article being replied to.
+If the original author requested not to be sent mail, the function signals
+an error.
+With the prefix argument FORCE, insert the header anyway."
+ (interactive "P")
(let ((co (message-fetch-reply-field "mail-copies-to")))
- (when (and co
+ (when (and (null force)
+ co
(equal (downcase co) "never"))
(error "The user has requested not to have copies sent via mail")))
(when (and (message-position-on-field "To")
(message-fix-before-sending)
(run-hooks 'message-send-hook)
(message "Sending...")
- (when (and (or (not (message-news-p))
- (and (or (not (memq 'news message-sent-message-via))
- (y-or-n-p
- "Already sent message via news; resend? "))
- (funcall message-send-news-function arg)))
- (or (not (message-mail-p))
- (and (or (not (memq 'mail message-sent-message-via))
- (y-or-n-p
- "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))
- (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)))
+ (let ((alist message-send-method-alist)
+ (success t)
+ 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)))))
+ (setq sent t)))
+ (when (and success sent)
+ (message-do-fcc)
+ ;;(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))))
+
+(defun message-send-via-mail (arg)
+ "Send the current message via mail."
+ (message-send-mail arg))
+
+(defun message-send-via-news (arg)
+ "Send the current message via news."
+ (funcall message-send-news-function arg))
(defun message-fix-before-sending ()
"Do various things to make the message nice before sending it."
(message-remove-header message-ignored-mail-headers t))
(goto-char (point-max))
;; require one newline at the end.
- (or (= (preceding-char) ?\n)
+ (or (= (char-before (point)) ?\n)
(insert ?\n))
(when (and news
(or (message-fetch-field "cc")
(message-remove-header message-ignored-news-headers t))
(goto-char (point-max))
;; require one newline at the end.
- (or (= (preceding-char) ?\n)
+ (or (= (char-before (point)) ?\n)
(insert ?\n))
(let ((case-fold-search t))
;; Remove the delimiter.
(defun message-check-news-header-syntax ()
(and
+ ;; Check the Subject header.
+ (message-check 'subject
+ (let* ((case-fold-search t)
+ (subject (message-fetch-field "subject")))
+ (or
+ (and subject
+ (not (string-match "\\`[ \t]*\\'" subject)))
+ (ignore
+ (message
+ "The subject field is empty or missing. Posting is denied.")))))
;; Check for commands in Subject.
(message-check 'subject-cmsg
(if (string-match "^cmsg " (message-fetch-field "subject"))
(y-or-n-p
(format "The Message-ID looks strange: \"%s\". Really post? "
message-id)))))
- ;; Check the Subject header.
- (message-check 'subject
- (let* ((case-fold-search t)
- (subject (message-fetch-field "subject")))
- (or
- (and subject
- (not (string-match "\\`[ \t]*\\'" subject)))
- (ignore
- (message
- "The subject field is empty or missing. Posting is denied.")))))
;; Check the Newsgroups & Followup-To headers.
(message-check 'existing-newsgroups
(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))
(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."
(progn
;; The header was found. We insert a space after the
;; colon, if there is none.
- (if (/= (following-char) ? ) (insert " ") (forward-char 1))
+ (if (/= (char-after (point)) ? ) (insert " ") (forward-char 1))
;; Find out whether the header is empty...
(looking-at "[ \t]*$")))
;; So we find out what value we should insert.
(beginning-of-line)
(insert "Original-")
(beginning-of-line))
- (insert "Sender: " secure-sender "\n"))))))
+ (when (or (message-news-p)
+ (string-match "^[^@]@.+\\..+" secure-sender))
+ (insert "Sender: " secure-sender "\n")))))))
(defun message-insert-courtesy-copy ()
"Insert a courtesy message in mail copies of combined messages."
(goto-char (point-min))
(while (not (eobp))
(skip-chars-forward "^,\"" (point-max))
- (if (or (= (following-char) ?,)
+ (if (or (= (char-after (point)) ?,)
(eobp))
(when (not quoted)
(if (and (> (current-column) 78)
(search-backward ":" )
(widen)
(forward-char 1)
- (if (= (following-char) ? )
+ (if (= (char-after (point)) ? )
(forward-char 1)
(insert " ")))
(t
(message-narrow-to-headers)
(run-hooks 'message-header-setup-hook))
(set-buffer-modified-p nil)
+ (setq buffer-undo-list nil)
(run-hooks 'message-setup-hook)
(message-position-point)
(undo-boundary))
(let ((name (make-temp-name
(expand-file-name
(concat (file-name-as-directory message-autosave-directory)
- "msg.")))))
+ "msg."
+ (nnheader-replace-chars-in-string
+ (buffer-name) ?* ?.))))))
(setq buffer-auto-save-file-name
(save-excursion
(prog1
cur)))
;;;###autoload
-(defun message-wide-reply (&optional to-address)
+(defun message-wide-reply (&optional to-address ignore-reply-to)
"Make a \"wide\" reply to the message in the current buffer."
(interactive)
- (message-reply to-address t))
+ (message-reply to-address t ignore-reply-to))
;;;###autoload
(defun message-followup (&optional to-newsgroups)
mail-header-separator "\n"
message-cancel-message)
(message "Canceling your article...")
- (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
- (funcall message-send-news-function))
- (message "Canceling your article...done")
+ (if (let ((message-syntax-checks
+ 'dont-check-for-anything-just-trust-me))
+ (funcall message-send-news-function))
+ (message "Canceling your article...done"))
(kill-buffer buf)))))
;;;###autoload
(goto-char (min start end))
(while (< (point) end1)
(or (looking-at "[_\^@- ]")
- (insert (following-char) "\b"))
+ (insert (char-after (point)) "\b"))
(forward-char 1)))))
;;;###autoload
(move-marker end1 (max start end))
(goto-char (min start end))
(while (re-search-forward "\b" end1 t)
- (if (eq (following-char) (char-after (- (point) 2)))
+ (if (eq (char-after (point)) (char-after (- (point) 2)))
(delete-char -2))))))
(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
(insert string)
(if (not comp)
(message "No matching groups")
- (pop-to-buffer "*Completions*")
- (buffer-disable-undo (current-buffer))
- (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)))))))
+ (save-selected-window
+ (pop-to-buffer "*Completions*")
+ (buffer-disable-undo (current-buffer))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (let ((standard-output (current-buffer)))
+ (display-completion-list (sort completions 'string<)))
+ (goto-char (point-min))
+ (delete-region (point) (progn (forward-line 3) (point))))))))))
;;; Help stuff.
projects / gnus / blobdiff