X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-filter.el;h=822e13a1efa08558d2fbb352d0511a7d957906ec;hb=107c307c8be7235fd1d35a22107c4df7acd736fe;hp=cd17d38be78c213e048e0bcc6b20b382c23ab649;hpb=be8d7b821412989340e00791d88ba789fa044e7e;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-filter.el b/elmo/elmo-filter.el index cd17d38..822e13a 100644 --- a/elmo/elmo-filter.el +++ b/elmo/elmo-filter.el @@ -1,6 +1,6 @@ -;;; elmo-filter.el -- Filtered Folder Interface for ELMO. +;;; elmo-filter.el --- Filtered Folder Interface for ELMO. -;; Copyright 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: mail, net news @@ -24,173 +24,306 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; -(require 'elmo-msgdb) - -(defun elmo-filter-msgdb-create (spec numlist new-mark already-mark - seen-mark important-mark seen-list) - (if (eq (nth 2 spec) 'partial) - (elmo-msgdb-create (nth 2 spec) - numlist - new-mark - already-mark - seen-mark important-mark seen-list) - (elmo-msgdb-create-as-numlist (nth 2 spec) - numlist - new-mark - already-mark - seen-mark important-mark seen-list))) - -(defun elmo-filter-msgdb-create-as-numlist (spec numlist new-mark already-mark - seen-mark important-mark - seen-list) - (elmo-msgdb-create-as-numlist (nth 2 spec) - numlist - new-mark - already-mark - seen-mark important-mark seen-list)) - -(defun elmo-filter-list-folders (spec &optional hierarchy) - nil) - -(defun elmo-filter-append-msg (spec string &optional msg no-see) - (elmo-call-func (nth 2 spec) "append" string)) - -(defun elmo-filter-read-msg (spec number outbuf) - (elmo-call-func (nth 2 spec) "read-msg" number outbuf)) - -(defun elmo-filter-delete-msgs (spec msgs) - (elmo-call-func (nth 2 spec) "delete-msgs" msgs)) - -(defun elmo-filter-list-folder (spec) - (let ((filter (nth 1 spec)) - (folder (nth 2 spec)) - msgs) - (cond - ((vectorp filter) - (cond ((string= (elmo-filter-key filter) - "last") - (setq msgs (elmo-list-folder folder)) - (nthcdr (max (- (length msgs) - (string-to-int (elmo-filter-value filter))) - 0) - msgs)) - ((string= (elmo-filter-key filter) - "first") - (setq msgs (elmo-list-folder folder)) - (let ((rest (nthcdr (string-to-int (elmo-filter-value filter) ) - msgs))) - (mapcar '(lambda (x) - (delete x msgs)) rest)) - msgs))) - ((listp filter) - (elmo-search folder filter))))) - -(defun elmo-filter-list-folder-unread (spec mark-alist unread-marks) - (let ((filter (nth 1 spec)) - (folder (nth 2 spec)) - msgs pair) - (cond - ((vectorp filter) - (cond ((string= (elmo-filter-key filter) - "last") - (setq msgs (elmo-list-folder-unread folder mark-alist - unread-marks)) - (nthcdr (max (- (length msgs) - (string-to-int (elmo-filter-value filter))) - 0) - msgs)) - ((string= (elmo-filter-key filter) - "first") - (setq msgs (elmo-list-folder-unread folder - mark-alist - unread-marks)) - (let ((rest (nthcdr (string-to-int (elmo-filter-value filter) ) - msgs))) - (mapcar '(lambda (x) - (delete x msgs)) rest)) - msgs))) - ((listp filter) - (elmo-list-filter - (elmo-search folder filter) - (elmo-list-folder-unread folder mark-alist unread-marks)))))) - -(defun elmo-filter-list-folder-important (spec overview) - (let ((filter (nth 1 spec)) - (folder (nth 2 spec)) - msgs pair) - (cond - ((vectorp filter) - (cond ((string= (elmo-filter-key filter) - "last") - (setq msgs (elmo-list-folder-important folder overview)) - (nthcdr (max (- (length msgs) - (string-to-int (elmo-filter-value filter))) - 0) - msgs)) - ((string= (elmo-filter-key filter) - "first") - (setq msgs (elmo-list-folder-important folder overview)) - (let ((rest (nthcdr (string-to-int (elmo-filter-value filter) ) - msgs))) - (mapcar '(lambda (x) - (delete x msgs)) rest)) - msgs))) - ((listp filter) - (elmo-list-filter - (mapcar - '(lambda (x) (elmo-msgdb-overview-entity-get-number x)) - overview) - (elmo-list-folder-important folder overview)))))) - -(defun elmo-filter-max-of-folder (spec) - (elmo-max-of-folder (nth 2 spec))) - -(defun elmo-filter-folder-exists-p (spec) - (elmo-folder-exists-p (nth 2 spec))) - -(defun elmo-filter-folder-creatable-p (spec) - (elmo-call-func (nth 2 spec) "folder-creatable-p")) - -(defun elmo-filter-create-folder (spec) - (elmo-create-folder (nth 2 spec))) - -(defun elmo-filter-search (spec condition &optional numlist) +;; +(require 'elmo) + +;;; ELMO filter folder +(eval-and-compile + (luna-define-class elmo-filter-folder (elmo-folder) + (condition target require-msgdb)) + (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)) + (if (string-match "^ */\\(.*\\)$" (cdr pair)) + (elmo-filter-folder-set-target-internal + folder + (elmo-make-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))) + 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-check ((folder elmo-filter-folder)) + (if (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-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-expand-msgdb-path ((folder + elmo-filter-folder)) + (expand-file-name + (elmo-replace-string-as-filename (elmo-folder-name-internal folder)) + (expand-file-name "filter" elmo-msgdb-directory))) + +(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) + (elmo-find-fetch-strategy + (elmo-filter-folder-target-internal folder) + entity ignore-cache)) + +(luna-define-method elmo-folder-get-primitive-list ((folder + elmo-filter-folder)) + (list (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-contains-type ((folder elmo-filter-folder) + type) + (elmo-folder-contains-type + (elmo-filter-folder-target-internal folder) + type)) + +(luna-define-method elmo-folder-msgdb-create ((folder elmo-filter-folder) + numlist seen-list) + (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)) + overview number-alist mark-alist message-id entity mark) + (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-overview-get-entity number msgdb)) + (when entity + (setq overview (elmo-msgdb-append-element overview entity) + message-id (elmo-msgdb-overview-entity-get-id entity) + number-alist (elmo-msgdb-number-add number-alist + number + message-id)) + (when (setq mark (elmo-msgdb-get-mark msgdb number)) + (setq mark-alist (elmo-msgdb-mark-append + mark-alist + number + mark)))) + (elmo-progress-notify 'elmo-folder-msgdb-create)) + (elmo-progress-clear 'elmo-folder-msgdb-create)) + (list overview number-alist mark-alist)) + ;; Does not require msgdb. + (elmo-folder-msgdb-create + (elmo-filter-folder-target-internal folder) + numlist seen-list))) + +(luna-define-method elmo-folder-append-buffer ((folder elmo-filter-folder) + unread &optional number) + (elmo-folder-append-buffer + (elmo-filter-folder-target-internal folder) + unread number)) + +(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)) + +(luna-define-method elmo-folder-delete-messages ((folder elmo-filter-folder) + numbers) + (elmo-folder-delete-messages + (elmo-filter-folder-target-internal folder) numbers)) + +(luna-define-method elmo-folder-list-messages-internal + ((folder elmo-filter-folder) &optional nohide) + (let ((target (elmo-filter-folder-target-internal folder))) + (if (or (elmo-folder-plugged-p target) + (not (elmo-folder-persistent-p folder))) + ;; search target folder + (elmo-folder-search + target + (elmo-filter-folder-condition-internal folder)) + ;; 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) + (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))) + +(luna-define-method elmo-folder-list-subfolders ((folder elmo-filter-folder) + &optional one-level) + (let* ((target (elmo-filter-folder-target-internal folder)) + (prefix (and (string-match + (concat "^\\(.*\\)" + (regexp-quote + (elmo-folder-name-internal + target)) + "$") + (elmo-folder-name-internal folder)) + (match-string 1 (elmo-folder-name-internal + folder))))) + (elmo-mapcar-list-of-list + (lambda (x) (concat prefix x)) + (elmo-folder-list-subfolders target one-level)))) + +(luna-define-method elmo-folder-diff :around ((folder elmo-filter-folder) + &optional numbers) + (let ((condition (elmo-filter-folder-condition-internal folder)) + diff) + (if (vectorp condition) + (cond + ((and (string= (elmo-filter-key condition) "flag") + (or (string= (elmo-filter-value condition) "any") + (string= (elmo-filter-value condition) "digest") + (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)))) + ((string= "last" (elmo-filter-key condition)) + (luna-call-next-method)) + (t + (cons nil (cdr (elmo-folder-diff (elmo-filter-folder-target-internal + folder)))))) + (luna-call-next-method)))) + +(luna-define-method elmo-folder-status ((folder elmo-filter-folder)) + (elmo-folder-status + (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-exists-p ((folder elmo-filter-folder)) + (elmo-folder-exists-p (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-creatable-p ((folder elmo-filter-folder)) + (elmo-folder-creatable-p (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-writable-p ((folder elmo-filter-folder)) + (elmo-folder-writable-p (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-create ((folder elmo-filter-folder)) + (elmo-folder-create (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-search ((folder elmo-filter-folder) + condition &optional numbers) ;; search from messages in this folder - (elmo-list-filter - numlist - (elmo-call-func (nth 2 spec) "search" condition - (elmo-filter-list-folder spec)))) + (elmo-list-filter + numbers + (elmo-folder-search (elmo-filter-folder-target-internal folder) + condition + (elmo-folder-list-messages folder)))) + +(luna-define-method elmo-message-use-cache-p ((folder elmo-filter-folder) + number) + (elmo-message-use-cache-p (elmo-filter-folder-target-internal folder) + number)) + +(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-plugged-p ((folder elmo-filter-folder)) + (elmo-folder-plugged-p (elmo-filter-folder-target-internal folder))) + +(luna-define-method elmo-folder-set-plugged ((folder elmo-filter-folder) + plugged &optional add) + (elmo-folder-set-plugged (elmo-filter-folder-target-internal folder) + plugged add)) -(defun elmo-filter-use-cache-p (spec number) - (elmo-call-func (nth 2 spec) "use-cache-p" number)) +(luna-define-method elmo-message-file-name ((folder elmo-filter-folder) + number) + (elmo-message-file-name (elmo-filter-folder-target-internal folder) + number)) -(defun elmo-filter-local-file-p (spec number) - (elmo-call-func (nth 2 spec) "local-file-p" number)) +(luna-define-method elmo-folder-mark-as-read :around ((folder + elmo-filter-folder) + numbers + &optional ignore-flag) + (elmo-folder-mark-as-read (elmo-filter-folder-target-internal folder) + numbers ignore-flag) + (luna-call-next-method)) -(defun elmo-filter-commit (spec) - (elmo-commit (nth 2 spec))) +(luna-define-method elmo-folder-unmark-read :around ((folder + elmo-filter-folder) + numbers + &optional ignore-flag) + (elmo-folder-unmark-read (elmo-filter-folder-target-internal folder) + numbers ignore-flag) + (luna-call-next-method)) -(defun elmo-filter-plugged-p (spec) - (elmo-folder-plugged-p (nth 2 spec))) +(luna-define-method elmo-folder-mark-as-important :around ((folder + elmo-filter-folder) + numbers) + (elmo-folder-mark-as-important (elmo-filter-folder-target-internal folder) + numbers) + (luna-call-next-method)) -(defun elmo-filter-set-plugged (spec plugged add) - (elmo-folder-set-plugged (nth 2 spec) plugged add)) +(luna-define-method elmo-folder-unmark-important :around ((folder + elmo-filter-folder) + numbers) + (elmo-folder-unmark-important (elmo-filter-folder-target-internal folder) + numbers) + (luna-call-next-method)) -(defun elmo-filter-get-msg-filename (spec number &optional loc-alist) - ;; This function may be called when elmo-filter-local-file-p() - ;; returns t. - (elmo-call-func (nth 2 spec) "get-msg-filename" number loc-alist)) +(luna-define-method elmo-folder-mark-as-answered :around ((folder + elmo-filter-folder) + numbers) + (elmo-folder-mark-as-answered (elmo-filter-folder-target-internal folder) + numbers) + (luna-call-next-method)) -(defun elmo-filter-sync-number-alist (spec number-alist) - (elmo-call-func (nth 2 spec) "sync-number-alist" number-alist)) -(defun elmo-filter-server-diff (spec) - (elmo-call-func (nth 2 spec) "server-diff")) +(luna-define-method elmo-folder-unmark-answered :around ((folder + elmo-filter-folder) + numbers) + (elmo-folder-unmark-answered (elmo-filter-folder-target-internal folder) + numbers) + (luna-call-next-method)) -(provide 'elmo-filter) +(require 'product) +(product-provide (provide 'elmo-filter) (require 'elmo-version)) ;;; elmo-filter.el ends here