From: hmurata Date: Sat, 10 Dec 2005 12:03:01 +0000 (+0000) Subject: * wl-util.el (wl-filter-associations): New function. X-Git-Tag: wl-2_15_3~32 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=52f343327474a14d313e1399cb2ef055a879df12;p=elisp%2Fwanderlust.git * wl-util.el (wl-filter-associations): New function. * wl-spam.el (wl-spam-undecided-folder-list): New user option. (wl-spam-ignored-folder-list): Ditto. (wl-spam-ignored-folder-regexp-list): Set default value as nil. (wl-spam-string-member-p): New function. (wl-spam-domain): Use it. (wl-spam-split-numbers): New function. (wl-spam-apply-partitions): Ditto. (wl-spam-register-spam-messages): Use `folder' instead of `wl-summary-buffer-elmo-folder'. (wl-spam-register-good-messages): Ditto. (wl-summary-exec-action-spam): Decide a domain by real folder of message. (wl-summary-exec-action-refile-with-register): Likewise. * elmo-util.el (elmo-string-member): Allow symbol element in list. --- diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 46560b4..fa03d9f 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,7 @@ +2005-12-10 Hiroya Murata + + * elmo-util.el (elmo-string-member): Allow symbol element in list. + 2005-11-26 Hiroya Murata * elmo-search.el (elmo-make-search-engine): Use prefix diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index ff7ba62..be16dc3 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -1319,11 +1319,14 @@ But if optional argument AUTO is non-nil, DEFAULT is returned." (defun elmo-string-member (string slist) (catch 'found - (while slist - (if (and (stringp (car slist)) - (string= string (car slist))) - (throw 'found t)) - (setq slist (cdr slist))))) + (dolist (element slist) + (cond ((null element)) + ((stringp element) + (when (string= string element) + (throw 'found t))) + ((symbolp element) + (when (string= string (symbol-value element)) + (throw 'found t))))))) (static-cond ((fboundp 'member-ignore-case) (defalias 'elmo-string-member-ignore-case 'member-ignore-case)) diff --git a/wl/ChangeLog b/wl/ChangeLog index 37003d5..d11d07c 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,21 @@ +2005-12-10 Hiroya Murata + + * wl-util.el (wl-filter-associations): New function. + + * wl-spam.el (wl-spam-undecided-folder-list): New user option. + (wl-spam-ignored-folder-list): Ditto. + (wl-spam-ignored-folder-regexp-list): Set default value as nil. + (wl-spam-string-member-p): New function. + (wl-spam-domain): Use it. + (wl-spam-split-numbers): New function. + (wl-spam-apply-partitions): Ditto. + (wl-spam-register-spam-messages): Use `folder' instead of + `wl-summary-buffer-elmo-folder'. + (wl-spam-register-good-messages): Ditto. + (wl-summary-exec-action-spam): Decide a domain by real folder of + message. + (wl-summary-exec-action-refile-with-register): Likewise. + 2005-11-12 Hiroya Murata * wl-e21.el (wl-e21-find-image): New function. diff --git a/wl/wl-spam.el b/wl/wl-spam.el index 8bb5494..dbff5e8 100644 --- a/wl/wl-spam.el +++ b/wl/wl-spam.el @@ -46,15 +46,28 @@ :type 'string :group 'wl-spam) +(defcustom wl-spam-undecided-folder-list nil + "*List of folder name which is contained undecided domain. +If an element is symbol, use symbol-value instead." + :type '(repeat (choice (string :tag "Folder name") + (variable :tag "Variable"))) + :group 'wl-spam) + (defcustom wl-spam-undecided-folder-regexp-list '("inbox") "*List of folder regexp which is contained undecided domain." :type '(repeat (regexp :tag "Folder Regexp")) :group 'wl-spam) -(defcustom wl-spam-ignored-folder-regexp-list - (list (regexp-opt (list wl-draft-folder - wl-trash-folder - wl-queue-folder))) +(defcustom wl-spam-ignored-folder-list '(wl-draft-folder + wl-trash-folder + wl-queue-folder) + "*List of folder name which is contained ignored domain. +If an element is symbol, use symbol-value instead." + :type '(repeat (choice (string :tag "Folder name") + (variable :tag "Variable"))) + :group 'wl-spam) + +(defcustom wl-spam-ignored-folder-regexp-list nil "*List of folder regexp which is contained ignored domain." :type '(repeat (regexp :tag "Folder Regexp")) :group 'wl-spam) @@ -104,18 +117,36 @@ See `wl-summary-mark-action-list' for the detail of element." (string :tag "Document string"))) :group 'wl-spam) +(defsubst wl-spam-string-member-p (string list regexp-list) + (or (wl-string-member string list) + (wl-string-match-member string regexp-list))) + (defun wl-spam-domain (folder-name) (cond ((string= folder-name wl-spam-folder) 'spam) - ((wl-string-match-member folder-name - wl-spam-undecided-folder-regexp-list) + ((wl-spam-string-member-p folder-name + wl-spam-undecided-folder-list + wl-spam-undecided-folder-regexp-list) 'undecided) - ((wl-string-match-member folder-name - wl-spam-ignored-folder-regexp-list) + ((wl-spam-string-member-p folder-name + wl-spam-ignored-folder-list + wl-spam-ignored-folder-regexp-list) 'ignore) (t 'good))) +(defun wl-spam-split-numbers (folder numbers) + (let (alist) + (dolist (number numbers) + (let* ((domain (wl-spam-domain + (elmo-folder-name-internal + (elmo-message-folder folder number)))) + (cell (assq domain alist))) + (if cell + (setcdr cell (cons number (cdr cell))) + (setq alist (cons (list domain number) alist))))) + alist)) + (defsubst wl-spam-auto-check-message-p (folder number) (or (eq wl-spam-auto-check-marks 'all) (member (wl-summary-message-mark folder number) @@ -132,13 +163,25 @@ See `wl-summary-mark-action-list' for the detail of element." (apply function number args))) (message "Checking spam...done"))) +(defun wl-spam-apply-partitions (folder partitions function msg) + (when partitions + (let ((total 0)) + (dolist (partition partitions) + (setq total (+ total (length (cdr partition))))) + (message msg) + (elmo-with-progress-display (> total elmo-display-progress-threshold) + (elmo-spam-register total msg) + (dolist (partition partitions) + (funcall function folder (cdr partition) (car partition)))) + (message (concat msg "done"))))) + (defun wl-spam-register-spam-messages (folder numbers) (let ((total (length numbers))) (message "Registering spam...") (elmo-with-progress-display (> total elmo-display-progress-threshold) (elmo-spam-register total "Registering spam...") (elmo-spam-register-spam-messages (elmo-spam-processor) - wl-summary-buffer-elmo-folder + folder numbers)) (message "Registering spam...done"))) @@ -148,7 +191,7 @@ See `wl-summary-mark-action-list' for the detail of element." (elmo-with-progress-display (> total elmo-display-progress-threshold) (elmo-spam-register total "Registering good...") (elmo-spam-register-good-messages (elmo-spam-processor) - wl-summary-buffer-elmo-folder + folder numbers)) (message "Registering good...done"))) @@ -272,55 +315,49 @@ See `wl-summary-mark-action-list' for the detail of element." (wl-summary-mark-spam))) (defun wl-summary-exec-action-spam (mark-list) - (let ((domain (wl-spam-domain (elmo-folder-name-internal - wl-summary-buffer-elmo-folder))) - (total (length mark-list))) + (let ((folder wl-summary-buffer-elmo-folder)) (wl-folder-confirm-existence (wl-folder-get-elmo-folder wl-spam-folder)) - (when (memq domain '(undecided good)) - (message "Registering spam...") - (elmo-with-progress-display (> total elmo-display-progress-threshold) - (elmo-spam-register total "Registering spam...") - (elmo-spam-register-spam-messages (elmo-spam-processor) - wl-summary-buffer-elmo-folder - (mapcar #'car mark-list) - (eq domain 'good))) - (message "Registering spam...done")) + (wl-spam-apply-partitions + folder + (wl-filter-associations + '(undecided good) + (wl-spam-split-numbers folder (mapcar #'car mark-list))) + (lambda (folder numbers domain) + (elmo-spam-register-spam-messages (elmo-spam-processor) + folder numbers + (eq domain 'good))) + "Registering spam...") (wl-summary-move-mark-list-messages mark-list wl-spam-folder "Refiling spam..."))) (defun wl-summary-exec-action-refile-with-register (mark-list) - (let* ((processor (elmo-spam-processor)) - (folder wl-summary-buffer-elmo-folder) - (domain (wl-spam-domain (elmo-folder-name-internal folder))) - spam-list good-list total) - (unless (eq domain 'ignore) - (dolist (info mark-list) - (case (wl-spam-domain (nth 2 info)) - (spam - (setq spam-list (cons (car info) spam-list))) - (good - (setq good-list (cons (car info) good-list))))) - (case domain - (spam (setq spam-list nil)) - (good (setq good-list nil))) - (when (or spam-list good-list) - (when spam-list - (setq total (length spam-list)) - (message "Registering spam...") - (elmo-with-progress-display (> total elmo-display-progress-threshold) - (elmo-spam-register total "Registering spam...") - (elmo-spam-register-spam-messages processor folder spam-list - (eq domain 'good))) - (message "Registering spam...done")) - (when good-list - (setq total (length good-list)) - (message "Registering good...") - (elmo-with-progress-display (> total elmo-display-progress-threshold) - (elmo-spam-register total "Registering good...") - (elmo-spam-register-good-messages processor folder good-list - (eq domain 'spam))) - (message "Registering good...done")))) + (let ((folder wl-summary-buffer-elmo-folder) + spam-list good-list) + (dolist (info mark-list) + (case (wl-spam-domain (nth 2 info)) + (spam + (setq spam-list (cons (car info) spam-list))) + (good + (setq good-list (cons (car info) good-list))))) + (wl-spam-apply-partitions + folder + (wl-filter-associations '(undecided good) + (wl-spam-split-numbers folder spam-list)) + (lambda (folder numbers domain) + (elmo-spam-register-spam-messages (elmo-spam-processor) + folder numbers + (eq domain 'good))) + "Registering spam...") + (wl-spam-apply-partitions + folder + (wl-filter-associations '(undecided spam) + (wl-spam-split-numbers folder good-list)) + (lambda (folder numbers domain) + (elmo-spam-register-good-messages (elmo-spam-processor) + folder numbers + (eq domain 'spam))) + "Registering good...") ;; execute refile messages (wl-summary-exec-action-refile mark-list))) diff --git a/wl/wl-util.el b/wl/wl-util.el index 0156bee..f3eb0af 100644 --- a/wl/wl-util.el +++ b/wl/wl-util.el @@ -336,6 +336,14 @@ changing the value of `foo'." (setq keys (cdr keys))) alist) +(defun wl-filter-associations (keys alist) + (let (entry result) + (while keys + (when (setq entry (assq (car keys) alist)) + (setq result (cons entry result))) + (setq keys (cdr keys))) + result)) + (defun wl-inverse-alist (keys alist) "Inverse ALIST, copying. Return an association list represents the inverse mapping of ALIST,