X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-pipe.el;h=f3c7ffcb68172fe36187e8d4536d673f144aaf33;hb=824fe18b2ad090f609041a4af11de484bdb7e3a8;hp=8b645c8866bb4bf6906aebc549e3b5a90fb371ef;hpb=4cc1db42dcee5928cf359133047c88ede4cdd5c3;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-pipe.el b/elmo/elmo-pipe.el index 8b645c8..f3c7ffc 100644 --- a/elmo/elmo-pipe.el +++ b/elmo/elmo-pipe.el @@ -30,6 +30,7 @@ ;; (require 'elmo) +(require 'elmo-signal) (defvar elmo-pipe-folder-copied-filename "copied" "Copied messages number set.") @@ -44,33 +45,61 @@ name) (when (string-match "^\\([^|]*\\)|\\(:?\\)\\(.*\\)$" name) (elmo-pipe-folder-set-src-internal folder - (elmo-make-folder + (elmo-get-folder (elmo-match-string 1 name))) (elmo-pipe-folder-set-dst-internal folder - (elmo-make-folder + (elmo-get-folder (elmo-match-string 3 name))) (elmo-pipe-folder-set-copy-internal folder (string= ":" (elmo-match-string 2 name)))) + (elmo-pipe-connect-signals folder (elmo-pipe-folder-dst-internal folder)) folder) +(defun elmo-pipe-connect-signals (folder destination) + (elmo-connect-signal + destination 'flag-changing folder + (elmo-define-signal-handler (folder dst number old-flags new-flags) + (elmo-emit-signal 'flag-changing folder number old-flags new-flags))) + (elmo-connect-signal + destination 'flag-changed folder + (elmo-define-signal-handler (folder dst numbers) + (elmo-emit-signal 'flag-changed folder numbers))) + (elmo-connect-signal + destination 'status-changed folder + (elmo-define-signal-handler (folder dst numbers) + (elmo-emit-signal 'status-changed folder numbers))) + (elmo-connect-signal + destination 'update-overview folder + (elmo-define-signal-handler (folder dst number) + (elmo-emit-signal 'update-overview folder number)))) + (luna-define-method elmo-folder-get-primitive-list ((folder elmo-pipe-folder)) - (elmo-flatten - (mapcar - 'elmo-folder-get-primitive-list - (list (elmo-pipe-folder-src-internal folder) - (elmo-pipe-folder-dst-internal folder))))) + (nconc + (elmo-folder-get-primitive-list (elmo-pipe-folder-src-internal folder)) + (elmo-folder-get-primitive-list (elmo-pipe-folder-dst-internal folder)))) (luna-define-method elmo-folder-contains-type ((folder elmo-pipe-folder) type) (or (elmo-folder-contains-type (elmo-pipe-folder-src-internal folder) type) (elmo-folder-contains-type (elmo-pipe-folder-dst-internal folder) type))) -(luna-define-method elmo-folder-append-messages ((folder elmo-pipe-folder) - src-folder numbers - &optional same-number) - (elmo-folder-append-messages (elmo-pipe-folder-dst-internal folder) - src-folder numbers +(defun elmo-folder-append-messages-pipe-* (dst-folder + src-folder + numbers + same-number) + (elmo-folder-append-messages dst-folder + (elmo-pipe-folder-dst-internal src-folder) + numbers + same-number)) + +(defun elmo-folder-append-messages-*-pipe (dst-folder + src-folder + numbers + same-number) + (elmo-folder-append-messages (elmo-pipe-folder-dst-internal dst-folder) + src-folder + numbers same-number)) (luna-define-method elmo-folder-append-buffer ((folder elmo-pipe-folder) @@ -80,9 +109,9 @@ (luna-define-method elmo-message-fetch ((folder elmo-pipe-folder) number strategy - &optional section outbuf unseen) + &optional unseen section) (elmo-message-fetch (elmo-pipe-folder-dst-internal folder) - number strategy section outbuf unseen)) + number strategy unseen section)) (luna-define-method elmo-folder-clear :after ((folder elmo-pipe-folder) &optional keep-killed) @@ -94,40 +123,35 @@ (elmo-folder-delete-messages (elmo-pipe-folder-dst-internal folder) numbers)) +(luna-define-method elmo-folder-detach-messages ((folder elmo-pipe-folder) + numbers) + (elmo-folder-detach-messages (elmo-pipe-folder-dst-internal folder) + numbers)) + (defvar elmo-pipe-drained-hook nil "A hook called when the pipe is flushed.") (defsubst elmo-pipe-folder-list-target-messages (src &optional ignore-list) - (unwind-protect - (progn - (elmo-folder-set-killed-list-internal src ignore-list) - (elmo-folder-list-messages src)) - (elmo-folder-set-killed-list-internal src nil))) + (let ((killed (elmo-folder-killed-list-internal src))) + (elmo-folder-set-killed-list-internal src ignore-list) + (unwind-protect + (elmo-folder-list-messages src t) + (elmo-folder-set-killed-list-internal src killed)))) (defun elmo-pipe-drain (src dst &optional copy ignore-list) "Move or copy all messages of SRC to DST." - (let ((elmo-inhibit-number-mapping (and (eq (elmo-folder-type-internal - src) 'pop3) - (not copy))) ; No need to use UIDL - msgs len) + (let ((elmo-inhibit-number-mapping (and (eq (elmo-folder-type-internal src) + 'pop3) + (not copy)))) ; No need to use UIDL (message "Checking %s..." (elmo-folder-name-internal src)) - ;; Warnnig: some function requires msgdb - ;; but elmo-folder-open-internal do not load msgdb. - (elmo-folder-open-internal src) - (setq msgs (elmo-pipe-folder-list-target-messages src ignore-list) - len (length msgs)) - (when (> len elmo-display-progress-threshold) - (elmo-progress-set 'elmo-folder-move-messages - len - (if copy - "Copying messages..." - "Moving messages..."))) + (elmo-folder-open src) (unwind-protect - (elmo-folder-move-messages src msgs dst copy) - (elmo-progress-clear 'elmo-folder-move-messages)) - (when (and copy msgs) - (setq ignore-list (elmo-number-set-append-list ignore-list - msgs))) - (elmo-folder-close-internal src) + (let ((msgs (elmo-pipe-folder-list-target-messages src ignore-list))) + (elmo-with-progress-display (elmo-folder-move-messages (length msgs)) + (if copy "Copying messages" "Moving messages") + (elmo-folder-move-messages src msgs dst copy)) + (when (and copy msgs) + (setq ignore-list (elmo-number-set-append-list ignore-list msgs)))) + (elmo-folder-close src)) (run-hooks 'elmo-pipe-drained-hook) ignore-list)) @@ -156,12 +180,11 @@ (elmo-folder-open-internal (elmo-pipe-folder-dst-internal folder))) (luna-define-method elmo-folder-close-internal ((folder elmo-pipe-folder)) - (elmo-folder-close-internal(elmo-pipe-folder-dst-internal folder))) + (elmo-folder-close-internal (elmo-pipe-folder-dst-internal folder))) -(luna-define-method elmo-folder-set-message-modified - ((folder elmo-pipe-folder) modified) - (elmo-folder-set-message-modified-internal - (elmo-pipe-folder-dst-internal folder) modified)) +(luna-define-method elmo-folder-close ((folder elmo-pipe-folder)) + (elmo-generic-folder-close folder) + (elmo-folder-close (elmo-pipe-folder-dst-internal folder))) (luna-define-method elmo-folder-list-messages ((folder elmo-pipe-folder) &optional visible-only in-msgdb) @@ -169,15 +192,6 @@ (elmo-folder-list-messages (elmo-pipe-folder-dst-internal folder) visible-only in-msgdb)) -(luna-define-method elmo-folder-list-unreads ((folder elmo-pipe-folder)) - (elmo-folder-list-unreads (elmo-pipe-folder-dst-internal folder))) - -(luna-define-method elmo-folder-list-importants ((folder elmo-pipe-folder)) - (elmo-folder-list-importants (elmo-pipe-folder-dst-internal folder))) - -(luna-define-method elmo-folder-list-answereds ((folder elmo-pipe-folder)) - (elmo-folder-list-answereds (elmo-pipe-folder-dst-internal folder))) - (luna-define-method elmo-folder-diff ((folder elmo-pipe-folder)) (elmo-folder-open-internal (elmo-pipe-folder-src-internal folder)) (elmo-folder-open-internal (elmo-pipe-folder-dst-internal folder)) @@ -192,8 +206,8 @@ ((consp (cdr dst-diff)) ; new unread all (mapcar (lambda (number) (+ number src-length)) dst-diff)) (t - (cons (+ (car dst-diff) src-length) - (+ (cdr dst-diff) src-length)))) + (cons (+ (or (car dst-diff) 0) src-length) + (+ (or (cdr dst-diff) 0) src-length)))) ;; No save. (elmo-folder-close-internal (elmo-pipe-folder-src-internal folder)) (elmo-folder-close-internal (elmo-pipe-folder-dst-internal folder))))) @@ -221,6 +235,11 @@ (luna-define-method elmo-folder-writable-p ((folder elmo-pipe-folder)) (elmo-folder-writable-p (elmo-pipe-folder-dst-internal folder))) +(luna-define-method elmo-folder-recover-messages ((folder elmo-pipe-folder) + numbers) + (elmo-folder-recover-messages + (elmo-pipe-folder-dst-internal folder) numbers)) + (luna-define-method elmo-folder-create ((folder elmo-pipe-folder)) (if (and (not (elmo-folder-exists-p (elmo-pipe-folder-src-internal folder))) (elmo-folder-creatable-p (elmo-pipe-folder-src-internal folder))) @@ -244,6 +263,13 @@ (and (elmo-folder-plugged-p (elmo-pipe-folder-src-internal folder)) (elmo-folder-plugged-p (elmo-pipe-folder-dst-internal folder)))) +(luna-define-method elmo-folder-set-plugged ((folder elmo-pipe-folder) + plugged &optional add) + (elmo-folder-set-plugged (elmo-pipe-folder-src-internal folder) + plugged add) + (elmo-folder-set-plugged (elmo-pipe-folder-dst-internal folder) + plugged add)) + (luna-define-method elmo-folder-message-file-p ((folder elmo-pipe-folder)) (elmo-folder-message-file-p (elmo-pipe-folder-dst-internal folder))) @@ -275,44 +301,25 @@ (elmo-folder-message-make-temp-files (elmo-pipe-folder-dst-internal folder) numbers start-number)) -(luna-define-method elmo-folder-mark-as-read ((folder elmo-pipe-folder) - numbers &optional ignore-flag) - (elmo-folder-mark-as-read (elmo-pipe-folder-dst-internal folder) - numbers ignore-flag)) - -(luna-define-method elmo-folder-unmark-read ((folder elmo-pipe-folder) - numbers - &optional ignore-flag) - (elmo-folder-unmark-read (elmo-pipe-folder-dst-internal folder) - numbers ignore-flag)) - -(luna-define-method elmo-folder-unmark-important ((folder elmo-pipe-folder) - numbers - &optional ignore-flag) - (elmo-folder-unmark-important (elmo-pipe-folder-dst-internal folder) - numbers ignore-flag)) - -(luna-define-method elmo-folder-mark-as-important ((folder elmo-pipe-folder) - numbers - &optional ignore-flag) - (elmo-folder-mark-as-important (elmo-pipe-folder-dst-internal folder) - numbers ignore-flag)) - -(luna-define-method elmo-folder-unmark-answered ((folder elmo-pipe-folder) - numbers) - (elmo-folder-unmark-answered (elmo-pipe-folder-dst-internal folder) - numbers)) +(luna-define-method elmo-folder-set-flag ((folder elmo-pipe-folder) + numbers + flag + &optional is-local) + (elmo-folder-set-flag (elmo-pipe-folder-dst-internal folder) + numbers flag is-local)) -(luna-define-method elmo-folder-mark-as-answered ((folder elmo-pipe-folder) - numbers) - (elmo-folder-mark-as-answered (elmo-pipe-folder-dst-internal folder) - numbers)) +(luna-define-method elmo-folder-unset-flag ((folder elmo-pipe-folder) + numbers + flag + &optional is-local) + (elmo-folder-unset-flag (elmo-pipe-folder-dst-internal folder) + numbers flag is-local)) (luna-define-method elmo-folder-pack-numbers ((folder elmo-pipe-folder)) (elmo-folder-pack-numbers (elmo-pipe-folder-dst-internal folder))) (luna-define-method elmo-folder-rename ((folder elmo-pipe-folder) new-name) - (let* ((new-folder (elmo-make-folder new-name))) + (let* ((new-folder (elmo-get-folder new-name))) (unless (string= (elmo-folder-name-internal (elmo-pipe-folder-src-internal folder)) (elmo-folder-name-internal @@ -323,21 +330,19 @@ (elmo-folder-type-internal (elmo-pipe-folder-dst-internal new-folder))) (error "Not same folder type")) - (if (or (file-exists-p (elmo-folder-msgdb-path - (elmo-pipe-folder-dst-internal new-folder))) - (elmo-folder-exists-p - (elmo-pipe-folder-dst-internal new-folder))) - (error "Already exists folder: %s" new-name)) - (elmo-folder-send (elmo-pipe-folder-dst-internal folder) - 'elmo-folder-rename-internal - (elmo-pipe-folder-dst-internal new-folder)) + (elmo-folder-rename (elmo-pipe-folder-dst-internal folder) + (elmo-folder-name-internal + (elmo-pipe-folder-dst-internal new-folder))) + (elmo-global-flag-replace-referrer (elmo-folder-name-internal folder) + new-name) (elmo-msgdb-rename-path folder new-folder))) (luna-define-method elmo-folder-synchronize ((folder elmo-pipe-folder) &optional disable-killed ignore-msgdb - no-check) + no-check + mask) (let ((src-folder (elmo-pipe-folder-src-internal folder)) (dst-folder (elmo-pipe-folder-dst-internal folder))) (when (and (elmo-folder-plugged-p src-folder) @@ -352,7 +357,7 @@ (elmo-pipe-drain src-folder dst-folder)))) (elmo-folder-synchronize (elmo-pipe-folder-dst-internal folder) - disable-killed ignore-msgdb no-check)) + disable-killed ignore-msgdb no-check mask)) (luna-define-method elmo-folder-list-flagged ((folder elmo-pipe-folder) flag @@ -366,38 +371,55 @@ (luna-define-method elmo-folder-length ((folder elmo-pipe-folder)) (elmo-folder-length (elmo-pipe-folder-dst-internal folder))) +(luna-define-method elmo-message-flag-available-p ((folder elmo-pipe-folder) + number flag) + (elmo-message-flag-available-p + (elmo-pipe-folder-dst-internal folder) + number flag)) + (luna-define-method elmo-folder-count-flags ((folder elmo-pipe-folder)) (elmo-folder-count-flags (elmo-pipe-folder-dst-internal folder))) -(luna-define-method elmo-message-mark ((folder elmo-pipe-folder) number) - (elmo-message-mark (elmo-pipe-folder-dst-internal folder) number)) +(luna-define-method elmo-message-flags ((folder elmo-pipe-folder) number) + (elmo-message-flags (elmo-pipe-folder-dst-internal folder) number)) (luna-define-method elmo-message-field ((folder elmo-pipe-folder) - number field) + number field &optional type) (elmo-message-field (elmo-pipe-folder-dst-internal folder) number - field)) + field + type)) + +(luna-define-method elmo-message-killed-p ((folder elmo-pipe-folder) number) + (elmo-message-killed-p (elmo-pipe-folder-dst-internal folder) number)) (luna-define-method elmo-message-set-cached ((folder elmo-pipe-folder) number cached) (elmo-message-set-cached (elmo-pipe-folder-dst-internal folder) number cached)) -(luna-define-method elmo-find-fetch-strategy - ((folder elmo-pipe-folder) entity &optional ignore-cache) +(luna-define-method elmo-find-fetch-strategy ((folder elmo-pipe-folder) + number + &optional + ignore-cache + require-entireness) (elmo-find-fetch-strategy (elmo-pipe-folder-dst-internal folder) - (elmo-message-entity - (elmo-pipe-folder-dst-internal folder) - (elmo-message-entity-number entity)) - ignore-cache)) + number + ignore-cache + require-entireness)) + +(luna-define-method elmo-message-number ((folder elmo-pipe-folder) + message-id) + (elmo-message-number (elmo-pipe-folder-dst-internal folder) + message-id)) (luna-define-method elmo-message-entity ((folder elmo-pipe-folder) key) (elmo-message-entity (elmo-pipe-folder-dst-internal folder) key)) (luna-define-method elmo-message-folder ((folder elmo-pipe-folder) number) - (elmo-pipe-folder-dst-internal folder)) - + (elmo-message-folder (elmo-pipe-folder-dst-internal folder) number)) + (require 'product) (product-provide (provide 'elmo-pipe) (require 'elmo-version))