X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=d5f5b57d0a822307f89a71e0cad1aec314ec1776;hb=c40056695d7dcc4e7c71707009bc077a18a3344d;hp=cd6ad64ed624667d36ea9155407effae58215103;hpb=266f58d9304763341c950245c5bb5dc0c132d5cc;p=gnus diff --git a/lisp/nnmail.el b/lisp/nnmail.el index cd6ad64ed..d5f5b57d0 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,6 +1,7 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -19,8 +20,8 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -28,16 +29,16 @@ (eval-when-compile (require 'cl)) +(require 'gnus) ; for macro gnus-kill-buffer, at least (require 'nnheader) (require 'message) -(require 'custom) (require 'gnus-util) (require 'mail-source) (require 'mm-util) (eval-and-compile - (autoload 'gnus-error "gnus-util") - (autoload 'gnus-buffer-live-p "gnus-util")) + (autoload 'gnus-add-buffer "gnus") + (autoload 'gnus-kill-buffer "gnus")) (defgroup nnmail nil "Reading mail with Gnus." @@ -48,7 +49,7 @@ :group 'nnmail) (defgroup nnmail-prepare nil - "Preparing (or mangling) new mail after retrival." + "Preparing (or mangling) new mail after retrieval." :group 'nnmail) (defgroup nnmail-duplicate nil @@ -56,7 +57,7 @@ :group 'nnmail) (defgroup nnmail-split nil - "Organizing the incomming mail in folders." + "Organizing the incoming mail in folders." :group 'nnmail) (defgroup nnmail-files nil @@ -76,8 +77,7 @@ "Various mail options." :group 'nnmail) -(defcustom nnmail-split-methods - '(("mail.misc" "")) +(defcustom nnmail-split-methods '(("mail.misc" "")) "*Incoming mail will be split according to this variable. If you'd like, for instance, one mail group for mail from the @@ -86,8 +86,8 @@ else, you could do something like this: (setq nnmail-split-methods '((\"mail.4ad\" \"From:.*4ad\") - (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\") - (\"mail.misc\" \"\"))) + (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\") + (\"mail.misc\" \"\"))) As you can see, this variable is a list of lists, where the first element in each \"rule\" is the name of the group (which, by the way, @@ -104,7 +104,8 @@ The last element should always have \"\" as the regexp. This variable can also have a function as its value." :group 'nnmail-split - :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp)) + :type '(choice (repeat :tag "Alist" (group (string :tag "Name") + (choice regexp function))) (function-item nnmail-split-fancy) (function :tag "Other"))) @@ -115,6 +116,24 @@ If nil, the first match found will be used." :group 'nnmail-split :type 'boolean) +(defcustom nnmail-split-fancy-with-parent-ignore-groups nil + "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'. +This can also be a list of regexps." + :version "22.1" + :group 'nnmail-split + :type '(choice (const :tag "none" nil) + (regexp :value ".*") + (repeat :value (".*") regexp))) + +(defcustom nnmail-cache-ignore-groups nil + "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert'). +This can also be a list of regexps." + :version "22.1" + :group 'nnmail-split + :type '(choice (const :tag "none" nil) + (regexp :value ".*") + (repeat :value (".*") regexp))) + ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). (defcustom nnmail-keep-last-article nil "If non-nil, nnmail will never delete/move a group's last article. @@ -150,17 +169,17 @@ can also be `immediate' and `never'." (defcustom nnmail-expiry-wait-function nil "Variable that holds function to specify how old articles should be before they are expired. - The function will be called with the name of the group that the -expiry is to be performed in, and it should return an integer that -says how many days an article can be stored before it is considered -\"old\". It can also return the values `never' and `immediate'. +The function will be called with the name of the group that the expiry +is to be performed in, and it should return an integer that says how +many days an article can be stored before it is considered \"old\". +It can also return the values `never' and `immediate'. Eg.: \(setq nnmail-expiry-wait-function (lambda (newsgroup) - (cond ((string-match \"private\" newsgroup) 31) - ((string-match \"junk\" newsgroup) 1) + (cond ((string-match \"private\" newsgroup) 31) + ((string-match \"junk\" newsgroup) 1) ((string-match \"important\" newsgroup) 'never) (t 7))))" :group 'nnmail-expire @@ -176,10 +195,44 @@ called in a buffer narrowed to the message in question. The function receives one argument, the name of the group the message comes from. The return value should be `delete' or a group name (a string)." :version "21.1" - :group 'nnmail-expire - :type '(choice (const delete) - (function :format "%v" nnmail-) - string)) + :group 'nnmail-expire + :type '(choice (const delete) + (function :format "%v" nnmail-) + string)) + +(defcustom nnmail-fancy-expiry-targets nil + "Determine expiry target based on articles using fancy techniques. + +This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries. If +`nnmail-expiry-target' is set to the function +`nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP, +the message will be expired to a group determined by invoking +`format-time-string' with TARGET used as the format string and the +time extracted from the articles' Date header (if missing the current +time is used). + +In the special cases that HEADER is the symbol `to-from', the regexp +will try to match against both the From and the To header. + +Example: + +\(setq nnmail-fancy-expiry-targets + '((to-from \"boss\" \"nnfolder:Work\") + (\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\") + (\"from\" \".*\" \"nnfolder:Archive-%Y\"))) + +In this case, articles containing the string \"boss\" in the To or the +From header will be expired to the group \"nnfolder:Work\"; +articles containing the sting \"IMPORTANT\" in the Subject header will +be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and +everything else will be expired to \"nnfolder:Archive-YYYY\"." + :version "22.1" + :group 'nnmail-expire + :type '(repeat (list (choice :tag "Match against" + (string :tag "Header") + (const to-from)) + regexp + (string :tag "Target group format string")))) (defcustom nnmail-cache-accepted-message-ids nil "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache. @@ -238,9 +291,9 @@ running (\"xwatch\", etc.) Eg. \(add-hook 'nnmail-read-incoming-hook - (lambda () - (call-process \"/local/bin/mailsend\" nil nil nil - \"read\" nnmail-spool-file))) + (lambda () + (call-process \"/local/bin/mailsend\" nil nil nil + \"read\" nnmail-spool-file))) If you have xwatch running, this will alert it that mail has been read. @@ -300,12 +353,83 @@ discarded after running the split process." :group 'nnmail-split :type 'hook) +(defcustom nnmail-spool-hook nil + "*A hook called when a new article is spooled." + :version "22.1" + :group 'nnmail + :type 'hook) + (defcustom nnmail-large-newsgroup 50 - "*The number of the articles which indicates a large newsgroup. -If the number of the articles is greater than the value, verbose + "*The number of articles which indicates a large newsgroup or nil. +If the number of articles is greater than the value, verbose messages will be shown to indicate the current status." :group 'nnmail-various - :type 'integer) + :type '(choice (const :tag "infinite" nil) + (number :tag "count"))) + +(define-widget 'nnmail-lazy 'default + "Base widget for recursive datastructures. + +This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility." + :format "%{%t%}: %v" + :convert-widget 'widget-value-convert-widget + :value-create (lambda (widget) + (let ((value (widget-get widget :value)) + (type (widget-get widget :type))) + (widget-put widget :children + (list (widget-create-child-value + widget (widget-convert type) value))))) + :value-delete 'widget-children-value-delete + :value-get (lambda (widget) + (widget-value (car (widget-get widget :children)))) + :value-inline (lambda (widget) + (widget-apply (car (widget-get widget :children)) + :value-inline)) + :default-get (lambda (widget) + (widget-default-get + (widget-convert (widget-get widget :type)))) + :match (lambda (widget value) + (widget-apply (widget-convert (widget-get widget :type)) + :match value)) + :validate (lambda (widget) + (widget-apply (car (widget-get widget :children)) :validate))) + +(define-widget 'nnmail-split-fancy 'nnmail-lazy + "Widget for customizing splits in the variable of the same name." + :tag "Split" + :type '(menu-choice :value (any ".*value.*" "misc") + :tag "Type" + (string :tag "Destination") + (list :tag "Use first match (|)" :value (|) + (const :format "" |) + (editable-list :inline t nnmail-split-fancy)) + (list :tag "Use all matches (&)" :value (&) + (const :format "" &) + (editable-list :inline t nnmail-split-fancy)) + (list :tag "Function with fixed arguments (:)" + :value (:) + (const :format "" :value :) + function + (editable-list :inline t (sexp :tag "Arg")) + ) + (list :tag "Function with split arguments (!)" + :value (!) + (const :format "" !) + function + (editable-list :inline t nnmail-split-fancy)) + (list :tag "Field match" + (choice :tag "Field" + regexp symbol) + (choice :tag "Match" + regexp + (symbol :value mail)) + (repeat :inline t + :tag "Restrictions" + (group :inline t + (const :format "" -) + regexp)) + nnmail-split-fancy) + (const :tag "Junk (delete mail)" junk))) (defcustom nnmail-split-fancy "mail.misc" "Incoming mail can be split according to this fancy variable. @@ -319,7 +443,7 @@ GROUP: Mail will be stored in GROUP (a string). \(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message field FIELD (a regexp) contains VALUE (a regexp), store the messages as specified by SPLIT. If RESTRICT (a regexp) matches some string - after FIELD and before the end of the matched VALUE, return NIL, + after FIELD and before the end of the matched VALUE, return nil, otherwise process SPLIT. Multiple RESTRICTs add up, further restricting the possibility of processing SPLIT. @@ -337,11 +461,17 @@ GROUP: Mail will be stored in GROUP (a string). return value FUNCTION should be a split, which is then recursively processed. +junk: Mail will be deleted. Use with care! Do not submerge in water! + Example: + (setq nnmail-split-fancy + '(| (\"Subject\" \"MAKE MONEY FAST\" junk) + ...other.rules.omitted...)) + FIELD must match a complete field name. VALUE must match a complete word according to the `nnmail-split-fancy-syntax-table' syntax table. You can use \".*\" in the regexps to match partial field names or words. -FIELD and VALUE can also be lisp symbols, in that case they are expanded +FIELD and VALUE can also be Lisp symbols, in that case they are expanded as specified in `nnmail-split-abbrev-alist'. GROUP can contain \\& and \\N which will substitute from matching @@ -364,20 +494,19 @@ Example: ;; Other mailing lists... (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\") (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\") - ;; Both lists below have the same suffix, so prevent - ;; cross-posting to mkpkg.list of messages posted only to - ;; the bugs- list, but allow cross-posting when the - ;; message was really cross-posted. - (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\") - (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\") - ;; + ;; Both lists below have the same suffix, so prevent + ;; cross-posting to mkpkg.list of messages posted only to + ;; the bugs- list, but allow cross-posting when the + ;; message was really cross-posted. + (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\") + (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\") + ;; ;; People... (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\")) ;; Unmatched mail goes to the catch all group. \"misc.misc\"))" :group 'nnmail-split - ;; Sigh! - :type 'sexp) + :type 'nnmail-split-fancy) (defcustom nnmail-split-abbrev-alist '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc") @@ -419,18 +548,48 @@ parameter. It should return nil, `warn' or `delete'." (const warn) (const delete))) -(defcustom nnmail-extra-headers nil +(defcustom nnmail-extra-headers '(To Newsgroups) "*Extra headers to parse." :version "21.1" :group 'nnmail :type '(repeat symbol)) -(defcustom nnmail-split-header-length-limit 512 +(defcustom nnmail-split-header-length-limit 2048 "Header lines longer than this limit are excluded from the split function." :version "21.1" :group 'nnmail :type 'integer) +(defcustom nnmail-mail-splitting-charset nil + "Default charset to be used when splitting incoming mail." + :version "22.1" + :group 'nnmail + :type 'symbol) + +(defcustom nnmail-mail-splitting-decodes nil + "Whether the nnmail splitting functionality should MIME decode headers." + :version "22.1" + :group 'nnmail + :type 'boolean) + +(defcustom nnmail-split-fancy-match-partial-words nil + "Whether to match partial words when fancy splitting. +Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded +by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\ + surrounded +by anything." + :version "22.1" + :group 'nnmail + :type 'boolean) + +(defcustom nnmail-split-lowercase-expanded t + "Whether to lowercase expanded entries (i.e. \\N) when splitting mails. +This avoids the creation of multiple groups when users send to an address +using different case (i.e. mailing-list@domain vs Mailing-List@Domain)." + :version "22.1" + :group 'nnmail + :type 'boolean) + ;;; Internal variables. (defvar nnmail-article-buffer " *nnmail incoming*" @@ -439,13 +598,12 @@ parameter. It should return nil, `warn' or `delete'." (defvar nnmail-split-history nil "List of group/article elements that say where the previous split put messages.") -(defvar nnmail-split-fancy-syntax-table nil +(defvar nnmail-split-fancy-syntax-table + (let ((table (make-syntax-table))) + ;; support the %-hack + (modify-syntax-entry ?\% "." table) + table) "Syntax table used by `nnmail-split-fancy'.") -(unless (syntax-table-p nnmail-split-fancy-syntax-table) - (setq nnmail-split-fancy-syntax-table - (copy-syntax-table (standard-syntax-table))) - ;; support the %-hack - (modify-syntax-entry ?\% "." nnmail-split-fancy-syntax-table)) (defvar nnmail-prepare-save-mail-hook nil "Hook called before saving mail.") @@ -455,11 +613,6 @@ parameter. It should return nil, `warn' or `delete'." -(defconst nnmail-version "nnmail 1.0" - "nnmail version.") - - - (defun nnmail-request-post (&optional server) (mail-send-and-exit nil)) @@ -470,15 +623,15 @@ parameter. It should return nil, `warn' or `delete'." mm-text-coding-system "Coding system used in reading inbox") -(defvar nnmail-pathname-coding-system 'iso-8859-1 - "*Coding system for pathname.") +(defvar nnmail-pathname-coding-system nil + "*Coding system for file name.") (defun nnmail-find-file (file) "Insert FILE in server buffer safely." (set-buffer nntp-server-buffer) (delete-region (point-min) (point-max)) (let ((format-alist nil) - (after-insert-file-functions nil)) + (after-insert-file-functions nil)) (condition-case () (let ((coding-system-for-read nnmail-file-coding-system) (auto-mode-alist (mm-auto-mode-alist)) @@ -488,7 +641,7 @@ parameter. It should return nil, `warn' or `delete'." (file-error nil)))) (defun nnmail-group-pathname (group dir &optional file) - "Make pathname for GROUP." + "Make file name for GROUP." (concat (let ((dir (file-name-as-directory (expand-file-name dir)))) (setq group (nnheader-replace-duplicate-chars-in-string @@ -529,12 +682,12 @@ nn*-request-list should have been called before calling this function." (while (not (eobp)) (condition-case err (progn - (narrow-to-region (point) (gnus-point-at-eol)) + (narrow-to-region (point) (point-at-eol)) (setq group (read buffer)) (unless (stringp group) (setq group (symbol-name group))) - (if (and (numberp (setq max (read nntp-server-buffer))) - (numberp (setq min (read nntp-server-buffer)))) + (if (and (numberp (setq max (read buffer))) + (numberp (setq min (read buffer)))) (push (list group (cons min max)) group-assoc))) (error nil)) @@ -616,7 +769,7 @@ If SOURCE is a directory spec, try to return the group name component." (if (not (save-excursion (and (re-search-backward "^Content-Length:[ \t]*\\([0-9]+\\)" start t) - (setq content-length (string-to-int + (setq content-length (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))) @@ -655,7 +808,7 @@ If SOURCE is a directory spec, try to return the group name component." (defsubst nnmail-search-unix-mail-delim () "Put point at the beginning of the next Unix mbox message." - ;; Algorithm used to find the the next article in the + ;; Algorithm used to find the next article in the ;; brain-dead Unix mbox format: ;; ;; 1) Search for "^From ". @@ -684,7 +837,7 @@ If SOURCE is a directory spec, try to return the group name component." (defun nnmail-search-unix-mail-delim-backward () "Put point at the beginning of the current Unix mbox message." - ;; Algorithm used to find the the next article in the + ;; Algorithm used to find the next article in the ;; brain-dead Unix mbox format: ;; ;; 1) Search for "^From ". @@ -719,7 +872,9 @@ If SOURCE is a directory spec, try to return the group name component." (if (not (and (re-search-forward "^From " nil t) (goto-char (match-beginning 0)))) ;; Possibly wrong format? - (error "Error, unknown mail format! (Possibly corrupted.)") + (error "Error, unknown mail format! (Possibly corrupted %s `%s'.)" + (if (buffer-file-name) "file" "buffer") + (or (buffer-file-name) (buffer-name))) ;; Carry on until the bitter end. (while (not (eobp)) (setq start (point) @@ -751,7 +906,7 @@ If SOURCE is a directory spec, try to return the group name component." (if (not (re-search-forward "^Content-Length:[ \t]*\\([0-9]+\\)" nil t)) (setq content-length nil) - (setq content-length (string-to-int (match-string 1))) + (setq content-length (string-to-number (match-string 1))) ;; We destroy the header, since none of the backends ever ;; use it, and we do not want to confuse other mailers by ;; having a (possibly) faulty header. @@ -764,7 +919,7 @@ If SOURCE is a directory spec, try to return the group name component." (setq head-end (point)) ;; We try the Content-Length value. The idea: skip over the header ;; separator, then check what happens content-length bytes into the - ;; message body. This should be either the end ot the buffer, the + ;; message body. This should be either the end of the buffer, the ;; message separator or a blank line followed by the separator. ;; The blank line should probably be deleted. If neither of the ;; three is met, the content-length header is probably invalid. @@ -891,7 +1046,7 @@ If SOURCE is a directory spec, try to return the group name component." group artnum-func) "Go through the entire INCOMING file and pick out each individual mail. FUNC will be called with the buffer narrowed to each mail." - (let (;; If this is a group-specific split, we bind the split + (let ( ;; If this is a group-specific split, we bind the split ;; methods to just this group. (nnmail-split-methods (if (and group (not nnmail-resplit-incoming)) @@ -927,10 +1082,9 @@ FUNC will be called with the buffer narrowed to each mail." (defun nnmail-article-group (func &optional trace) "Look at the headers and return an alist of groups that match. FUNC will be called with the group name to determine the article number." - (let ((methods nnmail-split-methods) + (let ((methods (or nnmail-split-methods '(("bogus" "")))) (obuf (current-buffer)) - (beg (point-min)) - end group-art method grp) + group-art method grp) (if (and (sequencep methods) (= (length methods) 1)) ;; If there is only just one group to put everything in, we @@ -939,13 +1093,21 @@ FUNC will be called with the group name to determine the article number." (list (cons (caar methods) (funcall func (caar methods))))) ;; We do actual comparison. (save-excursion - ;; Find headers. - (goto-char beg) - (setq end (if (search-forward "\n\n" nil t) (point) (point-max))) + ;; Copy the article into the work buffer. (set-buffer nntp-server-buffer) (erase-buffer) - ;; Copy the headers into the work buffer. - (insert-buffer-substring obuf beg end) + (insert-buffer-substring obuf) + ;; Narrow to headers. + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (point) + (point-max))) + (goto-char (point-min)) + ;; Decode MIME headers and charsets. + (when nnmail-mail-splitting-decodes + (let ((mail-parse-charset nnmail-mail-splitting-charset)) + (mail-decode-encoded-word-region (point-min) (point-max)))) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) @@ -958,7 +1120,7 @@ FUNC will be called with the group name to determine the article number." (while (not (eobp)) (unless (< (move-to-column nnmail-split-header-length-limit) nnmail-split-header-length-limit) - (delete-region (point) (progn (end-of-line) (point)))) + (delete-region (point) (point-at-eol))) (forward-line 1)) ;; Allow washing. (goto-char (point-min)) @@ -975,8 +1137,8 @@ FUNC will be called with the group name to determine the article number." (or (funcall nnmail-split-methods) '("bogus")) (error - (nnheader-message 5 - "Error in `nnmail-split-methods'; using `bogus' mail group") + (nnheader-message + 5 "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) (setq split (gnus-remove-duplicates split)) @@ -1021,19 +1183,22 @@ FUNC will be called with the group name to determine the article number." (unless group-art (setq group-art (list (cons (car method) - (funcall func (car method))))))))) + (funcall func (car method)))))))) + ;; Fall back on "bogus" if all else fails. + (unless group-art + (setq group-art (list (cons "bogus" (funcall func "bogus")))))) ;; Produce a trace if non-empty. (when (and trace nnmail-split-trace) - (let ((trace (nreverse nnmail-split-trace)) - (restore (current-buffer))) + (let ((restore (current-buffer))) (nnheader-set-temp-buffer "*Split Trace*") (gnus-add-buffer) - (while trace - (insert (car trace) "\n") - (setq trace (cdr trace))) + (dolist (trace (nreverse nnmail-split-trace)) + (prin1 trace (current-buffer)) + (insert "\n")) (goto-char (point-min)) (gnus-configure-windows 'split-trace) (set-buffer restore))) + (widen) ;; See whether the split methods returned `junk'. (if (equal group-art '(junk)) nil @@ -1095,19 +1260,20 @@ Return the number of characters in the body." (defun nnmail-remove-list-identifiers () "Remove list identifiers from Subject headers." - (let ((regexp - (if (consp nnmail-list-identifiers) + (let ((regexp + (if (consp nnmail-list-identifiers) (mapconcat 'identity nnmail-list-identifiers " *\\|") nnmail-list-identifiers))) (when regexp (goto-char (point-min)) (while (re-search-forward - (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)") - nil t) - (delete-region (match-beginning 2) (match-end 0)) - (beginning-of-line)) - (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" nil t) - (delete-region (match-beginning 1) (match-end 1)) + (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)") + nil t) + (delete-region (match-beginning 2) (match-end 0)) + (beginning-of-line)) + (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" + nil t) + (delete-region (match-beginning 1) (match-end 1)) (beginning-of-line))))) (defun nnmail-remove-tabs () @@ -1131,15 +1297,33 @@ Return the number of characters in the body." ;;; Utility functions +(defun nnmail-do-request-post (accept-func &optional server) + "Utility function to directly post a message to an nnmail-derived group. +Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article') +to actually put the message in the right group." + (let ((success t)) + (dolist (mbx (message-unquote-tokens + (message-tokenize-header + (message-fetch-field "Newsgroups") ", ")) success) + (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method))) + (or (gnus-active to-newsgroup) + (gnus-activate-group to-newsgroup) + (if (gnus-y-or-n-p (format "No such group: %s. Create it? " + to-newsgroup)) + (or (and (gnus-request-create-group + to-newsgroup gnus-command-method) + (gnus-activate-group to-newsgroup nil nil + gnus-command-method)) + (error "Couldn't create group %s" to-newsgroup))) + (error "No such group: %s" to-newsgroup)) + (unless (funcall accept-func mbx (nth 1 gnus-command-method)) + (setq success nil)))))) + (defun nnmail-split-fancy () "Fancy splitting method. -See the documentation for the variable `nnmail-split-fancy' for documentation." - (let ((syntab (syntax-table))) - (unwind-protect - (progn - (set-syntax-table nnmail-split-fancy-syntax-table) - (nnmail-split-it nnmail-split-fancy)) - (set-syntax-table syntab)))) +See the documentation for the variable `nnmail-split-fancy' for details." + (with-syntax-table nnmail-split-fancy-syntax-table + (nnmail-split-it nnmail-split-fancy))) (defvar nnmail-split-cache nil) ;; Alist of split expressions their equivalent regexps. @@ -1155,7 +1339,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; A group name. Do the \& and \N subs into the string. ((stringp split) (when nnmail-split-tracing - (push (format "\"%s\"" split) nnmail-split-trace)) + (push split nnmail-split-trace)) (list (nnmail-expand-newtext split))) ;; Junk the message. @@ -1178,6 +1362,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; Builtin : operation. ((eq (car split) ':) + (when nnmail-split-tracing + (push split nnmail-split-trace)) (nnmail-split-it (save-excursion (eval (cdr split))))) ;; Builtin ! operation. @@ -1194,13 +1380,13 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (while (and (goto-char end-point) (re-search-backward (cdr cached-pair) nil t)) (when nnmail-split-tracing - (push (cdr cached-pair) nnmail-split-trace)) + (push split nnmail-split-trace)) (let ((split-rest (cddr split)) (end (match-end 0)) - ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). So, - ;; start-of-value is the the point just before the - ;; beginning of the value, whereas after-header-name is - ;; the point just after the field name. + ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). + ;; So, start-of-value is the point just before the + ;; beginning of the value, whereas after-header-name + ;; is the point just after the field name. (start-of-value (match-end 1)) (after-header-name (match-end 2))) ;; Start the next search just before the beginning of the @@ -1228,7 +1414,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; correct match positions. (re-search-backward value start-of-value)) (dolist (sp (nnmail-split-it (car split-rest))) - (unless (memq sp split-result) + (unless (member sp split-result) (push sp split-result)))))) split-result)) @@ -1236,8 +1422,9 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (t (let* ((field (nth 0 split)) (value (nth 1 split)) - partial-front regexp - partial-rear regexp) + partial-front + partial-rear + regexp) (if (symbolp value) (setq value (cdr (assq value nnmail-split-abbrev-alist)))) (if (and (>= (length value) 2) @@ -1249,6 +1436,9 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (string= ".*" (substring value -2))) (setq value (substring value 0 -2) partial-rear "")) + (when nnmail-split-fancy-match-partial-words + (setq partial-front "" + partial-rear "")) (setq regexp (concat "^\\(\\(" (if (symbolp field) (cdr (assq field nnmail-split-abbrev-alist)) @@ -1261,7 +1451,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (or partial-rear "\\>"))) (push (cons split regexp) nnmail-split-cache) ;; Now that it's in the cache, just call nnmail-split-it again - ;; on the same split, which will find it immediately in the cache. + ;; on the same split, which will find it immediately in the cache. (nnmail-split-it split)))))) (defun nnmail-expand-newtext (newtext) @@ -1290,7 +1480,10 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (setq N 0) (setq N (- c ?0))) (when (match-beginning N) - (push (buffer-substring (match-beginning N) (match-end N)) + (push (if nnmail-split-lowercase-expanded + (downcase (buffer-substring (match-beginning N) + (match-end N))) + (buffer-substring (match-beginning N) (match-end N))) expanded)))) (setq pos (1+ pos))) (if did-expand @@ -1346,6 +1539,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (set-buffer (setq nnmail-cache-buffer (get-buffer-create " *nnmail message-id cache*"))) + (gnus-add-buffer) (when (file-exists-p nnmail-message-id-cache-file) (nnheader-insert-file-contents nnmail-message-id-cache-file)) (set-buffer-modified-p nil) @@ -1372,52 +1566,54 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." nnmail-message-id-cache-file nil 'silent) (set-buffer-modified-p nil) (setq nnmail-cache-buffer nil) - (kill-buffer (current-buffer))))) + (gnus-kill-buffer (current-buffer))))) ;; Compiler directives. (defvar group) (defvar group-art-list) (defvar group-art) -(defun nnmail-cache-insert (id) - (when nnmail-treat-duplicates - ;; Store some information about the group this message is written - ;; to. This function might have been called from various places. - ;; Sometimes, a function up in the calling sequence has an - ;; argument GROUP which is bound to a string, the group name. At - ;; other times, there is a function up in the calling sequence - ;; which has an argument GROUP-ART which is a list of pairs, and - ;; the car of a pair is a group name. Should we check that the - ;; length of the list is equal to 1? -- kai - (let ((g nil)) - (cond ((and (boundp 'group) group) - (setq g group)) - ((and (boundp 'group-art-list) group-art-list - (listp group-art-list)) - (setq g (caar group-art-list))) - ((and (boundp 'group-art) group-art (listp group-art)) - (setq g (caar group-art))) - (t (setq g ""))) +(defun nnmail-cache-insert (id grp &optional subject sender) + (when (stringp id) + ;; this will handle cases like `B r' where the group is nil + (let ((grp (or grp gnus-newsgroup-name "UNKNOWN"))) + (run-hook-with-args 'nnmail-spool-hook + id grp subject sender)) + (when nnmail-treat-duplicates + ;; Store some information about the group this message is written + ;; to. This is passed in as the grp argument -- all locations this + ;; has been called from have been checked and the group is available. + ;; The only ambiguous case is nnmail-check-duplication which will only + ;; pass the first (of possibly >1) group which matches. -Josh (unless (gnus-buffer-live-p nnmail-cache-buffer) - (nnmail-cache-open)) + (nnmail-cache-open)) (save-excursion - (set-buffer nnmail-cache-buffer) - (goto-char (point-max)) - (if (and g (not (string= "" g)) - (gnus-methods-equal-p gnus-command-method - (nnmail-cache-primary-mail-backend))) - (insert id "\t" g "\n") - (insert id "\n")))))) + (set-buffer nnmail-cache-buffer) + (goto-char (point-max)) + (if (and grp (not (string= "" grp)) + (gnus-methods-equal-p gnus-command-method + (nnmail-cache-primary-mail-backend))) + (let ((regexp (if (consp nnmail-cache-ignore-groups) + (mapconcat 'identity nnmail-cache-ignore-groups + "\\|") + nnmail-cache-ignore-groups))) + (unless (and regexp (string-match regexp grp)) + (insert id "\t" grp "\n"))) + (insert id "\n")))))) (defun nnmail-cache-primary-mail-backend () (let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) - (be nil) - (res nil)) + (be nil) + (res nil) + (get-new-mail nil)) (while (and (null res) be-list) (setq be (car be-list)) (setq be-list (cdr be-list)) (when (and (gnus-method-option-p be 'respool) - (eval (intern (format "%s-get-new-mail" (car be))))) - (setq res be))) + (setq get-new-mail + (intern (format "%s-get-new-mail" (car be)))) + (boundp get-new-mail) + (symbol-value get-new-mail)) + (setq res be))) res)) ;; Fetch the group name corresponding to the message id stored in the @@ -1428,19 +1624,18 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (set-buffer nnmail-cache-buffer) (goto-char (point-max)) (when (search-backward id nil t) - (beginning-of-line) - (skip-chars-forward "^\n\r\t") - (unless (eolp) - (forward-char 1) - (buffer-substring (point) - (progn (end-of-line) (point)))))))) + (beginning-of-line) + (skip-chars-forward "^\n\r\t") + (unless (looking-at "[\r\n]") + (forward-char 1) + (buffer-substring (point) (point-at-eol))))))) ;; Function for nnmail-split-fancy: look up all references in the ;; cache and if a match is found, return that group. (defun nnmail-split-fancy-with-parent () "Split this message into the same group as its parent. This function can be used as an entry in `nnmail-split-fancy', for -example like this: (: nnmail-split-fancy) +example like this: (: nnmail-split-fancy-with-parent) For a message to be split, it looks for the parent message in the References or In-Reply-To header and then looks in the message id cache file (given by the variable `nnmail-message-id-cache-file') to @@ -1448,18 +1643,25 @@ see which group that message was put in. This group is returned. See the Info node `(gnus)Fancy Mail Splitting' for more details." (let* ((refstr (or (message-fetch-field "references") - (message-fetch-field "in-reply-to"))) - (references nil) - (res nil)) + (message-fetch-field "in-reply-to"))) + (references nil) + (res nil) + (regexp (if (consp nnmail-split-fancy-with-parent-ignore-groups) + (mapconcat + (lambda (x) (format "\\(%s\\)" x)) + nnmail-split-fancy-with-parent-ignore-groups + "\\|") + nnmail-split-fancy-with-parent-ignore-groups))) (when refstr (setq references (nreverse (gnus-split-references refstr))) (unless (gnus-buffer-live-p nnmail-cache-buffer) - (nnmail-cache-open)) + (nnmail-cache-open)) (mapcar (lambda (x) - (setq res (or (nnmail-cache-fetch-group x) res)) - (when (string= "drafts" res) - (setq res nil))) - references) + (setq res (or (nnmail-cache-fetch-group x) res)) + (when (or (member res '("delayed" "drafts" "queue")) + (and regexp res (string-match regexp res))) + (setq res nil))) + references) res))) (defun nnmail-cache-id-exists-p (id) @@ -1484,7 +1686,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (cond ((memq nnmail-treat-duplicates '(warn delete)) nnmail-treat-duplicates) - ((nnheader-functionp nnmail-treat-duplicates) + ((functionp nnmail-treat-duplicates) (funcall nnmail-treat-duplicates message-id)) (t nnmail-treat-duplicates)))) @@ -1501,7 +1703,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ((not duplication) (funcall func (setq group-art (nreverse (nnmail-article-group artnum-func)))) - (nnmail-cache-insert message-id)) + (nnmail-cache-insert message-id (caar group-art))) ((eq action 'delete) (setq group-art nil)) ((eq action 'warn) @@ -1568,10 +1770,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (setq source (append source (list :predicate - `(lambda (file) - (string-equal - ,(concat group suffix) - (file-name-nondirectory file)))))))) + (gnus-byte-compile + `(lambda (file) + (string-equal + ,(concat group suffix) + (file-name-nondirectory file))))))))) (when nnmail-fetched-sources (if (member source nnmail-fetched-sources) (setq source nil) @@ -1592,14 +1795,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (when (setq new (mail-source-fetch source - `(lambda (file orig-file) - (nnmail-split-incoming - file ',(intern (format "%s-save-mail" method)) - ',spool-func - (if (equal file orig-file) - nil - (nnmail-get-split-group orig-file ',source)) - ',(intern (format "%s-active-number" method)))))) + (gnus-byte-compile + `(lambda (file orig-file) + (nnmail-split-incoming + file ',(intern (format "%s-save-mail" method)) + ',spool-func + (if (equal file orig-file) + nil + (nnmail-get-split-group orig-file ',source)) + ',(intern (format "%s-active-number" method))))))) (incf total new) (incf i))) ;; If we did indeed read any incoming spools, we save all info. @@ -1635,7 +1839,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; We expire all articles on sight. t) ((equal time '(0 0)) - ;; This is an ange-ftp group, and we don't have any dates. + ;; This is an ange-ftp group, and we don't have any dates. nil) ((numberp days) (setq days (days-to-time days)) @@ -1643,13 +1847,46 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (ignore-errors (time-less-p days (time-since time)))))))) (defun nnmail-expiry-target-group (target group) + ;; Do not invoke this from nntp-server-buffer! At least nnfolder clears + ;; that buffer if the nnfolder group isn't selected. (let (nnmail-cache-accepted-message-ids) ;; Don't enter Message-IDs into cache. ;; Let users hack it in TARGET function. - (when (nnheader-functionp target) + (when (functionp target) (setq target (funcall target group))) (unless (eq target 'delete) - (gnus-request-accept-article target nil nil t)))) + (when (or (gnus-request-group target) + (gnus-request-create-group target)) + (let ((group-art (gnus-request-accept-article target nil nil t))) + (when (consp group-art) + (gnus-group-mark-article-read target (cdr group-art)))))))) + +(defun nnmail-fancy-expiry-target (group) + "Returns a target expiry group determined by `nnmail-fancy-expiry-targets'." + (let* (header + (case-fold-search nil) + (from (or (message-fetch-field "from") "")) + (to (or (message-fetch-field "to") "")) + (date (date-to-time + (or (message-fetch-field "date") (current-time-string)))) + (target 'delete)) + (dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target) + (setq header (car regexp-target-pair)) + (cond + ;; If the header is to-from then match against the + ;; To or From header + ((and (equal header 'to-from) + (or (string-match (cadr regexp-target-pair) from) + (and (string-match message-dont-reply-to-names from) + (string-match (cadr regexp-target-pair) to)))) + (setq target (format-time-string (caddr regexp-target-pair) date))) + ((and (not (equal header 'to-from)) + (string-match (cadr regexp-target-pair) + (or + (message-fetch-field header) + ""))) + (setq target + (format-time-string (caddr regexp-target-pair) date))))))) (defun nnmail-check-syntax () "Check (and modify) the syntax of the message in the current buffer." @@ -1733,20 +1970,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (with-output-to-temp-buffer "*nnmail split history*" (with-current-buffer standard-output (fundamental-mode)) ; for Emacs 20.4+ - (let ((history nnmail-split-history) - elem) - (while (setq elem (pop history)) + (dolist (elem nnmail-split-history) (princ (mapconcat (lambda (ga) (concat (car ga) ":" (int-to-string (cdr ga)))) elem ", ")) - (princ "\n"))))) + (princ "\n")))) (defun nnmail-purge-split-history (group) "Remove all instances of GROUP from `nnmail-split-history'." (let ((history nnmail-split-history)) (while history - (setcar history (gnus-delete-if (lambda (e) (string= (car e) group)) + (setcar history (gnus-remove-if (lambda (e) (string= (car e) group)) (car history))) (pop history)) (setq nnmail-split-history (delq nil nnmail-split-history)))) @@ -1773,4 +2008,5 @@ Doesn't change point." (provide 'nnmail) +;;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7 ;;; nnmail.el ends here