;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
`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 'sexp)
(defcustom message-ignored-news-headers
- "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|X-Draft-From:"
+ "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:"
"*Regexp of headers to be removed unconditionally before posting."
:group 'message-news
:group 'message-headers
:type 'regexp)
(defcustom message-ignored-mail-headers
- "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|X-Draft-From:"
+ "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:"
"*Regexp of headers to be removed unconditionally before mailing."
:group 'message-mail
:group 'message-headers
: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."
:type 'sexp)
(defcustom message-generate-headers-first nil
- "*If non-nil, generate all possible headers before composing."
+ "*If non-nil, generate all required headers before composing.
+The variables `message-required-news-headers' and
+`message-required-mail-headers' specify which headers to generate.
+
+Note that the variable `message-deletable-headers' specifies headers which
+are to be deleted and then re-generated before sending, so this variable
+will not have a visible effect for those headers."
:group 'message-headers
:type 'boolean)
;;;###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
;;;###autoload
(defcustom message-signature-file "~/.signature"
- "*File containing the text inserted at end of message buffer."
- :type 'file
+ "*Name of file containing the text inserted at end of message buffer.
+Ignored if the named file doesn't exist.
+If nil, don't insert a signature."
+ :type '(choice file (const :tags "None" nil))
:group 'message-insertion)
(defcustom message-distribution-function nil
(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)
`empty-article' Allow you to post an empty article;
`quoted-text-only' Allow you to post quoted text only;
`multiple-copies' Allow you to post multiple copies.")
+;; `cancel-messages' Allow you to cancel or supersede others' messages.
(defsubst message-gnksa-enable-p (feature)
(or (not (listp message-shoot-gnksa-feet))
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")
(autoload 'gnus-request-post "gnus-int")
(autoload 'gnus-copy-article-buffer "gnus-msg")
(autoload 'gnus-alive-p "gnus-util")
+ (autoload 'gnus-server-string "gnus")
(autoload 'gnus-group-name-charset "gnus-group")
- (autoload 'rmail-output "rmail")
+ (autoload 'rmail-output "rmailout")
(autoload 'mu-cite-original "mu-cite"))
\f
(define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
(define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
(define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
- (define-key message-mode-map "\M-q" 'message-fill-paragraph)
+ ;;(define-key message-mode-map "\M-q" 'message-fill-paragraph)
(define-key message-mode-map "\t" 'message-tab)
(define-key message-mode-map "\M-;" 'comment-region)
["Newline and Reformat" message-newline-and-reformat t]
["Rename buffer" message-rename-buffer t]
["Spellcheck" ispell-message
- ,@(if (featurep 'xemacs) nil
+ ,@(if (featurep 'xemacs) '(t)
'(:help "Spellcheck this message"))]
["Attach file as MIME" mime-edit-insert-file
- ,@(if (featurep 'xemacs) nil
+ ,@(if (featurep 'xemacs) '(t)
'(:help "Attach a file at point"))]
"----"
["Send Message" message-send-and-exit
- ,@(if (featurep 'xemacs) nil
+ ,@(if (featurep 'xemacs) '(t)
'(:help "Send this message"))]
["Abort Message" message-dont-send
- ,@(if (featurep 'xemacs) nil
+ ,@(if (featurep 'xemacs) '(t)
'(:help "File this draft message and exit"))]
["Kill Message" message-kill-buffer
- ,@(if (featurep 'xemacs) nil
+ ,@(if (featurep 'xemacs) '(t)
'(:help "Delete this message without sending"))]))
(easy-menu-define
(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)
+ 'message-fill-paragraph)
(make-local-variable 'paragraph-separate)
(make-local-variable 'paragraph-start)
(make-local-variable 'adaptive-fill-regexp)
(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)))
(unless (bolp)
(insert "\n"))))
-(defun message-newline-and-reformat (&optional not-break)
- "Insert four newlines, and then reformat if inside quoted text."
- (interactive)
- (let (quoted point beg end leading-space)
+(defun message-newline-and-reformat (&optional arg not-break)
+ "Insert four newlines, and then reformat if inside quoted text.
+Prefix arg means justify as well."
+ (interactive (list (if current-prefix-arg 'full)))
+ (let (quoted point beg end leading-space bolp)
(setq point (point))
(beginning-of-line)
(setq beg (point))
+ (setq bolp (= beg point))
;; Find first line of the paragraph.
(if not-break
(while (and (not (eobp))
(setq leading-space (match-string 0)))
(if (and quoted
(not not-break)
+ (not bolp)
(< (- point beg) (length quoted)))
- ;; break in the cite prefix.
+ ;; break inside the cite prefix.
(setq quoted nil
end nil))
(if quoted
(narrow-to-region beg end)
(if not-break
(setq point nil)
- (insert "\n\n")
+ (if bolp
+ (insert "\n")
+ (insert "\n\n"))
(setq point (point))
(insert "\n\n")
(delete-region (point) (re-search-forward "[ \t]*"))
- (when quoted
+ (when (and quoted (not bolp))
(insert quoted leading-space)))
(if quoted
(let* ((adaptive-fill-regexp
(regexp-quote (concat quoted leading-space)))
(adaptive-fill-first-line-regexp
adaptive-fill-regexp ))
- (fill-paragraph nil))
- (fill-paragraph nil))
+ (fill-paragraph arg))
+ (fill-paragraph arg))
(if point (goto-char point)))))
-(defun message-fill-paragraph ()
+(defun message-fill-paragraph (&optional arg)
"Like `fill-paragraph'."
- (interactive)
- (message-newline-and-reformat t))
+ (interactive (list (if current-prefix-arg 'full)))
+ (message-newline-and-reformat arg t)
+ t)
(defun message-insert-signature (&optional force)
"Insert a signature. See documentation for variable `message-signature'."
(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))
(when message-indent-citation-function
(if (listp message-indent-citation-function)
message-indent-citation-function
- (list message-indent-citation-function)))))
+ (list message-indent-citation-function))))
+ (message-reply-headers (or message-reply-headers
+ (make-mail-header))))
+ (mail-header-set-from message-reply-headers
+ (save-restriction
+ (narrow-to-region
+ (point)
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max)))
+ (or (message-fetch-field "from")
+ "unknown sender")))
;; Allow undoing.
(undo-boundary)
(goto-char end)
(while (looking-at "^[ \t]*$")
(forward-line -1))
(forward-line 1)
- (delete-region (point) end))
+ (delete-region (point) end)
+ (unless (search-backward "\n\n" start t)
+ ;; Insert a blank line if it is peeled off.
+ (insert "\n")))
(goto-char start)
(while functions
(funcall (pop functions)))
(set-buffer message-encoding-buffer)
(erase-buffer)
;; Avoid copying text props.
- (insert (with-current-buffer message-edit-buffer
- (buffer-substring-no-properties (point-min) (point-max))))
+ (let (message-invisibles)
+ (insert
+ (with-current-buffer message-edit-buffer
+ (setq message-invisibles (message-find-invisible-regions))
+ (buffer-substring-no-properties (point-min) (point-max))))
+ ;; Inherit the invisible property of texts to make MIME-Edit
+ ;; find the MIME part boundaries.
+ (dolist (region message-invisibles)
+ (put-text-property (car region) (cdr region) 'invisible t)))
(funcall message-encode-function)
(while (and success
(setq elem (pop alist)))
(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))
(eval-after-load "invisible"
'(defalias 'invisible-region 'message-invisible-region))
+(defun message-find-invisible-regions ()
+ "Find invisible texts with the property `message-invisible' and
+return a list of points."
+ (let (from
+ (to (point-min))
+ regions)
+ (while (setq from (text-property-any to (point-max)
+ 'message-invisible t))
+ (setq to (or (text-property-not-all from (point-max)
+ 'message-invisible t)
+ (point-max)))
+ (push (cons from to) regions))
+ regions))
+
(defun message-fix-before-sending ()
"Do various things to make the message nice before sending it."
;; Make sure there's a newline at the end of the message.
(insert "\n"))
;; Expose all invisible text with the property `message-invisible'.
;; We should believe that the things might be created by MIME-Edit.
- (let (start)
- (while (setq start (text-property-any (point-min) (point-max)
- 'message-invisible t))
- (remove-text-properties start
- (or (text-property-not-all start (point-max)
- 'message-invisible t)
- (point-max))
- '(invisible nil message-invisible nil))))
- ;; Expose all invisible text.
- (message-check 'invisible-text
- (when (text-property-any (point-min) (point-max) 'invisible t)
- (put-text-property (point-min) (point-max) 'invisible nil)
- (unless (yes-or-no-p
- "Invisible text found and made visible; continue posting? ")
- (error "Invisible text found and made visible")))))
+ (let ((message-invisibles (message-find-invisible-regions)))
+ (dolist (region message-invisibles)
+ (put-text-property (car region) (cdr region) 'invisible nil))
+ ;; Expose all invisible text.
+ (message-check 'invisible-text
+ (when (text-property-any (point-min) (point-max) 'invisible t)
+ (put-text-property (point-min) (point-max) 'invisible nil)
+ (unless (yes-or-no-p
+ "Invisible text found and made visible; continue posting? ")
+ (error "Invisible text found and made visible"))))
+ ;; Hide again all text with the property `message-invisible'.
+ ;; It is needed to make MIME-Edit find the MIME part boundaries.
+ (dolist (region message-invisibles)
+ (put-text-property (car region) (cdr region) 'invisible t))))
(defun message-add-action (action &rest types)
"Add ACTION to be performed when doing an exit of type TYPES."
(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
(prin1-to-string failure)))))
(defun message-send-mail-partially ()
- "Sendmail as message/partial."
+ "Send mail as message/partial."
;; replace the header delimiter with a blank line
(goto-char (point-min))
(re-search-forward
(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)))
(or (message-fetch-field "cc")
(message-fetch-field "to"))
(let ((ct (mime-read-Content-Type)))
- (and (eq 'text (cdr (assq 'type ct)))
- (eq 'plain (cdr (assq 'subtype ct)))))))
+ (or (not ct)
+ (and (eq 'text (cdr (assq 'type ct)))
+ (eq 'plain (cdr (assq 'subtype ct))))))))
(message-insert-courtesy-copy))
(setq failure (message-maybe-split-and-send-mail)))
(kill-buffer tembuf))
;; 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"))))
(message-generate-headers message-required-news-headers)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
- (if group-name-charset
- (setq message-syntax-checks
- (cons '(valid-newsgroups . disabled)
- message-syntax-checks)))
+ (when group-name-charset
+ (setq message-syntax-checks
+ (cons '(valid-newsgroups . disabled)
+ message-syntax-checks)))
(message-cleanup-headers)
(if (not (message-check-news-syntax))
nil
(backward-char 1)
(run-hooks 'message-send-news-hook)
(gnus-open-server method)
+ (message "Sending news with %s..." (gnus-server-string method))
(gnus-request-post method)
))
(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)
- (if (or (not hashtb)
- (not (boundp 'gnus-read-active-file))
- (not gnus-read-active-file)
- (eq gnus-read-active-file 'some))
- t
- (while groups
- (when (and (not (boundp (intern (car groups) hashtb)))
- (not (equal (car groups) "poster")))
- (push (car groups) errors))
- (pop groups))
- (if (not errors)
- t
- (y-or-n-p
- (format
- "Really post to %s unknown group%s: %s? "
- (if (= (length errors) 1) "this" "these")
- (if (= (length errors) 1) "" "s")
- (mapconcat 'identity errors ", ")))))))
- ;; Check the Newsgroups & Followup-To headers for syntax errors.
- (message-check 'valid-newsgroups
- (let ((case-fold-search t)
- (headers '("Newsgroups" "Followup-To"))
- header error)
- (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))
- (memq
- nil (mapcar
- (lambda (g)
- (not (string-match "\\.\\'\\|\\.\\." g)))
- (message-tokenize-header header ","))))
- (setq error t)))
- (unless error
- (pop headers)))
- (if (not error)
- t
+ (while 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 (and (boundp 'gnus-active-hashtb)
+ gnus-active-hashtb))
+ (not (boundp 'gnus-read-active-file)))
+ t)
+ ;; We don't have all the group names.
+ ((and (or (not gnus-read-active-file)
+ (eq gnus-read-active-file 'some))
+ errors)
(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
+ (format
+ "Really post to %s possibly unknown group%s: %s? "
+ (if (= (length errors) 1) "this" "these")
+ (if (= (length errors) 1) "" "s")
+ (mapconcat 'identity errors ", "))))
+ ;; There were no errors.
+ ((not errors)
+ t)
+ ;; There are unknown groups.
+ (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)
- (from (message-fetch-field "from"))
- ad)
- (cond
- ((not from)
- (message "There is no From line. Posting is denied.")
- nil)
- ((or (not (string-match
- "@[^\\.]*\\."
- (setq ad (nth 1 (mail-extract-address-components
- from))))) ;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 "(.*).*(.*)" from)) ;(lars) (lars)
- (message
- "Denied posting -- the From looks strange: \"%s\"." from)
- nil)
- (t t))))))
+ (format
+ "Really post to %s unknown group%s: %s? "
+ (if (= (length errors) 1) "this" "these")
+ (if (= (length errors) 1) "" "s")
+ (mapconcat 'identity errors ", ")))))))
+ ;; Check the Newsgroups & Followup-To headers for syntax errors.
+ (message-check 'valid-newsgroups
+ (let ((case-fold-search t)
+ (headers '("Newsgroups" "Followup-To"))
+ header error)
+ (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))
+ (memq
+ nil (mapcar
+ (lambda (g)
+ (not (string-match "\\.\\'\\|\\.\\." g)))
+ (message-tokenize-header header ","))))
+ (setq error t)))
+ (unless error
+ (pop headers)))
+ (if (not error)
+ t
+ (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)
+ (from (message-fetch-field "from"))
+ ad)
+ (cond
+ ((not from)
+ (message "There is no From line. Posting is denied.")
+ nil)
+ ((or (not (string-match
+ "@[^\\.]*\\."
+ (setq ad (nth 1 (mail-extract-address-components
+ from))))) ;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 "(.*).*(.*)" from)) ;(lars) (lars)
+ (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 ()
(and
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1)
(while (and
- (progn
- (end-of-line)
- (< (current-column) 80))
+ (or (looking-at
+ mime-edit-tag-regexp)
+ (let ((p (point)))
+ (end-of-line)
+ (< (- (point) p) 80)))
(zerop (forward-line 1))))
(or (bolp)
(eobp)
(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 "\\`\\*\\(unsent \\)?" (buffer-name))
- (rename-buffer
- (concat "*sent " (substring (buffer-name) (match-end 0))) t)))
+ ;; 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 (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 "
+ (or (car (mail-extract-address-components to))
+ to) "*"))
+ ((and group (not (string= group "")))
+ (concat "*sent news on " group "*"))
+ (t "*sent mail*"))))
+ (unless (string-equal name (buffer-name))
+ (rename-buffer name t)))))
;; Push the current buffer onto the list.
(when message-max-buffers
(setq message-buffer-list
(if (gnus-alive-p)
(setq message-draft-article
(nndraft-request-associate-buffer "drafts"))
- (setq buffer-file-name (expand-file-name "*message*"
- message-auto-save-directory))
+ (setq buffer-file-name (expand-file-name
+ (if (eq system-type 'windows-nt)
+ "message"
+ "*message*")
+ message-auto-save-directory))
(setq buffer-auto-save-file-name (make-auto-save-file-name)))
(clear-visited-file-modtime)
(static-if (boundp 'MULE)
(nconc
`((To . ,(or to "")) (Subject . ,(or subject "")))
(when other-headers other-headers))
- replybuffer)
+ replybuffer send-actions)
;; FIXME: Should return nil if failure.
t))
"that mailing list") ".")))
(setq mft nil))
- (if (or (not wide)
- to-address)
+ (if (and (not mft)
+ (or (not wide)
+ to-address))
(progn
(setq follow-to (list (cons 'To
(or to-address mrt reply-to mft from))))
- (when (and wide mct)
+ (when (and wide mct
+ (not (member (cons 'To mct) follow-to)))
(push (cons 'Cc mct) follow-to)))
(let (ccalist)
(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
(defun message-reply (&optional to-address wide)
"Start editing a reply to the article in the current buffer."
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)))))))
(interactive "P")
(unless (message-news-p)
(error "This is not a news article; canceling is impossible"))
- (when (yes-or-no-p "Do you really want to cancel this article? ")
- (let (from newsgroups message-id distribution buf sender)
- (save-excursion
- ;; Get header info from original article.
- (save-restriction
- (message-narrow-to-head-1)
- (setq from (message-fetch-field "from")
- sender (message-fetch-field "sender")
- newsgroups (message-fetch-field "newsgroups")
- message-id (message-fetch-field "message-id" t)
- distribution (message-fetch-field "distribution")))
- ;; Make sure that this article was written by the user.
- (unless (or (and sender
- (string-equal
- (downcase sender)
- (downcase (message-make-sender))))
- (string-equal
- (downcase (cadr (std11-extract-address-components
- from)))
- (downcase (cadr (std11-extract-address-components
- (message-make-from))))))
- (error "This article is not yours"))
+ (let (from newsgroups message-id distribution buf sender)
+ (save-excursion
+ ;; Get header info from original article.
+ (save-restriction
+ (message-narrow-to-head-1)
+ (setq from (message-fetch-field "from")
+ sender (message-fetch-field "sender")
+ newsgroups (message-fetch-field "newsgroups")
+ message-id (message-fetch-field "message-id" t)
+ distribution (message-fetch-field "distribution")))
+ ;; Make sure that this article was written by the user.
+ (unless (or (message-gnksa-enable-p 'cancel-messages)
+ (and sender
+ (string-equal
+ (downcase sender)
+ (downcase (message-make-sender))))
+ (string-equal
+ (downcase (cadr (std11-extract-address-components from)))
+ (downcase (cadr (std11-extract-address-components
+ (message-make-from))))))
+ (error "This article is not yours"))
+ (when (yes-or-no-p "Do you really want to cancel this article? ")
;; Make control message.
(if arg
(message-news)
(setq buf (set-buffer (get-buffer-create " *message cancel*"))))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
- "From: " from "\n"
+ "From: " from "\n"
"Subject: cmsg cancel " message-id "\n"
"Control: cancel " message-id "\n"
(if distribution
mail-header-separator "\n"
message-cancel-message)
(run-hooks 'message-cancel-hook)
- (message "Canceling your article...")
(unless arg
+ (message "Canceling your article...")
(if (let ((message-syntax-checks
'dont-check-for-anything-just-trust-me)
(message-encoding-buffer (current-buffer))
(sender (message-fetch-field "sender"))
(from (message-fetch-field "from")))
;; Check whether the user owns the article that is to be superseded.
- (unless (or (and sender
+ (unless (or (message-gnksa-enable-p 'cancel-messages)
+ (and sender
(string-equal
(downcase sender)
(downcase (message-make-sender))))
;;; Forwarding messages.
+(defvar message-forward-decoded-p nil
+ "Non-nil means the original message is decoded.")
+
(defun message-forward-subject-author-subject (subject)
"Generate a SUBJECT for a forwarded message.
The form is: [Source] Subject, where if the original message was mail,
Source is the sender, and if the original message was news, Source is
the list of newsgroups is was posted to."
(concat "["
- (or (message-fetch-field
- (if (message-news-p) "newsgroups" "from"))
- "(nowhere)")
+ (if (message-news-p)
+ (or (message-fetch-field "newsgroups")
+ "(nowhere)")
+ (let ((from (message-fetch-field "from")))
+ (if from
+ (nnheader-decode-from from)
+ "(nobody)")))
"] " subject))
(defun message-forward-subject-fwd (subject)
(subject (message-fetch-field "Subject")))
(setq subject
(if subject
- (nnheader-decode-subject subject)
+ (if message-forward-decoded-p
+ subject
+ (nnheader-decode-subject subject))
""))
(if message-wash-forwarded-subjects
(setq subject (message-wash-subject subject)))
"^\\(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")
(when lines
(insert lines))
(setq content-type-p
- (re-search-backward "^Content-Type:" nil t)))
+ (or mml-boundary
+ (re-search-backward "^Content-Type:" nil t))))
(save-restriction
(message-narrow-to-headers-or-head)
(message-remove-first-header "Content-Type")
(mail-strip-quoted-names
(message-fetch-field "from")))
(message-options-set 'message-recipients
- (mail-strip-quoted-names
- (message-fetch-field "to")))))
+ (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)
(interactive)
(message "Saving %s..." buffer-file-name)
(let ((reply-headers message-reply-headers)
- (msg (buffer-substring-no-properties (point-min) (point-max))))
+ (msg (buffer-substring-no-properties (point-min) (point-max)))
+ (message-invisibles (message-find-invisible-regions)))
(with-temp-file buffer-file-name
(insert msg)
+ ;; Inherit the invisible property of texts to make MIME-Edit
+ ;; find the MIME part boundaries.
+ (dolist (region message-invisibles)
+ (put-text-property (car region) (cdr region) 'invisible t))
(setq message-reply-headers reply-headers)
(message-generate-headers '((optional . In-Reply-To)))
(mime-edit-translate-buffer))
projects / elisp / gnus.git- / blobdiff