X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-filter.el;h=65aacfa57b7e58dead8747f2f08ba4b7465d09ca;hb=2706485848c7fabd109477e1d7fad89a6249f0b2;hp=10c469c72de22a0b3124e19401bb5e0bb24e898f;hpb=90e500e5eebbd0d010cb4f6f018de51541a4d9e1;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-filter.el b/elmo/elmo-filter.el index 10c469c..65aacfa 100644 --- a/elmo/elmo-filter.el +++ b/elmo/elmo-filter.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Yuuichi Teranishi +;; Hiroya Murata ;; Keywords: mail, net news ;; This file is part of ELMO (Elisp Library for Message Orchestration). @@ -29,59 +30,161 @@ ;;; Code: ;; (require 'elmo) +(require 'elmo-signal) +(require 'elmo-msgdb) + +(defvar elmo-filter-number-filename "number-list" + "File name for message number database.") ;;; ELMO filter folder (eval-and-compile (luna-define-class elmo-filter-folder (elmo-folder) - (condition target require-msgdb)) + (condition target require-msgdb number-list flag-count)) (luna-define-internal-accessors 'elmo-filter-folder)) (luna-define-method elmo-folder-initialize ((folder elmo-filter-folder) name) (let (pair) (setq pair (elmo-parse-search-condition name)) - (elmo-filter-folder-set-condition-internal folder - (car pair)) + (elmo-filter-folder-set-condition-internal folder (car pair)) (if (string-match "^ */\\(.*\\)$" (cdr pair)) (elmo-filter-folder-set-target-internal folder - (elmo-make-folder (elmo-match-string 1 (cdr pair)))) + (elmo-get-folder (elmo-match-string 1 (cdr pair)))) (error "Folder syntax error `%s'" (elmo-folder-name-internal folder))) (elmo-filter-folder-set-require-msgdb-internal folder (elmo-folder-search-requires-msgdb-p (elmo-filter-folder-target-internal folder) (elmo-filter-folder-condition-internal folder))) + (elmo-filter-folder-set-number-list-internal folder 'not-loaded) + (elmo-filter-connect-signals + folder + (elmo-filter-folder-target-internal folder)) folder)) +(defun elmo-filter-connect-signals (folder target) + (elmo-connect-signal + target 'flag-changing folder + (elmo-define-signal-handler (folder target number old-flags new-flags) + (elmo-filter-add-flag-count folder old-flags -1) + (elmo-filter-add-flag-count folder new-flags) + (elmo-emit-signal 'flag-changing folder number old-flags new-flags)) + (elmo-define-signal-filter (folder target number) + (memq number (elmo-folder-list-messages folder nil t)))) + (elmo-connect-signal + target 'flag-changed folder + (elmo-define-signal-handler (folder target numbers) + (let ((filterd (elmo-list-filter + (elmo-folder-list-messages folder nil t) + numbers))) + (when filterd + (elmo-emit-signal 'flag-changed folder filterd))))) + (elmo-connect-signal + target 'status-changed folder + (elmo-define-signal-handler (folder target numbers) + (let ((filterd (elmo-list-filter + (elmo-folder-list-messages folder nil t) + numbers))) + (when filterd + (elmo-emit-signal 'status-changed folder filterd))))) + (elmo-connect-signal + target 'update-overview folder + (elmo-define-signal-handler (folder target number) + (elmo-emit-signal 'update-overview folder number)) + (elmo-define-signal-filter (folder target number) + (memq number (elmo-folder-list-messages folder nil t))))) + +(defun elmo-filter-number-list-load (dir) + (elmo-object-load + (expand-file-name elmo-filter-number-filename dir))) + +(defun elmo-filter-number-list-save (dir number-list) + (elmo-object-save + (expand-file-name elmo-filter-number-filename dir) + number-list)) + +(defun elmo-filter-folder-number-list-loaded-p (folder) + (listp (elmo-filter-folder-number-list-internal folder))) + +(defun elmo-filter-folder-number-list (folder) + (let ((numbers (elmo-filter-folder-number-list-internal folder))) + (if (listp numbers) + numbers + (elmo-filter-folder-set-number-list-internal + folder + (elmo-filter-number-list-load (elmo-folder-msgdb-path folder)))))) + +(defsubst elmo-filter-folder-countup-message-flags (folder numbers + &optional delta) + (let ((flag-count (elmo-filter-folder-flag-count-internal folder)) + (delta (or delta 1)) + elem) + (dolist (number numbers) + (dolist (flag (elmo-message-flags folder number)) + (if (setq elem (assq flag flag-count)) + (setcdr elem (+ (cdr elem) delta)) + (setq flag-count (cons (cons flag delta) flag-count))))) + (elmo-filter-folder-set-flag-count-internal folder flag-count))) + +(defun elmo-filter-add-flag-count (folder flags &optional delta) + (let ((flag-count (elmo-filter-folder-flag-count-internal folder)) + (delta (or delta 1)) + elem) + (dolist (flag flags) + (if (setq elem (assq flag flag-count)) + (setcdr elem (+ (cdr elem) delta)) + (setq flag-count (cons (cons flag delta) flag-count)))) + (elmo-filter-folder-set-flag-count-internal folder flag-count))) + +(defun elmo-filter-folder-flag-count (folder) + (or (elmo-filter-folder-flag-count-internal folder) + (elmo-filter-folder-countup-message-flags + folder + (elmo-folder-list-messages folder t t)))) + +(defun elmo-filter-folder-copy-flag-count (flag-counts) + (mapcar (lambda (pair) (cons (car pair) (cdr pair))) flag-counts)) + +(luna-define-method elmo-folder-open :after ((folder elmo-filter-folder) + &optional load-msgdb) + (when load-msgdb + (elmo-filter-folder-number-list folder) + (elmo-filter-folder-flag-count folder) + (elmo-folder-msgdb (elmo-filter-folder-target-internal folder)))) + (luna-define-method elmo-folder-open-internal ((folder elmo-filter-folder)) (elmo-folder-open-internal (elmo-filter-folder-target-internal folder))) -(luna-define-method elmo-folder-msgdb :around ((folder elmo-filter-folder)) - ;; Load target's msgdb if required. - (if (elmo-filter-folder-require-msgdb-internal folder) - (elmo-folder-msgdb (elmo-filter-folder-target-internal folder))) - ;; Load msgdb of itself. - (luna-call-next-method)) +(luna-define-method elmo-folder-open-internal-p ((folder elmo-filter-folder)) + (elmo-folder-open-internal-p (elmo-filter-folder-target-internal folder))) (luna-define-method elmo-folder-check ((folder elmo-filter-folder)) - (if (elmo-filter-folder-require-msgdb-internal folder) - (elmo-folder-synchronize (elmo-filter-folder-target-internal folder)))) + (when (elmo-filter-folder-require-msgdb-internal folder) + (elmo-folder-synchronize (elmo-filter-folder-target-internal folder)))) (luna-define-method elmo-folder-close-internal ((folder elmo-filter-folder)) (elmo-folder-close-internal (elmo-filter-folder-target-internal folder))) -(luna-define-method elmo-folder-close :after ((folder elmo-filter-folder)) - ;; Clear target msgdb if it is used. - (if (elmo-filter-folder-require-msgdb-internal folder) - (elmo-folder-set-msgdb-internal (elmo-filter-folder-target-internal - folder) nil))) +(luna-define-method elmo-folder-close ((folder elmo-filter-folder)) + (elmo-generic-folder-close folder) + (elmo-filter-folder-set-number-list-internal folder 'not-loaded) + (elmo-filter-folder-set-flag-count-internal folder nil) + (elmo-folder-close (elmo-filter-folder-target-internal folder))) -(luna-define-method elmo-folder-commit :around ((folder elmo-filter-folder)) - ;; Save target msgdb if it is used. - (if (elmo-filter-folder-require-msgdb-internal folder) - (elmo-folder-commit (elmo-filter-folder-target-internal folder))) - (luna-call-next-method)) +(luna-define-method elmo-folder-commit ((folder elmo-filter-folder)) + (elmo-folder-commit (elmo-filter-folder-target-internal folder)) + (when (elmo-folder-persistent-p folder) + (elmo-folder-set-info-max-by-numdb + folder + (elmo-folder-list-messages folder nil 'in-msgdb)) + (elmo-msgdb-killed-list-save + (elmo-folder-msgdb-path folder) + (elmo-folder-killed-list-internal folder)) + (when (elmo-filter-folder-number-list-loaded-p folder) + (elmo-filter-number-list-save + (elmo-folder-msgdb-path folder) + (elmo-filter-folder-number-list folder))))) (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-filter-folder)) @@ -98,15 +201,18 @@ (luna-define-method elmo-folder-newsgroups ((folder elmo-filter-folder)) (elmo-folder-newsgroups (elmo-filter-folder-target-internal folder))) -(luna-define-method elmo-find-fetch-strategy - ((folder elmo-filter-folder) entity &optional ignore-cache) +(luna-define-method elmo-find-fetch-strategy ((folder elmo-filter-folder) + number + &optional + ignore-cache + require-entireness) (elmo-find-fetch-strategy (elmo-filter-folder-target-internal folder) - entity ignore-cache)) + number ignore-cache require-entireness)) (luna-define-method elmo-folder-get-primitive-list ((folder elmo-filter-folder)) - (list (elmo-filter-folder-target-internal folder))) + (elmo-folder-get-primitive-list (elmo-filter-folder-target-internal folder))) (luna-define-method elmo-folder-contains-type ((folder elmo-filter-folder) type) @@ -114,48 +220,74 @@ (elmo-filter-folder-target-internal folder) type)) -(luna-define-method elmo-folder-msgdb-create ((folder elmo-filter-folder) - numlist flag-table) - (if (elmo-filter-folder-require-msgdb-internal folder) - (let* ((target-folder (elmo-filter-folder-target-internal folder)) - (len (length numlist)) - (msgdb (elmo-folder-msgdb target-folder)) - (new-msgdb (elmo-make-msgdb)) - message-id entity) - (when (> len elmo-display-progress-threshold) - (elmo-progress-set 'elmo-folder-msgdb-create - len "Creating msgdb...")) - (unwind-protect - (dolist (number numlist) - (setq entity (elmo-msgdb-message-entity msgdb number)) - (when entity - (elmo-msgdb-append-entity new-msgdb entity - (elmo-msgdb-flags msgdb number))) - (elmo-progress-notify 'elmo-folder-msgdb-create)) - (elmo-progress-clear 'elmo-folder-msgdb-create)) - new-msgdb) - ;; Does not require msgdb. - (elmo-folder-msgdb-create - (elmo-filter-folder-target-internal folder) - numlist flag-table))) - (luna-define-method elmo-folder-append-buffer ((folder elmo-filter-folder) &optional flag number) (elmo-folder-append-buffer (elmo-filter-folder-target-internal folder) flag number)) +(defun elmo-folder-append-messages-filter-* (dst-folder + src-folder + numbers + same-number) + (elmo-folder-append-messages dst-folder + (elmo-filter-folder-target-internal src-folder) + numbers + same-number)) + +(defun elmo-folder-append-messages-*-filter (dst-folder + src-folder + numbers + same-number) + (elmo-folder-append-messages (elmo-filter-folder-target-internal dst-folder) + src-folder + numbers + same-number)) + +(luna-define-method elmo-message-fetch-bodystructure ((folder + elmo-filter-folder) + number strategy) + (elmo-message-fetch-bodystructure + (elmo-filter-folder-target-internal folder) + number strategy)) + (luna-define-method elmo-message-fetch ((folder elmo-filter-folder) number strategy - &optional section outbuf unseen) - (elmo-message-fetch - (elmo-filter-folder-target-internal folder) - number strategy section outbuf unseen)) + &optional unseen section) + (elmo-message-fetch (elmo-filter-folder-target-internal folder) + number strategy unseen section)) (luna-define-method elmo-folder-delete-messages ((folder elmo-filter-folder) numbers) - (elmo-folder-delete-messages - (elmo-filter-folder-target-internal folder) numbers)) + (let ((flag-count (elmo-filter-folder-copy-flag-count + (elmo-filter-folder-flag-count-internal folder))) + (messages (copy-sequence + (elmo-filter-folder-number-list folder))) + success) + (elmo-folder-detach-messages folder numbers) + (unless (setq success + (elmo-folder-delete-messages + (elmo-filter-folder-target-internal folder) numbers)) + (elmo-filter-folder-set-flag-count-internal folder flag-count) + (elmo-filter-folder-set-number-list-internal folder messages)) + success)) + +(luna-define-method elmo-folder-list-messages ((folder elmo-filter-folder) + &optional visible-only in-msgdb) + (let ((list (if in-msgdb + t + (elmo-folder-list-messages-internal folder visible-only))) + (killed-list (elmo-folder-killed-list-internal folder))) + (unless (listp list) + ;; Use current list. + (setq list (elmo-filter-folder-number-list folder))) + (if visible-only + (elmo-living-messages list killed-list) + (if (and in-msgdb killed-list list) + (elmo-uniq-sorted-list + (sort (nconc (elmo-number-set-to-number-list killed-list) list) #'<) + #'eq) + list)))) (luna-define-method elmo-folder-list-messages-internal ((folder elmo-filter-folder) &optional nohide) @@ -169,29 +301,13 @@ ;; not available t))) -(defsubst elmo-filter-folder-list-unreads (folder) - (elmo-list-filter - (elmo-folder-list-messages folder nil 'in-msgdb) - (elmo-folder-list-unreads - (elmo-filter-folder-target-internal folder)))) - -(luna-define-method elmo-folder-list-unreads :around ((folder - elmo-filter-folder)) - (if (elmo-filter-folder-require-msgdb-internal folder) - (elmo-filter-folder-list-unreads folder) - (luna-call-next-method))) - -(defsubst elmo-filter-folder-list-importants (folder) +(luna-define-method elmo-folder-list-flagged ((folder elmo-filter-folder) + flag + &optional in-msgdb) (elmo-list-filter - (elmo-folder-list-messages folder nil 'in-msgdb) - (elmo-folder-list-importants - (elmo-filter-folder-target-internal folder)))) - -(luna-define-method elmo-folder-list-importants :around ((folder - elmo-filter-folder)) - (if (elmo-filter-folder-require-msgdb-internal folder) - (elmo-filter-folder-list-importants folder) - (luna-call-next-method))) + (elmo-folder-list-messages folder nil t) + (elmo-folder-list-flagged + (elmo-filter-folder-target-internal folder) flag in-msgdb))) (luna-define-method elmo-folder-list-subfolders ((folder elmo-filter-folder) &optional one-level) @@ -220,9 +336,10 @@ (string= (elmo-filter-value condition) "unread"))) (setq diff (elmo-folder-diff (elmo-filter-folder-target-internal folder))) - (if (consp diff) - (cons (car diff) (car diff)) - (cons (car diff) (nth 1 diff)))) + (if (consp (cdr diff)) + ;; new unread unread + (list (car diff) (nth 1 diff) (nth 1 diff)) + (cons (car diff) (car diff)))) ((string= "last" (elmo-filter-key condition)) (luna-call-next-method)) (t @@ -265,6 +382,9 @@ (luna-define-method elmo-folder-message-file-p ((folder elmo-filter-folder)) (elmo-folder-message-file-p (elmo-filter-folder-target-internal folder))) +(luna-define-method elmo-folder-local-p ((folder elmo-filter-folder)) + (elmo-folder-local-p (elmo-filter-folder-target-internal folder))) + (luna-define-method elmo-folder-plugged-p ((folder elmo-filter-folder)) (elmo-folder-plugged-p (elmo-filter-folder-target-internal folder))) @@ -278,58 +398,127 @@ (elmo-message-file-name (elmo-filter-folder-target-internal folder) number)) -(luna-define-method elmo-folder-flag-as-read :around ((folder - elmo-filter-folder) - numbers - &optional is-local) - (elmo-folder-flag-as-read (elmo-filter-folder-target-internal folder) - numbers is-local) - (luna-call-next-method)) - -(luna-define-method elmo-folder-unflag-read :around ((folder - elmo-filter-folder) - numbers - &optional is-local) - (elmo-folder-unflag-read (elmo-filter-folder-target-internal folder) - numbers is-local) - (luna-call-next-method)) - -(luna-define-method elmo-folder-flag-as-important :around ((folder - elmo-filter-folder) - numbers - &optional - is-local) - (elmo-folder-flag-as-important (elmo-filter-folder-target-internal folder) - numbers is-local) - (luna-call-next-method)) - -(luna-define-method elmo-folder-unflag-important :around ((folder - elmo-filter-folder) - numbers - &optional - is-local) - (elmo-folder-unflag-important (elmo-filter-folder-target-internal folder) - numbers is-local) - (luna-call-next-method)) - -(luna-define-method elmo-folder-flag-as-answered :around ((folder - elmo-filter-folder) - numbers - &optional - is-local) - (elmo-folder-flag-as-answered (elmo-filter-folder-target-internal folder) - numbers is-local) - (luna-call-next-method)) - - -(luna-define-method elmo-folder-unflag-answered :around ((folder - elmo-filter-folder) - numbers - &optional - is-local) - (elmo-folder-unflag-answered (elmo-filter-folder-target-internal folder) - numbers is-local) - (luna-call-next-method)) +(luna-define-method elmo-message-flag-available-p ((folder + elmo-filter-folder) number + flag) + (elmo-message-flag-available-p + (elmo-filter-folder-target-internal folder) + number flag)) + +(luna-define-method elmo-message-flags ((folder elmo-filter-folder) number) + (elmo-message-flags (elmo-filter-folder-target-internal folder) + number)) + +(luna-define-method elmo-message-set-cached ((folder elmo-filter-folder) + number cached) + (elmo-message-set-cached + (elmo-filter-folder-target-internal folder) number cached)) + +(luna-define-method elmo-message-number ((folder elmo-filter-folder) + message-id) + (elmo-message-number (elmo-filter-folder-target-internal folder) + message-id)) + +(luna-define-method elmo-message-entity ((folder elmo-filter-folder) key) + (elmo-message-entity (elmo-filter-folder-target-internal folder) key)) + +(luna-define-method elmo-message-entity-parent ((folder elmo-filter-folder) + entity) + (let ((parent (elmo-message-entity-parent + (elmo-filter-folder-target-internal folder) + entity))) + (when (memq (elmo-message-entity-number parent) + (elmo-filter-folder-number-list folder)) + parent))) + +(luna-define-method elmo-folder-flag-table ((folder elmo-filter-folder) + &optional if-exists) + (elmo-folder-flag-table (elmo-filter-folder-target-internal folder) + if-exists)) + +(luna-define-method elmo-folder-close-flag-table ((folder elmo-filter-folder)) + (elmo-folder-close-flag-table (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-count-flags ((folder elmo-filter-folder)) + (elmo-filter-folder-flag-count folder)) + +(luna-define-method elmo-folder-set-flag ((folder elmo-filter-folder) + numbers + flag + &optional is-local) + (elmo-folder-set-flag (elmo-filter-folder-target-internal folder) + numbers flag is-local)) + +(luna-define-method elmo-folder-unset-flag ((folder elmo-filter-folder) + numbers + flag + &optional is-local) + (elmo-folder-unset-flag (elmo-filter-folder-target-internal folder) + numbers flag is-local)) + +(luna-define-method elmo-message-folder ((folder elmo-filter-folder) + number) + (elmo-message-folder (elmo-filter-folder-target-internal folder) number)) + +(luna-define-method elmo-message-field ((folder elmo-filter-folder) + number field &optional type) + (elmo-message-field + (elmo-filter-folder-target-internal folder) number field type)) + +(luna-define-method elmo-message-set-field ((folder elmo-filter-folder) + number field value) + (elmo-message-set-field + (elmo-filter-folder-target-internal folder) number field value)) + +(luna-define-method elmo-folder-clear ((folder elmo-filter-folder) + &optional keep-killed) + (unless keep-killed + (elmo-folder-set-killed-list-internal folder nil)) + (elmo-filter-folder-set-number-list-internal folder nil) + (elmo-filter-folder-set-flag-count-internal folder nil)) + +(luna-define-method elmo-folder-synchronize ((folder elmo-filter-folder) + &optional + disable-killed + ignore-msgdb + no-check + mask) + (let ((killed-list (elmo-folder-killed-list-internal folder)) + numbers) + (unless no-check + (when (elmo-filter-folder-require-msgdb-internal folder) + (elmo-folder-synchronize (elmo-filter-folder-target-internal folder) + disable-killed + ignore-msgdb + no-check + mask))) + (setq numbers (elmo-folder-list-messages folder (not disable-killed))) + (when (and numbers + (not (elmo-filter-folder-require-msgdb-internal folder))) + (elmo-folder-synchronize (elmo-filter-folder-target-internal folder) + 'disable-killed + ignore-msgdb + no-check + (if mask + (elmo-list-filter mask numbers) + numbers))) + (when (and disable-killed ignore-msgdb) + (elmo-folder-set-killed-list-internal folder nil)) + (elmo-filter-folder-set-number-list-internal folder numbers) + (elmo-filter-folder-set-flag-count-internal folder nil) + 0)) + +(luna-define-method elmo-folder-detach-messages ((folder elmo-filter-folder) + numbers) + (elmo-filter-folder-countup-message-flags folder numbers -1) + (elmo-filter-folder-set-number-list-internal + folder + (elmo-list-delete numbers (elmo-filter-folder-number-list folder) #'delq)) + t) + +(luna-define-method elmo-folder-length ((folder elmo-filter-folder)) + (and (elmo-filter-folder-number-list-loaded-p folder) + (length (elmo-filter-folder-number-list-internal folder)))) (require 'product) (product-provide (provide 'elmo-filter) (require 'elmo-version))