X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=c3b53048a6bd7507850112278175e51dc4f6e6d3;hb=8047583c8c86a5c6a61bddc27b391042e39e1ce5;hp=06ee77646cd83cdcd5ea4b9e8c8fe8b7aacad3da;hpb=49d38b41c190eaab2cb34294fac7302a9c9ea353;p=elisp%2Fgnus.git- diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 06ee776..c3b5304 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,5 +1,5 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -31,7 +31,6 @@ (require 'gnus) ; for macro gnus-kill-buffer, at least (require 'nnheader) (require 'message) -(require 'custom) (require 'gnus-util) (require 'mail-source) @@ -223,6 +222,7 @@ 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 "21.4" :group 'nnmail-expire :type '(repeat (list (choice :tag "Match against" (string :tag "Header") @@ -355,13 +355,77 @@ discarded after running the split process." :type 'hook) (defcustom nnmail-large-newsgroup 50 - "*The number of the articles which indicates a large newsgroup or nil. -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 '(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 21.4 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. To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'. @@ -402,7 +466,7 @@ 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 @@ -437,8 +501,7 @@ Example: ;; 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") @@ -494,11 +557,29 @@ parameter. It should return nil, `warn' or `delete'." (defcustom nnmail-mail-splitting-charset nil "Default charset to be used when splitting incoming mail." + :version "21.4" :group 'nnmail :type 'symbol) (defcustom nnmail-mail-splitting-decodes t "Whether the nnmail splitting functionality should MIME decode headers." + :version "21.4" + :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." + :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)." :group 'nnmail :type 'boolean) @@ -510,13 +591,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.") @@ -526,11 +606,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)) @@ -552,8 +627,7 @@ parameter. It should return nil, `warn' or `delete'." (after-insert-file-functions nil)) (condition-case () (let ((auto-mode-alist (nnheader-auto-mode-alist)) - (file-name-coding-system nnmail-pathname-coding-system) - (pathname-coding-system nnmail-pathname-coding-system)) + (file-name-coding-system nnmail-pathname-coding-system)) (insert-file-contents-as-coding-system nnmail-file-coding-system file) t) @@ -601,7 +675,7 @@ 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))) @@ -619,8 +693,7 @@ nn*-request-list should have been called before calling this function." (defun nnmail-save-active (group-assoc file-name) "Save GROUP-ASSOC in ACTIVE-FILE." - (let ((coding-system-for-write nnmail-active-file-coding-system) - (output-coding-system nnmail-active-file-coding-system)) + (let ((coding-system-for-write nnmail-active-file-coding-system)) (when file-name (with-temp-file file-name (nnmail-generate-active group-assoc))))) @@ -1040,7 +1113,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) (gnus-point-at-eol))) + (delete-region (point) (point-at-eol))) (forward-line 1)) ;; Allow washing. (goto-char (point-min)) @@ -1103,7 +1176,10 @@ 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 ((restore (current-buffer))) @@ -1239,12 +1315,8 @@ to actually put the message in the right group." (defun nnmail-split-fancy () "Fancy splitting method. See the documentation for the variable `nnmail-split-fancy' for details." - (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)))) + (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. @@ -1343,8 +1415,9 @@ See the documentation for the variable `nnmail-split-fancy' for details." (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) @@ -1356,6 +1429,9 @@ See the documentation for the variable `nnmail-split-fancy' for details." (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)) @@ -1397,7 +1473,10 @@ See the documentation for the variable `nnmail-split-fancy' for details." (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 @@ -1486,31 +1565,34 @@ See the documentation for the variable `nnmail-split-fancy' for details." (defvar group) (defvar group-art-list) (defvar group-art) -(defun nnmail-cache-insert (id grp) - (run-hook-with-args 'nnmail-spool-hook - id grp) - (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)) - (save-excursion - (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-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)) + (save-excursion + (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) @@ -1539,7 +1621,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." (skip-chars-forward "^\n\r\t") (unless (looking-at "[\r\n]") (forward-char 1) - (buffer-substring (point) (gnus-point-at-eol))))))) + (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. @@ -1597,7 +1679,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)))) @@ -1763,7 +1845,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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) (when (or (gnus-request-group target) @@ -1809,8 +1891,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defun nnmail-write-region (start end filename &optional append visit lockname) "Do a `write-region', and then set the file modes." - (let ((file-name-coding-system nnmail-pathname-coding-system) - (pathname-coding-system nnmail-pathname-coding-system)) + (let ((file-name-coding-system nnmail-pathname-coding-system)) (write-region-as-coding-system nnmail-file-coding-system start end filename append visit lockname) (set-file-modes filename nnmail-default-file-modes)))