`new-text', `quoting-style', `redirected-followup', `signature',
`approved', `sender', `empty', `empty-headers', `message-id', `from',
`subject', `shorten-followup-to', `existing-newsgroups',
-`buffer-file-name', `unchanged', `newsgroups'."
+`buffer-file-name', `unchanged', `newsgroups', `reply-to'."
:group 'message-news
:type '(repeat sexp)) ; Fixme: improve this
:type 'regexp)
(defcustom message-cite-prefix-regexp
- ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
- "\\([ \t]*\\(\\w\\|[-_.]\\)+>+\\|[ \t]*[]>»|:}+]\\)+"
+ (if (string-match "[[:digit:]]" "1") ;; support POSIX?
+ "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>»|:}+]\\)+"
+ ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
+ "\\([ \t]*\\(\\w\\|[-_.]\\)+>+\\|[ \t]*[]>»|:}+]\\)+")
"*Regexp matching the longest possible citation prefix on a line."
:group 'message-insertion
:type 'regexp)
`use', always use the value."
:group 'message-interface
:type '(choice (const :tag "ignore" nil)
+ (const :tag "use & query" t)
(const :tag "maybe" t)
(const :tag "always" use)
(const :tag "ask" ask)))
(const :tag "always" use)
(const :tag "ask" ask)))
-(defcustom message-use-mail-followup-to 'ask
- "*Specifies what to do with Mail-Followup-To header.
-If nil, always ignore the header. If it is the symbol `ask', always
-query the user whether to use the value. If it is t or the symbol
-`use', always use the value."
- :group 'message-interface
- :type '(choice (const :tag "ignore" nil)
- (const :tag "maybe" t)
- (const :tag "always" use)
- (const :tag "ask" ask)))
-
;;; XXX: 'ask and 'use are not implemented yet.
(defcustom message-use-mail-reply-to 'ask
"*Specifies what to do with Mail-Reply-To/Reply-To header.
(const :tag "always" use)
(const :tag "ask" ask)))
+(defcustom message-use-mail-followup-to t
+ "*Specifies what to do with Mail-Followup-To header.
+If nil, always ignore the header. If it is the symbol `ask', always
+query the user whether to use the value. If it is t or the symbol
+`use', always use the value."
+ :group 'message-interface
+ :type '(choice (const :tag "ignore" nil)
+ (const :tag "maybe" t)
+ (const :tag "always" use)
+ (const :tag "ask" ask)))
+
(defcustom message-sendmail-f-is-evil nil
"*Non-nil means don't add \"-f username\" to the sendmail command line.
Doing so would be even more evil than leaving it out."
;;;###autoload
(defcustom message-citation-line-function 'message-insert-citation-line
- "*Function called to insert the \"Whomever writes:\" line."
+ "*Function called to insert the \"Whomever writes:\" line.
+
+Note that Gnus provides a feature where the reader can click on
+`writes:' to hide the cited text. If you change this line too much,
+people who read your message will have to change their Gnus
+configuration. See the variable `gnus-cite-attribution-suffix'."
:type 'function
:group 'message-insertion)
;;;###autoload
(defcustom message-yank-prefix "> "
"*Prefix inserted on the lines of yanked messages.
-Fix `message-cite-prefix-regexp' if it is set to an abnormal value."
+Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
+See also `message-yank-cited-prefix'."
:type 'string
:group 'message-insertion)
(integer :tag "Position from last ID"))
:group 'message-insertion)
+(defcustom message-yank-cited-prefix ">"
+ "*Prefix inserted on cited lines of yanked messages.
+Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
+See also `message-yank-prefix'."
+ :type 'string
+ :group 'message-insertion)
+
(defcustom message-indentation-spaces 3
"*Number of spaces to insert at the beginning of each cited line.
Used by `message-yank-original' via `message-yank-cite'."
:group 'message-insertion)
;;;###autoload
+(defcustom message-suspend-font-lock-when-citing nil
+ "Non-nil means suspend font-lock'ing while citing an original message.
+Some lazy demand-driven fontification tools (or Emacs itself) have a
+bug that they often miss a buffer to be fontified. It will mostly
+occur when Emacs prompts user for any inputs in the minibuffer.
+Setting this option to non-nil may help you to avoid unpleasant errors
+even if it is an add-hoc expedient."
+ :type 'boolean
+ :group 'message-insertion)
+
+;;;###autoload
(defcustom message-indent-citation-function 'message-indent-citation
"*Function for modifying a citation just inserted in the mail buffer.
This can also be a list of functions. Each function can find the
(defcustom message-dont-reply-to-names
(and (boundp 'rmail-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."
+ "*A regexp specifying addresses to prune when doing wide replies.
+A value of nil means exclude your own user name only."
:version "21.1"
:group 'message
:type '(choice (const :tag "Yourself" nil)
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'.")
-
(defface message-header-to-face
'((((class color)
(background dark))
"Face used for displaying MML."
:group 'message-faces)
-(defvar message-font-lock-fence-open-regexp "[+|]"
- "*Regexp that matches fence open string.")
-
-(defvar message-font-lock-fence-close-regexp "|"
- "*Regexp that matches fence close string.")
-
-(defvar message-font-lock-fence-open-position nil
- "*Cons of SYMBOL of a function or a variable and a number of OFFSET that
-indicate the fence open position. If it is non-nil,
-`message-font-lock-fence-open-regexp' is not used for searching for the
-fence open position. If SYMBOL is a function, it is called with one argument
-last cursor position and should return the fence open position as a number
-or a marker. If SYMBOL is a variable symbol, the value is examined with
-`symbol-value'. OFFSET is added to the position to compensate the value.
-For example, the following combinations of variable symbol and offset value
-can be used:
-
-Egg v3: '(egg:*region-start* . -1)
-Canna: '(canna:*region-start* . 0)
-")
-
-(defvar message-font-lock-fence-close-position nil
- "*Cons of SYMBOL of a function or a variable and a number of OFFSET that
-indicate the fence close position. If it is non-nil,
-`message-font-lock-fence-close-regexp' is not used for searching for the
-fence close position. If SYMBOL is a function, it is called with one argument
-last cursor position and should return the fence close position as a number
-or a marker. If SYMBOL is a variable symbol, the value is examined with
-`symbol-value'. OFFSET is added to the position to compensate the value.
-For example, the following combinations of variable symbol and offset value
-can be used:
-
-Egg v3: '(egg:*region-end* . 0)
-Canna: '(canna:*region-end* . 0)
-")
-
-(defvar message-font-lock-cited-text-regexp
- "^[\t ]*\\([^\000- :>|}\177]*\\)[:>|}].*"
- "*Regexp that matches cited text. It should have a grouping for the
-citation prefix which is ended at the beginning of citation mark string.")
-
-(defvar message-font-lock-citation-name-max-column 10
- "*Maximun number of column for citation name for fontifying.")
-
-(defvar message-font-lock-last-position nil
- "Internal buffer local variable to save the last cursor position
-before fontifying.")
-
-(eval-after-load "font-lock"
- '(defadvice font-lock-after-change-function
- (before message-font-lock-save-last-position activate)
- "Save last cursor position before fontifying."
- (if (eq 'message-mode major-mode)
- (setq message-font-lock-last-position (point)))))
-
-(defun message-font-lock-cited-text-matcher (limit)
- "Search for a cited text containing `message-font-lock-cited-text-regexp'
-forward. Argument LIMIT bounds the search. If a cited text is found, it
-returns t and sets match data 1 and 2, otherwise it returns nil. Normally,
-match data 2 has zero length, but if the FENCE (for input method) is detected
-in matched text, result is divided into match data 1 and 2 across the FENCE.
-See also the documentations for the following variables:
- `message-font-lock-fence-open-regexp'
- `message-font-lock-fence-close-regexp'
- `message-font-lock-fence-open-position'
- `message-font-lock-fence-close-position'
-"
- (prog1
- (when (re-search-forward message-font-lock-cited-text-regexp limit t)
- (let* ((start0 (match-beginning 0))
- (end0 (match-end 0))
- (cite-mark (match-end 1))
- (should-fontify
- (progn
- (goto-char cite-mark)
- (<= (current-column)
- message-font-lock-citation-name-max-column)))
- end1 start2)
- (and
- should-fontify
- message-font-lock-last-position
- (>= message-font-lock-last-position start0)
- (<= message-font-lock-last-position end0)
- (cond
- (message-font-lock-fence-open-position
- (let* ((symbol (car message-font-lock-fence-open-position))
- (open
- (cond ((functionp symbol)
- (funcall symbol message-font-lock-last-position))
- ((and (symbolp symbol)
- (boundp symbol))
- (symbol-value symbol)))))
- (when (markerp open)
- (setq open (marker-position open)))
- (and (numberp open)
- (setq open
- (+ open
- (cdr message-font-lock-fence-open-position)))
- (>= message-font-lock-last-position open)
- (goto-char open)
- (or (not message-font-lock-fence-open-regexp)
- (looking-at message-font-lock-fence-open-regexp))
- (setq end1 open))))
- (message-font-lock-fence-open-regexp
- (goto-char message-font-lock-last-position)
- (when (re-search-backward
- message-font-lock-fence-open-regexp start0 t)
- (setq end1 (match-beginning 0)))))
- (setq should-fontify
- (and message-font-lock-fence-open-position
- (not (eq cite-mark end1))))
- (cond
- (message-font-lock-fence-close-position
- (let* ((symbol (car message-font-lock-fence-close-position))
- (close
- (cond ((functionp symbol)
- (funcall symbol message-font-lock-last-position))
- ((and (symbolp symbol)
- (boundp symbol))
- (symbol-value symbol)))))
- (when (markerp close)
- (setq close (marker-position close)))
- (and (numberp close)
- (setq close
- (+ close
- (cdr message-font-lock-fence-close-position)))
- (<= message-font-lock-last-position close)
- (setq start2 close))))
- (message-font-lock-fence-close-regexp
- (goto-char message-font-lock-last-position)
- (when (looking-at message-font-lock-fence-close-regexp)
- (setq start2 (match-end 0)))))
- (setq should-fontify
- (and (not (and (not message-font-lock-fence-open-position)
- (eq cite-mark end1)))
- (not (eq cite-mark start2)))))
- (goto-char end0)
- (when should-fontify
- (if start2
- (store-match-data (list start0 end0 start0 end1 start2 end0))
- (store-match-data (list start0 end0 start0 end0 end0 end0)))
- t)))
- (setq message-font-lock-last-position nil)))
-
-(defvar message-font-lock-keywords-1
+(defvar message-font-lock-keywords
(let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
`((,(concat "^\\([Tt]o:\\)" content)
(1 'message-header-name-face)
(not (equal mail-header-separator "")))
`((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
1 'message-separator-face))
- nil))))
-
-(defvar message-font-lock-keywords-2
- (append message-font-lock-keywords-1
- `((message-font-lock-cited-text-matcher
- (1 'message-cited-text-face)
- (2 'message-cited-text-face))
- (,(concat "^\\(" message-cite-prefix-regexp "\\).*")
- (0 'message-cited-text-face))
- ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>"
- (0 'message-mml-face)))))
-
-(defvar message-font-lock-keywords message-font-lock-keywords-2
+ nil)
+ (,(concat "^\\(" message-cite-prefix-regexp "\\).*")
+ (0 'message-cited-text-face))
+ (,mime-edit-tag-regexp
+ (0 'message-mml-face))))
"Additional expressions to highlight in Message mode.")
;; XEmacs does it like this. For Emacs, we have to set the
;; `font-lock-defaults' buffer-local variable.
-(put 'message-mode 'font-lock-defaults
- '((message-font-lock-keywords
- message-font-lock-keywords-1
- message-font-lock-keywords-2)
- nil nil nil nil
- (font-lock-mark-block-function . mark-paragraph)))
+(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
(defvar message-face-alist
'((bold . bold-region)
:version "21.1"
:group 'message)
+(defcustom message-wide-reply-confirm-recipients nil
+ "Whether to confirm a wide reply to multiple email recipients.
+If this variable is nil, don't ask whether to reply to all recipients.
+If this variable is non-nil, pose the question \"Reply to all
+recipients?\" before a wide reply to multiple recipients. If the user
+answers yes, reply to all recipients as usual. If the user answers
+no, only reply back to the author."
+ :group 'message-headers
+ :type 'boolean)
+
;;; Internal variables.
(defvar message-sending-message "Sending...")
(defvar message-options nil
"Some saved answers when sending message.")
+(defvar message-send-mail-real-function nil
+ "Internal send mail function.")
+
(eval-and-compile
(autoload 'message-setup-toolbar "messagexmas")
(autoload 'mh-new-draft-name "mh-comp")
(defvar facemenu-remove-face-function))
;;;###autoload
-(defun message-mode ()
+(define-derived-mode message-mode text-mode "Message"
"Major mode for editing mail and news to be sent.
Like Text Mode but with these additional commands:\\<message-mode-map>
C-c C-s `message-send' (send the message) C-c C-c `message-send-and-exit'
C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution
C-c C-f C-m move to Mail-Followup-To
C-c C-f C-f move to Followup-To
+ C-c C-f c move to Mail-Copies-To
C-c C-t `message-insert-to' (add a To header to a news followup)
C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply)
C-c C-b `message-goto-body' (move to beginning of message text).
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).
M-RET `message-newline-and-reformat' (break the line and reformat)."
- (interactive)
- (kill-all-local-variables)
(set (make-local-variable 'message-reply-buffer) nil)
(make-local-variable 'message-send-actions)
(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)
- (setq major-mode 'message-mode)
- (setq mode-name "Message")
(setq buffer-offer-save t)
- (make-local-variable 'facemenu-add-face-function)
- (make-local-variable 'facemenu-remove-face-function)
- (setq facemenu-add-face-function
- (lambda (face end)
- (let ((face-fun (cdr (assq face message-face-alist))))
- (if face-fun
- (funcall face-fun (point) end)
- (error "Face %s not configured for %s mode" face mode-name)))
- "")
- facemenu-remove-face-function t)
- (make-local-variable 'message-reply-headers)
- (setq message-reply-headers nil)
+ (set (make-local-variable 'facemenu-add-face-function)
+ (lambda (face end)
+ (let ((face-fun (cdr (assq face message-face-alist))))
+ (if face-fun
+ (funcall face-fun (point) end)
+ (error "Face %s not configured for %s mode" face mode-name)))
+ ""))
+ (set (make-local-variable 'facemenu-remove-face-function) t)
+ (set (make-local-variable 'message-reply-headers) nil)
(make-local-variable 'message-user-agent)
(make-local-variable 'message-post-method)
(set (make-local-variable 'message-sent-message-via) nil)
(if (featurep 'xemacs)
(message-setup-toolbar)
(set (make-local-variable 'font-lock-defaults)
- '((message-font-lock-keywords
- message-font-lock-keywords-1
- message-font-lock-keywords-2)
- nil nil nil nil
- (font-lock-mark-block-function . mark-paragraph)))
+ '(message-font-lock-keywords t))
(if (boundp 'tool-bar-map)
(set (make-local-variable 'tool-bar-map) (message-tool-bar-map))))
- (set (make-local-variable 'message-font-lock-last-position) nil)
(easy-menu-add message-mode-menu message-mode-map)
(easy-menu-add message-mode-field-menu message-mode-map)
;; Allow mail alias things.
(mail-abbrevs-setup)
(mail-aliases-setup)))
(message-set-auto-save-file-name)
- (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
- (setq indent-tabs-mode nil)
- (run-hooks 'text-mode-hook 'message-mode-hook))
+ (set (make-local-variable 'indent-tabs-mode) nil)) ;No tabs for indentation.
(defun message-setup-fill-variables ()
"Setup message fill variables."
- (set (make-local-variable 'fill-paragraph-function)
+ (set (make-local-variable 'fill-paragraph-function)
'message-fill-paragraph)
(make-local-variable 'paragraph-separate)
(make-local-variable 'paragraph-start)
(expand-abbrev))
(goto-char (point-min))
(or (search-forward (concat "\n" mail-header-separator "\n") nil t)
- (search-forward "\n\n" nil t)))
+ (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)))
(defun message-goto-eoh ()
"Move point to the end of the headers."
(defun message-delete-not-region (beg end)
"Delete everything in the body of the current message outside of the region."
(interactive "r")
- (save-excursion
- (goto-char end)
- (delete-region (point) (if (not (message-goto-signature))
- (point)
- (forward-line -2)
- (point)))
- (insert "\n")
- (goto-char beg)
- (delete-region beg (progn (message-goto-body)
- (forward-line 2)
- (point))))
+ (let (citeprefix)
+ (save-excursion
+ (goto-char beg)
+ ;; snarf citation prefix, if appropriate
+ (unless (eq (point) (progn (beginning-of-line) (point)))
+ (when (looking-at message-cite-prefix-regexp)
+ (setq citeprefix (match-string 0))))
+ (goto-char end)
+ (delete-region (point) (if (not (message-goto-signature))
+ (point)
+ (forward-line -2)
+ (point)))
+ (insert "\n")
+ (goto-char beg)
+ (delete-region beg (progn (message-goto-body)
+ (forward-line 2)
+ (point)))
+ (when citeprefix
+ (insert citeprefix))))
(when (message-goto-signature)
(forward-line -2)))
(save-excursion
(goto-char start)
(while (< (point) (mark t))
- (insert message-yank-prefix)
+ (if (looking-at message-cite-prefix-regexp)
+ (insert message-yank-cited-prefix)
+ (insert message-yank-prefix))
(forward-line 1))))
(goto-char start)))
(backward-delete-char 1)))))
(unless arg
- (funcall message-cite-function))
+ (if (and message-suspend-font-lock-when-citing
+ (boundp 'font-lock-mode)
+ (symbol-value 'font-lock-mode))
+ (unwind-protect
+ (progn
+ (sit-for 0)
+ (font-lock-mode 0)
+ (funcall message-cite-function))
+ (font-lock-mode 1))
+ (funcall message-cite-function)))
(message-exchange-point-and-mark)
(unless (bolp)
(insert ?\n))
(format
"Already sent message via %s; resend? "
(car elem)))
- (error "Denied posting -- multiple copies.")))
+ (error "Denied posting -- multiple copies")))
(setq success (funcall (caddr elem) arg)))
(setq sent t)))))
(unless (or sent (not success))
(delete-region (match-end 0) (std11-field-end))
(insert " " (message-make-message-id))))
(condition-case err
- (funcall message-send-mail-function)
+ (funcall (or message-send-mail-real-function
+ message-send-mail-function))
(error
(throw 'message-sending-mail-failure err))))))
nil)
(condition-case err
(progn
- (funcall message-send-mail-function)
+ (funcall (or message-send-mail-real-function
+ message-send-mail-function))
nil)
(error err))))
(when failure
(insert "\n")
(widen)
(mm-with-unibyte-current-buffer
- (funcall message-send-mail-function)))
+ (funcall (or message-send-mail-real-function
+ message-send-mail-function))))
(setq n (+ n 1))
(setq p (pop plist))
(erase-buffer)))
;; 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"))
+ (100 (error "qmail-inject reported permanent failure"))
(111 (error "qmail-inject reported transient failure"))
;; should never happen
(t (error "qmail-inject reported unknown failure"))))
(if followup-to
(concat newsgroups "," followup-to)
newsgroups)))
- (hashtb (and (boundp 'gnus-active-hashtb)
- gnus-active-hashtb))
+ (known-groups
+ (mapcar '(lambda (n) (gnus-group-real-name n))
+ (gnus-groups-from-server
+ (cond ((equal gnus-post-method 'current)
+ gnus-current-select-method)
+ (gnus-post-method gnus-post-method)
+ (t gnus-select-method)))))
errors)
(while groups
- (when (and (not (boundp (intern (car groups) hashtb)))
- (not (equal (car groups) "poster")))
- (push (car groups) errors))
- (pop groups))
+ (unless (or (equal (car groups) "poster")
+ (member (car groups) known-groups))
+ (push (car groups) errors))
+ (pop groups))
(cond
;; Gnus is not running.
- ((or (not hashtb)
+ ((or (not (and (boundp 'gnus-active-hashtb)
+ gnus-active-hashtb))
(not (boundp 'gnus-read-active-file)))
t)
;; We don't have all the group names.
(message
"Denied posting -- the From looks strange: \"%s\"." from)
nil)
+ (t t))))
+ ;; Check the Reply-To header.
+ (message-check 'reply-to
+ (let* ((case-fold-search t)
+ (reply-to (message-fetch-field "reply-to"))
+ ad)
+ (cond
+ ((not reply-to)
+ t)
+ ((string-match "," reply-to)
+ (y-or-n-p
+ (format "Multiple Reply-To addresses: \"%s\". Really post? "
+ reply-to)))
+ ((or (not (string-match
+ "@[^\\.]*\\."
+ (setq ad (nth 1 (mail-extract-address-components
+ reply-to))))) ;larsi@ifi
+ (string-match "\\.\\." ad) ;larsi@ifi..uio
+ (string-match "@\\." ad) ;larsi@.ifi.uio
+ (string-match "\\.$" ad) ;larsi@ifi.uio.
+ (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
+ (string-match "(.*).*(.*)" reply-to)) ;(lars) (lars)
+ (y-or-n-p
+ (format
+ "The Reply-To looks strange: \"%s\". Really post? "
+ reply-to)))
(t t))))))
(defun message-check-news-body-syntax ()
(output-coding-system 'raw-text)
list file)
(save-excursion
- (set-buffer (get-buffer-create " *message temp*"))
- (erase-buffer)
- (insert-buffer-substring message-encoding-buffer)
(save-restriction
(message-narrow-to-headers)
- (while (setq file (message-fetch-field "fcc"))
- (push file list)
- (message-remove-header "fcc" nil t)))
- (goto-char (point-min))
- (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
- (replace-match "" t t)
- ;; Process FCC operations.
- (while list
- (setq file (pop list))
- (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 shell-command-switch
- (match-string 1 file))
- ;; Save the article.
- (setq file (expand-file-name file))
- (unless (file-exists-p (file-name-directory file))
- (make-directory (file-name-directory file) t))
- (if (and message-fcc-handler-function
- (not (eq message-fcc-handler-function 'rmail-output)))
- (funcall message-fcc-handler-function file)
- (if (and (file-readable-p file) (mail-file-babyl-p file))
- (rmail-output file 1 nil t)
- (let ((mail-use-rfc822 t))
- (rmail-output file 1 t t))))))
- (kill-buffer (current-buffer)))))
+ (setq file (message-fetch-field "fcc" t)))
+ (when file
+ (set-buffer (get-buffer-create " *message temp*"))
+ (erase-buffer)
+ (insert-buffer-substring message-encoding-buffer)
+ (save-restriction
+ (message-narrow-to-headers)
+ (while (setq file (message-fetch-field "fcc"))
+ (push file list)
+ (message-remove-header "fcc" nil t)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (replace-match "" t t))
+ ;; Process FCC operations.
+ (while list
+ (setq file (pop list))
+ (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 shell-command-switch
+ (match-string 1 file))
+ ;; Save the article.
+ (setq file (expand-file-name file))
+ (unless (file-exists-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
+ (if (and message-fcc-handler-function
+ (not (eq message-fcc-handler-function 'rmail-output)))
+ (funcall message-fcc-handler-function file)
+ (if (and (file-readable-p file) (mail-file-babyl-p file))
+ (rmail-output file 1 nil t)
+ (let ((mail-use-rfc822 t))
+ (rmail-output file 1 t t))))))
+ (kill-buffer (current-buffer))))))
(defun message-output (filename)
"Append this article to Unix/babyl mail file FILENAME."
(setq sign "-")
(setq zone (- zone)))
(concat
+ ;; The day name of the %a spec is locale-specific. Pfff.
+ (format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now))
+ parse-time-weekdays))))
(format-time-string "%d" now)
;; The month name of the %b spec is locale-specific. Pfff.
(format " %s "
(nthcdr (+ (- cut 2) surplus 1) list)))
(defun message-shorten-references (header references)
- "Trim REFERENCES to be less than 31 Message-ID long, and fold them.
+ "Trim REFERENCES to be 21 Message-ID long or less, and fold them.
If folding is disallowed, also check that the REFERENCES are less
than 988 characters long, and if they are not, trim them until they are."
- (let ((maxcount 31)
+ (let ((maxcount 21)
(count 0)
- (cut 6)
+ (cut 2)
refs)
(with-temp-buffer
(insert references)
;; Rename the buffer.
(if message-send-rename-function
(funcall message-send-rename-function)
- (when (string-match "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*"
- (buffer-name))
+ ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus.
+ (when (string-match
+ "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to "
+ (buffer-name))
(let ((name (match-string 2 (buffer-name)))
to group)
- (if (not (or (string-equal name "mail")
+ (if (not (or (null name)
+ (string-equal name "mail")
(string-equal name "news")))
(setq name (concat "*sent " name "*"))
+ (message-narrow-to-headers)
(setq to (message-fetch-field "to"))
(setq group (message-fetch-field "newsgroups"))
+ (widen)
(setq name
(cond
(to (concat "*sent mail to "
(nconc
`((To . ,(or to "")) (Subject . ,(or subject "")))
(when other-headers other-headers))
- replybuffer)
+ replybuffer send-actions)
;; FIXME: Should return nil if failure.
t))
mrt (when message-use-mail-reply-to
(message-fetch-field "mail-reply-to"))
mft (when (and (not (or to-address mrt reply-to))
- (or message-use-followup-to
- message-use-mail-followup-to))
+ message-use-mail-followup-to)
(message-fetch-field "mail-followup-to")))
;; Handle special values of Mail-Copies-To.
;; Handle Mail-Followup-To.
(when (and mft
- (eq (or message-use-followup-to
- message-use-mail-followup-to) 'ask)
+ (eq message-use-mail-followup-to 'ask)
(not (message-y-or-n-p
(concat "Obey Mail-Followup-To: " mft "? ") t "\
You should normally obey the Mail-Followup-To: header.
(save-excursion
(message-set-work-buffer)
(if (and mft
- message-use-followup-to
- (or (not (eq message-use-followup-to 'ask))
+ wide
+ (or (not (eq message-use-mail-followup-to 'ask))
(message-y-or-n-p "Obey Mail-Followup-To? " t "\
You should normally obey the Mail-Followup-To: header. In this
article, it has the value of
"the specified addresses"
"that address only") ".
-If a message is posted to several mailing lists, Mail-Followup-To is
-often used to direct the following discussion to one list only,
+Most commonly, Mail-Followup-To is used by a mailing list poster to
+express that responses should be sent to just the list, and not the
+poster as well.
+
+If a message is posted to several mailing lists, Mail-Followup-To may
+also be used to direct the following discussion to one list only,
because discussions that are spread over several lists tend to be
fragmented and very difficult to follow.
-Also, some source/announcement lists are not indented for discussion;
+Also, some source/announcement lists are not intended for discussion;
responses here are directed to other addresses.")))
(insert mft)
(unless never-mct
(lambda (addr) (cdr addr)) ccalist ", "))))
(when (string-match "^ +" (cdr ccs))
(setcdr ccs (substring (cdr ccs) (match-end 0))))
- (push ccs follow-to)))))
+ (push ccs follow-to)))
+ ;; Allow the user to be asked whether or not to reply to all
+ ;; recipients in a wide reply.
+ (if (and ccalist wide message-wide-reply-confirm-recipients
+ (not (y-or-n-p "Reply to all recipients?")))
+ (setq follow-to (delq (assoc 'Cc follow-to) follow-to)))))
follow-to))
;;;###autoload
distribution (message-fetch-field "distribution")
mct (when message-use-mail-copies-to
(message-fetch-field "mail-copies-to"))
- mft (when (or message-use-followup-to
- message-use-mail-followup-to)
+ mft (when message-use-mail-followup-to
(message-fetch-field "mail-followup-to")))
(when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
(string-match "<[^>]+>" gnus-warning))
because discussions that are spread over several newsgroup tend to
be fragmented and very difficult to follow.
-Also, some source/announcement newsgroups are not indented for discussion;
+Also, some source/announcement newsgroups are not intended for discussion;
responses here are directed to other newsgroups."))
(setq follow-to (list (cons 'Newsgroups followup-to)))
(setq follow-to (list (cons 'Newsgroups newsgroups)))))))
;; Handle Mail-Followup-To, followup via e-mail.
((and mft
- (or (not (eq (or message-use-followup-to
- message-use-mail-followup-to) 'ask))
+ (or (not (eq message-use-mail-followup-to 'ask))
(message-y-or-n-p
(concat "Obey Mail-Followup-To: " mft "? ") t "\
You should normally obey the Mail-Followup-To: header.
"^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):"
"Regexp that match headers that lists groups.")
+(defvar message-completion-alist
+ (list (cons message-newgroups-header-regexp 'message-expand-group)
+ '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name))
+ "Alist of (RE . FUN). Use FUN for completion on header lines matching RE.")
+
(defun message-tab ()
"Expand group names in Newsgroups and Followup-To headers.
Do a `tab-to-tab-stop' if not in those headers."
(interactive)
- (if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp))
- (mail-abbrev-in-expansion-header-p))
- (message-expand-group)
- (tab-to-tab-stop)))
+ (let ((alist message-completion-alist))
+ (while (and alist
+ (let ((mail-abbrev-mode-regexp (caar alist)))
+ (not (mail-abbrev-in-expansion-header-p))))
+ (setq alist (cdr alist)))
+ (funcall (or (cdar alist) (default-value 'indent-line-function)))))
(defun message-expand-group ()
"Expand the group name under point."
(goto-char (point-min))
(delete-region (point) (progn (forward-line 3) (point))))))))))
+(defun message-expand-name ()
+ (if (fboundp 'bbdb-complete-name)
+ (bbdb-complete-name)
+ (expand-abbrev)))
+
;;; Help stuff.
(defun message-talkative-question (ask question show &rest text)
(if (catch 'mime-edit-error
(save-excursion
(mime-edit-pgp-enclose-buffer)
- (mime-edit-translate-body)
- ))
- (error "Translation error!")
- )
- (end-of-invisible)
- (run-hooks 'mime-edit-exit-hook)
- ))
+ (mime-edit-translate-body)))
+ (error "Translation error!"))
+ (run-hooks 'mime-edit-exit-hook)))
(defun message-mime-insert-article (&optional full-headers)
(interactive "P")
(mail-strip-quoted-names
(message-fetch-field "from")))
(message-options-set 'message-recipients
- (mail-strip-quoted-names
- (concat
- (or (message-fetch-field "to") "") ", "
- (or (message-fetch-field "cc") "") ", "
- (or (message-fetch-field "bcc") ""))))))
+ (mail-strip-quoted-names
+ (let ((to (message-fetch-field "to"))
+ (cc (message-fetch-field "cc"))
+ (bcc (message-fetch-field "bcc")))
+ (concat
+ (or to "")
+ (if (and to cc) ", ")
+ (or cc "")
+ (if (and (or to cc) bcc) ", ")
+ (or bcc "")))))))
(when (featurep 'xemacs)
(require 'messagexmas)
projects / elisp / gnus.git- / blobdiff