** Group Carbon Copy (GCC) quoting
To support groups that contains SPC and other weird characters, groups
-are quoted before they are placed in the Gcc: header. While this
-should not cause problems, errorenous local customization may cause
-problems. In particular, if you have local customizations (e.g.,
-variables such as gnus-message-archive-group) that return the string
-"nnml:foo, nnml:bar" (indicating Gcc into two groups) you must change
-it to return the list ("nnml:foo" "nnml:bar"), otherwise the Gcc: line
-will be quoted incorrectly. Note that returning the string "nnml:foo,
-nnml:bar" was incorrect earlier, it just didn't generate any problems.
+are quoted before they are placed in the Gcc: header. This means
+variables such as `gnus-message-archive-group' should no longer
+contain quote characters to make groups containing SPC work. Also, if
+you are using the string "nnml:foo, nnml:bar" (indicating Gcc into two
+groups) you must change it to return the list ("nnml:foo" "nnml:bar"),
+otherwise the Gcc: line will be quoted incorrectly. Note that
+returning the string "nnml:foo, nnml:bar" was incorrect earlier, it
+just didn't generate any problems since it was inserted directly.
** gnus-agent
+2002-09-17 Simon Josefsson <jas@extundo.com>
+
+ * nnimap.el (nnimap-expiry-target): Don't search for which
+ articles exists here.
+ (nnimap-request-expire-articles): Do it here instead. Only expire
+ when articles are found. Suggested by Nevin Kapur
+ <nevin@jhu.edu>.
+
+2002-09-17 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+ From Reiner Steib <reiner.steib@gmx.de>.
+
+ * message.el (message-strip-subject-trailing-was)
+ (message-change-subject, message-add-archive-header)
+ (message-xpost-fup2-header, message-xpost-insert-note)
+ (message-xpost-fup2, message-reduce-to-to-cc): New functions
+ adopted from message-utils.el. Add functions to the keymap, mode
+ describtion and menu.
+ (message-change-subject,message-xpost-fup2): Signal error if
+ current header is empty.
+ (message-xpost-insert-note): Changed insert position.
+ (message-archive-note): Ensure to insert note in message body (not
+ in head).
+ (message-archive-header, message-archive-note)
+ (message-xpost-default, message-xpost-note, message-fup2-note)
+ (message-xpost-note-function): New variables adopted from
+ message-utils.el. Changed some doc-strings.
+ (message-mark-insert-{begin,end}): Rename from
+ message-{begin,end}-inserted-text-mark (message-utils.el), changed
+ values.
+ (message-subject-trailing-was-query)
+ (message-subject-trailing-was-ask-regexp)
+ (message-subject-trailing-was-regexp): New variables.
+ (message-to-list-only): Added doc-string and menu entry.
+
+ * message-utils.el: Removed. Functions are now in message.el.
+
2002-09-16 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-art.el (gnus-article-reply-with-original,
+++ /dev/null
-;;; message-utils.el -- utils for message-mode
-
-;; Copyright (C) 2002 Free Software Foundation, Inc.
-
-;; Author: Holger Schauer <Holger.Schauer@gmx.de>
-;; Keywords: utils message
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2 of the License, or
-;; (at your option) any later version.
-;;
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This file contains some small additions to message mode:
-;; * inserting files in a message and explicit marking it
-;; as something somebody else has created,
-;; * change Subject: header and add (was: <old subject>)
-;; * strip (was: <old subject>) from Subject: headers
-;; * add a X-No-Archive: Yes header and a note in the body
-;; * a function for cross-post and followup-to messages
-;; * replace To: header with contents of Cc: or Bcc: header.
-;;
-
-;; This file is adopt from the link below when the revision is 0.8.
-;; http://www.coling.uni-freiburg.de/~schauer/resources/emacs/message-utils.el.gz
-
-;;; Installation: (TODO: merge into message.el)
-
-;; .. is easy as in most cases. Add
-;; (autoload 'message-mark-inserted-region "message-utils" nil t)
-;; (autoload 'message-mark-insert-file "message-utils" nil t)
-;; (autoload 'message-strip-subject-was "message-utils" nil t)
-;; (autoload 'message-change-subject "message-utils" nil t)
-;; (autoload 'message-xpost-fup2 "message-utils" nil t)
-;; (autoload 'message-add-archive-header "message-utils" nil t)
-;; (autoload 'message-reduce-to-to-cc "message-utils" nil t)
-;; as well as some keybindings like
-;; (define-key message-mode-map '[(control c) m] 'message-mark-inserted-region)
-;; (define-key message-mode-map '[(control c) f] 'message-mark-insert-file)
-;; (define-key message-mode-map '[(control c) x] 'message-xpost-fup2)
-;; (define-key message-mode-map '[(control c) s] 'message-change-subject)
-;; (define-key message-mode-map '[(control c) a] 'message-add-archive-header)
-;; (define-key message-mode-map '[(control c) t] 'message-reduce-to-to-cc)
-;; (add-hook 'message-header-setup-hook 'message-strip-subject-was)
-;; to your .gnus or to your .emacs.
-;; You might also want to add something along the following lines:
-;; (defun message-utils-setup ()
-;; "Add menu-entries for message-utils."
-;; (easy-menu-add-item nil '("Message")
-;; ["Insert Region Marked" message-mark-inserted-region t] "Spellcheck")
-;; (easy-menu-add-item nil '("Message")
-;; ["Insert File Marked" message-mark-insert-file t] "Spellcheck")
-;; (easy-menu-add-item nil '("Field")
-;; ["Crosspost / Followup" message-xpost-fup2 t] "----")
-;; (easy-menu-add-item nil '("Field")
-;; ["New Subject" message-change-subject t] "----")
-;; (easy-menu-add-item nil '("Field")
-;; ["Reduce To: to Cc:" message-reduce-to-to-cc t] "----")
-;; (easy-menu-add-item nil '("Field")
-;; [ "X-No-Archive:" message-add-archive-header t ]))
-;; (add-hook 'message-mode-hook 'message-utils-setup)
-
-;;; Code:
-
-(require 'message)
-
-;;; **************
-;;; Inserting and marking ...
-
-; We try to hook the vars into the message customize group
-
-(defcustom message-begin-inserted-text-mark
-"--8<------------------------schnipp------------------------->8---\n"
-"How to mark the beginning of some inserted text."
- :type 'string
- :group 'message-various)
-
-(defcustom message-end-inserted-text-mark
-"--8<------------------------schnapp------------------------->8---\n"
-"How to mark the end of some inserted text."
- :type 'string
- :group 'message-various)
-
-;;;###autoload
-(defun message-mark-inserted-region (beg end)
- "Mark some region in the current article with enclosing tags.
-See `message-begin-inserted-text-mark' and `message-end-inserted-text-mark'."
- (interactive "r")
- (save-excursion
- ; add to the end of the region first, otherwise end would be invalid
- (goto-char end)
- (insert message-end-inserted-text-mark)
- (goto-char beg)
- (insert message-begin-inserted-text-mark)))
-
-;;;###autoload
-(defun message-mark-insert-file (file)
- "Inserts FILE at point, marking it with enclosing tags.
-See `message-begin-inserted-text-mark' and `message-end-inserted-text-mark'."
- (interactive "fFile to insert: ")
- ;; reverse insertion to get correct result.
- (let ((p (point)))
- (insert message-end-inserted-text-mark)
- (goto-char p)
- (insert-file-contents file)
- (goto-char p)
- (insert message-begin-inserted-text-mark)))
-
-;;; **************
-;;; Subject mangling
-
-(defcustom message-subject-was-regexp
- "[ \t]*\\((*[Ww][Aa][SsRr]:[ \t]*.*)\\)"
- "*Regexp matching \"(was: <old subject>)\" in the subject line."
- :group 'message-various
- :type 'regexp)
-
-;;;###autoload
-(defun message-strip-subject-was ()
- "Remove trailing \"(Was: <old subject>)\" from subject lines."
- (message-narrow-to-head)
- (let* ((subject (message-fetch-field "Subject"))
- (pos))
- (cond (subject
- (setq pos (or (string-match message-subject-was-regexp subject) 0))
- (cond ((> pos 0)
- (message-goto-subject)
- (message-delete-line)
- (insert (concat "Subject: "
- (substring subject 0 pos) "\n")))))))
- (widen))
-
-;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/
-;;;###autoload
-(defun message-change-subject (new-subject)
- "Ask for new Subject: header, append (was: <Old Subject>)."
- (interactive
- (list
- (read-from-minibuffer "New subject: ")))
- (cond ((and (not (or (null new-subject) ; new subject not empty
- (zerop (string-width new-subject))
- (string-match "^[ \t]*$" new-subject))))
- (save-excursion
- (let ((old-subject (message-fetch-field "Subject")))
- (cond ((not (string-match
- (concat "^[ \t]*"
- (regexp-quote new-subject)
- " \t]*$")
- old-subject)) ; yes, it really is a new subject
- ;; delete eventual Re: prefix
- (setq old-subject
- (message-strip-subject-re old-subject))
- (message-goto-subject)
- (message-delete-line)
- (insert (concat "Subject: "
- new-subject
- " (was: "
- old-subject ")\n")))))))))
-
-
-;;; **************
-;;; X-Archive-Header: No
-
-(defcustom message-archive-header
- "X-No-Archive: Yes\n"
- "Header to insert when you don't want your article to be archived by deja.com."
- :type 'string
- :group 'message-various)
-
-(defcustom message-archive-note
- "X-No-Archive: Yes - save http://deja.com/"
- "Note to insert why you wouldn't want this posting archived."
- :type 'string
- :group 'message-various)
-
-(defun message-add-archive-header ()
- "Insert \"X-No-Archive: Yes\" in the header and a note in the body.
-When called with a prefix argument, ask for a text to insert."
- (interactive)
- (if current-prefix-arg
- (setq message-archive-note
- (read-from-minibuffer "Reason for No-Archive: "
- (cons message-archive-note 0))))
- (save-excursion
- (insert message-archive-note)
- (newline)
- (message-add-header message-archive-header)
- (message-sort-headers)))
-
-;;; **************
-;;; Crossposts and Followups
-
-; inspired by JoH-followup-to by Jochem Huhman <joh at gmx.de>
-; new suggestions by R. Weikusat <rw at another.de>
-
-(defvar message-xpost-old-target nil
- "Old target for cross-posts or follow-ups.")
-(make-variable-buffer-local 'message-xpost-old-target)
-
-(defcustom message-xpost-default t
- "When non-nil `message-xpost-fup2' will normally perform a crosspost.
-If nil, `message-xpost-fup2' will only do a followup. Note that you
-can explicitly override this setting by calling `message-xpost-fup2'
-with a prefix."
- :type 'boolean
- :group 'message-various)
-
-(defun message-xpost-fup2-header (target-group)
- "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
-With prefix-argument just set Follow-Up, don't cross-post."
- (interactive
- (list ; Completion based on Gnus
- (completing-read "Followup To: "
- (if (boundp 'gnus-newsrc-alist)
- gnus-newsrc-alist)
- nil nil '("poster" . 0)
- (if (boundp 'gnus-group-history)
- 'gnus-group-history))))
- (message-remove-header "Follow[Uu]p-[Tt]o" t)
- (message-goto-newsgroups)
- (beginning-of-line)
- ;; if we already did a crosspost before, kill old target
- (if (and message-xpost-old-target
- (re-search-forward
- (regexp-quote (concat "," message-xpost-old-target))
- nil t))
- (replace-match ""))
- ;; unless (followup is to poster or user explicitly asked not
- ;; to cross-post, or target-group is already in Newsgroups)
- ;; add target-group to Newsgroups line.
- (cond ((and (or (and message-xpost-default (not current-prefix-arg)) ; def: xpost, req:no
- (and (not message-xpost-default) current-prefix-arg)) ; def: no-xpost, req:yes
- (not (string-match "poster" target-group))
- (not (string-match (regexp-quote target-group)
- (message-fetch-field "Newsgroups"))))
- (end-of-line)
- (insert-string (concat "," target-group))))
- (end-of-line) ; ensure Followup: comes after Newsgroups:
- ;; unless new followup would be identical to Newsgroups line
- ;; make a new Followup-To line
- (if (not (string-match (concat "^[ \t]*"
- target-group
- "[ \t]*$")
- (message-fetch-field "Newsgroups")))
- (insert (concat "\nFollowup-To: " target-group)))
- (setq message-xpost-old-target target-group))
-
-
-(defcustom message-xpost-note
- "Crosspost & Followup-To: "
- "Note to insert before signature to notify of xpost and follow-up."
- :type 'string
- :group 'message-various)
-
-(defcustom message-fup2-note
- "Followup-To: "
- "Note to insert before signature to notify of follow-up only."
- :type 'string
- :group 'message-various)
-
-(defun message-xpost-insert-note (target-group xpost in-old old-groups)
- "Insert a in message body note about a set Followup or Crosspost.
-If there have been previous notes, delete them. TARGET-GROUP specifies the
-group to Followup-To. When XPOST is t, insert note about
-crossposting. IN-OLD specifies whether TARGET-GROUP is a member of
-OLD-GROUPS. OLD-GROUPS lists the old-groups the posting would have
-been made to before the user asked for a Crosspost."
- ;; start scanning body for previous uses
- (message-goto-signature)
- (let ((head (re-search-backward
- (concat "^" mail-header-separator)
- nil t))) ; just search in body
- (message-goto-signature)
- (while (re-search-backward
- (concat "^" (regexp-quote message-xpost-note) ".*")
- head t)
- (message-delete-line))
- (message-goto-signature)
- (while (re-search-backward
- (concat "^" (regexp-quote message-fup2-note) ".*")
- head t)
- (message-delete-line))
- ;; insert new note
- (message-goto-signature)
- (previous-line 2)
- (open-line 1)
- (if (or in-old
- (not xpost)
- (string-match "^[ \t]*poster[ \t]*$" target-group))
- (insert (concat message-fup2-note target-group "\n"))
- (insert (concat message-xpost-note target-group "\n")))))
-
-(defcustom message-xpost-note-function
- 'message-xpost-insert-note
- "Function to use to insert note about Crosspost or Followup-To.
-The function will be called with four arguments. The function should not
-only insert a note, but also ensure old notes are deleted. See the
-documentation for `message-xpost-insert-note'. "
- :type 'function
- :group 'message-various)
-
-;;;###autoload
-(defun message-xpost-fup2 (target-group)
- "Crossposts message and sets Followup-To to TARGET-GROUP.
-With prefix-argument just set Follow-Up, don't cross-post."
- (interactive
- (list ; Completion based on Gnus
- (completing-read "Followup To: "
- (if (boundp 'gnus-newsrc-alist)
- gnus-newsrc-alist)
- nil nil '("poster" . 0)
- (if (boundp 'gnus-group-history)
- 'gnus-group-history))))
- (cond ((not (or (null target-group) ; new subject not empty
- (zerop (string-width target-group))
- (string-match "^[ \t]*$" target-group)))
- (save-excursion
- (let* ((old-groups (message-fetch-field "Newsgroups"))
- (in-old (string-match
- (regexp-quote target-group) old-groups)))
- ;; check whether target exactly matches old Newsgroups
- (cond ((or (not in-old)
- (not (string-match
- (concat "^[ \t]*"
- (regexp-quote target-group)
- "[ \t]*$")
- old-groups)))
- ;; yes, Newsgroups line must change
- (message-xpost-fup2-header target-group)
- ;; insert note whether we do xpost or fup2
- (funcall message-xpost-note-function
- target-group
- (if (or (and message-xpost-default (not current-prefix-arg))
- (and (not message-xpost-default) current-prefix-arg))
- t)
- in-old old-groups))))))))
-
-
-;;; **************
-;;; Reduce To: to Cc: or Bcc: header
-
-(defun message-reduce-to-to-cc ()
- "Replace contents of To: header with contents of Cc: or Bcc: header."
- (interactive)
- (let ((cc-content (message-fetch-field "cc"))
- (bcc nil))
- (if (and (not cc-content)
- (setq cc-content (message-fetch-field "bcc")))
- (setq bcc t))
- (cond (cc-content
- (save-excursion
- (message-goto-to)
- (message-delete-line)
- (insert (concat "To: " cc-content "\n"))
- (message-remove-header (if bcc
- "bcc"
- "cc")))))))
-
-;;; provide ourself
-(provide 'message-utils)
-
-;;; message-utils.el ends here
:group 'message-sending
:type 'function)
+;;; Start of variables adopted from `message-utils.el'.
+
+(defcustom message-subject-trailing-was-query 'ask
+ ;; should it default to nil or ask?
+ "*What to do with trailing \"(was: <old subject>)\" in subject lines.
+If nil, leave the subject unchanged. If it is the symbol `ask', query
+the user what do do. In this case, the subject is matched against
+`message-subject-trailing-was-ask-regexp'. If
+`message-subject-trailing-was-query' is t, always strip the trailing
+old subject. In this case, `message-subject-trailing-was-regexp' is
+used."
+ :type '(choice (const :tag "never" nil)
+ (const :tag "always strip" t)
+ (const ask))
+ :group 'message-various)
+
+(defcustom message-subject-trailing-was-ask-regexp
+ "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)"
+ "*Regexp matching \"(was: <old subject>)\" in the subject line.
+
+The function `message-strip-subject-trailing-was' uses this regexp if
+`message-subject-trailing-was-query' is set to the symbol `ask'. If
+the variable is t instead of `ask', use
+`message-subject-trailing-was-regexp' instead.
+
+It is okay to create some false positives here, as the user is asked."
+ :group 'message-various
+ :type 'regexp)
+
+(defcustom message-subject-trailing-was-regexp
+ "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)"
+ "*Regexp matching \"(was: <old subject>)\" in the subject line.
+
+If `message-subject-trailing-was-query' is set to t, the subject is
+matched against `message-subject-trailing-was-regexp' in
+`message-strip-subject-trailing-was'. You should use a regexp creating very
+few false positives here."
+ :group 'message-various
+ :type 'regexp)
+
+;;; marking inserted text
+
+;;;###autoload
+(defcustom message-mark-insert-begin
+ "--8<---------------cut here---------------start------------->8---\n"
+ "How to mark the beginning of some inserted text."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-mark-insert-end
+ "--8<---------------cut here---------------end--------------->8---\n"
+ "How to mark the end of some inserted text."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-archive-header
+ "X-No-Archive: Yes\n"
+ "Header to insert when you don't want your article to be archived.
+Archives \(such as groups.googgle.com\) respect this header."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-archive-note
+ "X-No-Archive: Yes - save http://groups.google.com/"
+ "Note to insert why you wouldn't want this posting archived.
+If nil, don't insert any text in the body."
+ :type 'string
+ :group 'message-various)
+
+;;; Crossposts and Followups
+;; inspired by JoH-followup-to by Jochem Huhman <joh at gmx.de>
+;; new suggestions by R. Weikusat <rw at another.de>
+
+(defvar message-xpost-old-target nil
+ "Old target for cross-posts or follow-ups.")
+(make-variable-buffer-local 'message-xpost-old-target)
+
+;;;###autoload
+(defcustom message-xpost-default t
+ "When non-nil `message-xpost-fup2' will normally perform a crosspost.
+If nil, `message-xpost-fup2' will only do a followup. Note that you
+can explicitly override this setting by calling `message-xpost-fup2'
+with a prefix."
+ :type 'boolean
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-xpost-note
+ "Crosspost & Followup-To: "
+ "Note to insert before signature to notify of xpost and follow-up."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-fup2-note
+ "Followup-To: "
+ "Note to insert before signature to notify of follow-up only."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-xpost-note-function
+ 'message-xpost-insert-note
+ "Function to use to insert note about Crosspost or Followup-To.
+The function will be called with four arguments. The function should not only
+insert a note, but also ensure old notes are deleted. See the documentation
+for `message-xpost-insert-note'. "
+ :type 'function
+ :group 'message-various)
+
+;;; End of variables adopted from `message-utils.el'.
+
;;;###autoload
(defcustom message-from-style 'default
"*Specifies how \"From\" headers look.
(substring subject (match-end 0))
subject))
+;;; Start of functions adopted from `message-utils.el'.
+
+(defun message-strip-subject-trailing-was (subject)
+ "Remove trailing \"(Was: <old subject>)\" from subject lines.
+Leading \"Re: \" is not stripped by this function. Use the function
+`message-strip-subject-re' for this."
+ (let* ((query message-subject-trailing-was-query)
+ (new) (found))
+ (setq found
+ (string-match
+ (if (eq query 'ask)
+ message-subject-trailing-was-ask-regexp
+ message-subject-trailing-was-regexp)
+ subject))
+ (if found
+ (setq new (substring subject 0 (match-beginning 0))))
+ (if (or (not found) (eq query nil))
+ subject
+ (if (eq query 'ask)
+ (if (message-y-or-n-p
+ "Strip `(was: <old subject>)' in subject? " t
+ (concat
+ "Strip `(was: <old subject>)' in subject "
+ "and use the new one instead?\n\n"
+ "Current subject is: \""
+ subject "\"\n\n"
+ "New subject would be: \""
+ new "\"\n\n"
+ "See the variable `message-subject-trailing-was-query' "
+ "to get rid of this query."
+ ))
+ new subject)
+ new))))
+
+;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/
+
+;;;###autoload
+(defun message-change-subject (new-subject)
+ "Ask for new Subject: header, append (was: <Old Subject>)."
+ (interactive
+ (list
+ (read-from-minibuffer "New subject: ")))
+ (cond ((and (not (or (null new-subject) ; new subject not empty
+ (zerop (string-width new-subject))
+ (string-match "^[ \t]*$" new-subject))))
+ (save-excursion
+ (let ((old-subject (message-fetch-field "Subject")))
+ (cond ((not old-subject)
+ (error "No current subject."))
+ ((not (string-match
+ (concat "^[ \t]*"
+ (regexp-quote new-subject)
+ " \t]*$")
+ old-subject)) ; yes, it really is a new subject
+ ;; delete eventual Re: prefix
+ (setq old-subject
+ (message-strip-subject-re old-subject))
+ (message-goto-subject)
+ (message-delete-line)
+ (insert (concat "Subject: "
+ new-subject
+ " (was: "
+ old-subject ")\n")))))))))
+
+;;;###autoload
+(defun message-mark-inserted-region (beg end)
+ "Mark some region in the current article with enclosing tags.
+See `message-mark-insert-begin' and `message-mark-insert-end'."
+ (interactive "r")
+ (save-excursion
+ ; add to the end of the region first, otherwise end would be invalid
+ (goto-char end)
+ (insert message-mark-insert-end)
+ (goto-char beg)
+ (insert message-mark-insert-begin)))
+
+;;;###autoload
+(defun message-mark-insert-file (file)
+ "Inserts FILE at point, marking it with enclosing tags.
+See `message-mark-insert-begin' and `message-mark-insert-end'."
+ (interactive "fFile to insert: ")
+ ;; reverse insertion to get correct result.
+ (let ((p (point)))
+ (insert message-mark-insert-end)
+ (goto-char p)
+ (insert-file-contents file)
+ (goto-char p)
+ (insert message-mark-insert-begin)))
+
+;;;###autoload
+(defun message-add-archive-header ()
+ "Insert \"X-No-Archive: Yes\" in the header and a note in the body.
+The note can be customized using `message-archive-note'. When called with a
+prefix argument, ask for a text to insert. If you don't want the note in the
+body, set `message-archive-note' to nil."
+ (interactive)
+ (if current-prefix-arg
+ (setq message-archive-note
+ (read-from-minibuffer "Reason for No-Archive: "
+ (cons message-archive-note 0))))
+ (save-excursion
+ (if (message-goto-signature)
+ (re-search-backward message-signature-separator))
+ (when message-archive-note
+ (insert message-archive-note)
+ (newline))
+ (message-add-header message-archive-header)
+ (message-sort-headers)))
+
+;;;###autoload
+(defun message-xpost-fup2-header (target-group)
+ "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
+With prefix-argument just set Follow-Up, don't cross-post."
+ (interactive
+ (list ; Completion based on Gnus
+ (completing-read "Followup To: "
+ (if (boundp 'gnus-newsrc-alist)
+ gnus-newsrc-alist)
+ nil nil '("poster" . 0)
+ (if (boundp 'gnus-group-history)
+ 'gnus-group-history))))
+ (message-remove-header "Follow[Uu]p-[Tt]o" t)
+ (message-goto-newsgroups)
+ (beginning-of-line)
+ ;; if we already did a crosspost before, kill old target
+ (if (and message-xpost-old-target
+ (re-search-forward
+ (regexp-quote (concat "," message-xpost-old-target))
+ nil t))
+ (replace-match ""))
+ ;; unless (followup is to poster or user explicitly asked not
+ ;; to cross-post, or target-group is already in Newsgroups)
+ ;; add target-group to Newsgroups line.
+ (cond ((and (or
+ ;; def: xpost, req:no
+ (and message-xpost-default (not current-prefix-arg))
+ ;; def: no-xpost, req:yes
+ (and (not message-xpost-default) current-prefix-arg))
+ (not (string-match "poster" target-group))
+ (not (string-match (regexp-quote target-group)
+ (message-fetch-field "Newsgroups"))))
+ (end-of-line)
+ (insert-string (concat "," target-group))))
+ (end-of-line) ; ensure Followup: comes after Newsgroups:
+ ;; unless new followup would be identical to Newsgroups line
+ ;; make a new Followup-To line
+ (if (not (string-match (concat "^[ \t]*"
+ target-group
+ "[ \t]*$")
+ (message-fetch-field "Newsgroups")))
+ (insert (concat "\nFollowup-To: " target-group)))
+ (setq message-xpost-old-target target-group))
+
+;;;###autoload
+(defun message-xpost-insert-note (target-group xpost in-old old-groups)
+ "Insert a in message body note about a set Followup or Crosspost.
+If there have been previous notes, delete them. TARGET-GROUP specifies the
+group to Followup-To. When XPOST is t, insert note about
+crossposting. IN-OLD specifies whether TARGET-GROUP is a member of
+OLD-GROUPS. OLD-GROUPS lists the old-groups the posting would have
+been made to before the user asked for a Crosspost."
+ ;; start scanning body for previous uses
+ (message-goto-signature)
+ (let ((head (re-search-backward
+ (concat "^" mail-header-separator)
+ nil t))) ; just search in body
+ (message-goto-signature)
+ (while (re-search-backward
+ (concat "^" (regexp-quote message-xpost-note) ".*")
+ head t)
+ (message-delete-line))
+ (message-goto-signature)
+ (while (re-search-backward
+ (concat "^" (regexp-quote message-fup2-note) ".*")
+ head t)
+ (message-delete-line))
+ ;; insert new note
+ (if (message-goto-signature)
+ (re-search-backward message-signature-separator))
+ (if (or in-old
+ (not xpost)
+ (string-match "^[ \t]*poster[ \t]*$" target-group))
+ (insert (concat message-fup2-note target-group "\n"))
+ (insert (concat message-xpost-note target-group "\n")))))
+
+;;;###autoload
+(defun message-xpost-fup2 (target-group)
+ "Crossposts message and sets Followup-To to TARGET-GROUP.
+With prefix-argument just set Follow-Up, don't cross-post."
+ (interactive
+ (list ; Completion based on Gnus
+ (completing-read "Followup To: "
+ (if (boundp 'gnus-newsrc-alist)
+ gnus-newsrc-alist)
+ nil nil '("poster" . 0)
+ (if (boundp 'gnus-group-history)
+ 'gnus-group-history))))
+ (cond ((not (or (null target-group) ; new subject not empty
+ (zerop (string-width target-group))
+ (string-match "^[ \t]*$" target-group)))
+ (save-excursion
+ (let* ((old-groups (message-fetch-field "Newsgroups"))
+ (in-old (string-match
+ (regexp-quote target-group)
+ (or old-groups ""))))
+ ;; check whether target exactly matches old Newsgroups
+ (cond ((not old-groups)
+ (error "No current newsgroup."))
+ ((or (not in-old)
+ (not (string-match
+ (concat "^[ \t]*"
+ (regexp-quote target-group)
+ "[ \t]*$")
+ old-groups)))
+ ;; yes, Newsgroups line must change
+ (message-xpost-fup2-header target-group)
+ ;; insert note whether we do xpost or fup2
+ (funcall message-xpost-note-function
+ target-group
+ (if (or (and message-xpost-default
+ (not current-prefix-arg))
+ (and (not message-xpost-default)
+ current-prefix-arg)) t)
+ in-old old-groups))))))))
+
+;;; Reduce To: to Cc: or Bcc: header
+
+;;;###autoload
+(defun message-reduce-to-to-cc ()
+ "Replace contents of To: header with contents of Cc: or Bcc: header."
+ (interactive)
+ (let ((cc-content (message-fetch-field "cc"))
+ (bcc nil))
+ (if (and (not cc-content)
+ (setq cc-content (message-fetch-field "bcc")))
+ (setq bcc t))
+ (cond (cc-content
+ (save-excursion
+ (message-goto-to)
+ (message-delete-line)
+ (insert (concat "To: " cc-content "\n"))
+ (message-remove-header (if bcc
+ "bcc"
+ "cc")))))))
+
+;;; End of functions adopted from `message-utils.el'.
+
(defun message-remove-header (header &optional is-regexp first reverse)
"Remove HEADER in the narrowed buffer.
If IS-REGEXP, HEADER is a regular expression.
(define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
(define-key message-mode-map "\C-c\C-f\C-i" 'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\C-f\C-a" 'message-gen-unsubscribed-mft)
+
+ ;; modify headers (and insert notes in body)
+ (define-key message-mode-map "\C-c\C-fs" 'message-change-subject)
+ ;;
+ (define-key message-mode-map "\C-c\C-fx" 'message-xpost-fup2)
+ ;; prefix+message-xpost-fup2 = same w/o xpost
+ (define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc)
+ (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header)
+ ;; mark inserted text
+ (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region)
+ (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file)
+
(define-key message-mode-map "\C-c\C-b" 'message-goto-body)
(define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
(define-key message-mode-map "\C-c\C-fc" 'message-goto-mail-copies-to)
,@(if (featurep 'xemacs) '(t)
'(:help "Attach a file at point"))]
"----"
+ ["Insert Region Marked" message-mark-inserted-region
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mark region with enclosing tags"))]
+ ["Insert File Marked" message-mark-insert-file
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Insert file at point marked with enclosing tags"))]
+ "----"
["Send Message" message-send-and-exit
,@(if (featurep 'xemacs) '(t)
'(:help "Send this message"))]
["To" message-goto-to t]
["From" message-goto-from t]
["Subject" message-goto-subject t]
+ ["Change subject" message-change-subject t]
["Cc" message-goto-cc t]
+ ["Bcc" message-goto-bcc t]
+ ["Fcc" message-goto-fcc t]
["Reply-To" message-goto-reply-to t]
- ["Mail-Reply-To" message-goto-mail-reply-to t]
- ["Mail-Followup-To" message-goto-mail-followup-to t]
- ["Mail-Copies-To" message-goto-mail-copies-to t]
+ "----"
+ ;; (typical) news stuff
["Summary" message-goto-summary t]
["Keywords" message-goto-keywords t]
["Newsgroups" message-goto-newsgroups t]
["Followup-To" message-goto-followup-to t]
- ["Mail-Followup-To" message-goto-mail-followup-to t]
+ ;; ["Followup-To (with note in body)" message-xpost-fup2 t]
+ ["Crosspost / Followup-To" message-xpost-fup2 t]
["Distribution" message-goto-distribution t]
+ ["X-No-Archive:" message-add-archive-header t ]
+ "----"
+ ;; (typical) mailing-lists stuff
+ ["Send to list only" message-to-list-only t]
+ ["Mail-Followup-To" message-goto-mail-followup-to t]
+ ["Mail-Reply-To" message-goto-mail-reply-to t]
+ ["Mail-Copies-To" message-goto-mail-copies-to t]
+ ["Reduce To: to Cc:" message-reduce-to-to-cc t]
+ "----"
["Body" message-goto-body t]
["Signature" message-goto-signature t]))
C-c C-f C-o move to From (\"Originator\")
C-c C-f C-f move to Followup-To
C-c C-f C-m move to Mail-Followup-To
- C-c C-f C-i cycle through Importance values
C-c C-f c move to Mail-Copies-To
+ C-c C-f C-i cycle through Importance values
+ C-c C-f s change subject and append \"(was: <Old Subject>)\"
+ C-c C-f x crossposting with FollowUp-To header and note in body
+ C-c C-f t replace To: header with contents of Cc: or Bcc:
+ C-c C-f a Insert X-No-Archive: header and a note in the body
C-c C-t `message-insert-to' (add a To header to a news followup)
C-c C-l `message-to-list-only' (removes all but list address in to/cc)
C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply)
C-c C-r `message-caesar-buffer-body' (rot13 the message body).
C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance).
C-c M-n `message-insert-disposition-notification-to' (request receipt).
+C-c M-m `message-mark-inserted-region' (mark region with enclosing tags).
+C-c M-f `message-mark-insert-file' (insert file marked with enclosing tags).
M-RET `message-newline-and-reformat' (break the line and reformat)."
(setq local-abbrev-table text-mode-abbrev-table)
(set (make-local-variable 'message-reply-buffer) nil)
(message-make-fqdn)))
(defun message-to-list-only ()
+ "Send a message to the list only.
+Remove all addresses but the list address from To and Cc headers."
(interactive)
(let ((listaddr (message-make-mft t)))
(when listaddr
(when gnus-list-identifiers
(setq subject (message-strip-list-identifiers subject)))
(setq subject (message-make-followup-subject subject))
+ (when message-subject-trailing-was-query
+ (setq subject (message-strip-subject-trailing-was subject)))
(when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
(string-match "<[^>]+>" gnus-warning))
(if gnus-list-identifiers
(setq subject (message-strip-list-identifiers subject)))
(setq subject (message-make-followup-subject subject))
+ (when message-subject-trailing-was-query
+ (setq subject (message-strip-subject-trailing-was subject)))
(widen))
;; Handle special values of Mail-Copies-To.
(defun nnimap-expiry-target (arts group server)
(unless (eq nnmail-expiry-target 'delete)
(with-temp-buffer
- (dolist (art (imap-search (concat "UID "
- (imap-range-to-message-set
- (gnus-uncompress-sequence arts)))
- nnimap-server-buffer))
+ (dolist (art arts)
(nnimap-request-article art group server (current-buffer))
;; hints for optimization in `nnimap-request-accept-article'
(let ((nnimap-current-move-article art)
(let ((days (or (and nnmail-expiry-wait-function
(funcall nnmail-expiry-wait-function group))
nnmail-expiry-wait)))
- (cond (force
- (nnimap-expiry-target artseq group server)
- (when (imap-message-flags-add
- (imap-range-to-message-set artseq) "\\Deleted")
- (setq articles nil)))
- ((eq days 'immediate)
- (nnimap-expiry-target artseq group server)
- (when (imap-message-flags-add
- (imap-range-to-message-set artseq) "\\Deleted")
- (setq articles nil)))
+ (cond ((or force (eq days 'immediate))
+ (let ((oldarts (imap-search
+ (concat "UID "
+ (imap-range-to-message-set artseq)))))
+ (when oldarts
+ (nnimap-expiry-target oldarts group server))
+ (when (imap-message-flags-add
+ (imap-range-to-message-set oldarts) "\\Deleted")
+ (setq articles (gnus-set-difference
+ articles oldarts)))))
((numberp days)
(let ((oldarts (imap-search
(format nnimap-expunge-search-string
(nnimap-date-days-ago days))))
(imap-fetch-data-hook
'(nnimap-request-expire-articles-progress)))
- (nnimap-expiry-target oldarts group server)
- (and oldarts
- (imap-message-flags-add
- (imap-range-to-message-set
- (gnus-compress-sequence oldarts))
- "\\Deleted")
- (setq articles (gnus-set-difference
- articles oldarts))))))))))
+ (when oldarts
+ (nnimap-expiry-target oldarts group server))
+ (when (imap-message-flags-add
+ (imap-range-to-message-set oldarts) "\\Deleted")
+ (setq articles (gnus-set-difference
+ articles oldarts))))))))))
;; return articles not deleted
articles)
projects / elisp / gnus.git- / commitdiff