From: hmurata Date: Sun, 1 Oct 2006 08:32:29 +0000 (+0000) Subject: * elmo.el (elmo-file-tag): New class. X-Git-Tag: wl-2_15_5~5 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=c869501fc881f10421f2192f1499153de31771a1;p=elisp%2Fwanderlust.git * elmo.el (elmo-file-tag): New class. (elmo-append-messages-disptch-table): New constant. (elmo-folder-type-p): New function. (elmo-folder-append-messages): Redefine as function. * elmo-null.el (elmo-folder-append-messages): Renamed from `elmo-folder-append-messages'. * elmo-maildir.el (elmo-maildir-folder): Inherit `elmo-file-tag'. (elmo-folder-append-messages-*-maildir): Renamed from `elmo-folder-append-messages'. * elmo-localdir.el (elmo-localdir-folder): Inherit `elmo-file-tag'. (elmo-folder-append-messages-*-localdir): Renamed from `elmo-folder-append-messages'. * elmo-imap4.el (elmo-folder-append-messages-imap4-imap4): Renamed from `elmo-folder-append-messages'. * elmo-flag.el (elmo-folder-append-messages-*-flag): Renamed from `elmo-folder-append-messages'. * elmo-filter.el (elmo-folder-append-messages-filter-*): New function. (elmo-folder-append-messages-*-filter): Ditto. * elmo-multi.el (elmo-folder-append-messages-multi-*): Ditto. * elmo-pipe.el (elmo-folder-append-messages-pipe-*): Ditto. (elmo-folder-append-messages-*-pipe): Renamed from `elmo-folder-append-messages'. * elmo-cache.el (elmo-cache-folder): Inherit `elmo-file-tag'. * elmo-file.el (elmo-file-folder): Ditto. * elmo-sendlog.el (elmo-sendlog-folder): Ditto. * elmo-archive.el (elmo-folder-append-messages-*-archive): Renamed from `elmo-folder-append-messages' --- diff --git a/elmo/ChangeLog b/elmo/ChangeLog index ba473c1..7698b5c 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,47 @@ +2006-10-01 Hiroya Murata + + * elmo.el (elmo-file-tag): New class. + (elmo-append-messages-disptch-table): New constant. + (elmo-folder-type-p): New function. + (elmo-folder-append-messages): Redefine as function. + + * elmo-null.el (elmo-folder-append-messages): Renamed from + `elmo-folder-append-messages'. + + * elmo-maildir.el (elmo-maildir-folder): Inherit `elmo-file-tag'. + (elmo-folder-append-messages-*-maildir): Renamed from + `elmo-folder-append-messages'. + + * elmo-localdir.el (elmo-localdir-folder): Inherit + `elmo-file-tag'. + (elmo-folder-append-messages-*-localdir): Renamed from + `elmo-folder-append-messages'. + + * elmo-imap4.el (elmo-folder-append-messages-imap4-imap4): Renamed + from `elmo-folder-append-messages'. + + * elmo-flag.el (elmo-folder-append-messages-*-flag): Renamed from + `elmo-folder-append-messages'. + + * elmo-filter.el (elmo-folder-append-messages-filter-*): New + function. + (elmo-folder-append-messages-*-filter): Ditto. + + * elmo-multi.el (elmo-folder-append-messages-multi-*): Ditto. + + * elmo-pipe.el (elmo-folder-append-messages-pipe-*): Ditto. + (elmo-folder-append-messages-*-pipe): Renamed from + `elmo-folder-append-messages'. + + * elmo-cache.el (elmo-cache-folder): Inherit `elmo-file-tag'. + + * elmo-file.el (elmo-file-folder): Ditto. + + * elmo-sendlog.el (elmo-sendlog-folder): Ditto. + + * elmo-archive.el (elmo-folder-append-messages-*-archive): Renamed + from `elmo-folder-append-messages' + 2006-09-23 Hiroya Murata * elmo-map.el (elmo-location-map-setup): Change an argument diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index 80b8e61..925ed62 100644 --- a/elmo/elmo-archive.el +++ b/elmo/elmo-archive.el @@ -623,8 +623,10 @@ TYPE specifies the archiver's symbol." t)) nil))))) -(luna-define-method elmo-folder-append-messages :around - ((folder elmo-archive-folder) src-folder numbers &optional same-number) +(defun elmo-folder-append-messages-*-archive (folder + src-folder + numbers + same-number) (let ((prefix (elmo-archive-folder-archive-prefix-internal folder))) (cond ((and same-number @@ -632,9 +634,10 @@ TYPE specifies the archiver's symbol." (elmo-folder-message-file-p src-folder) (elmo-folder-message-file-number-p src-folder)) ;; same-number(localdir, localnews) -> archive - (unless (elmo-archive-append-files folder - (elmo-folder-message-file-directory src-folder) - numbers) + (unless (elmo-archive-append-files + folder + (elmo-folder-message-file-directory src-folder) + numbers) (setq numbers nil)) (elmo-progress-notify 'elmo-folder-move-messages (length numbers)) numbers) @@ -676,7 +679,9 @@ TYPE specifies the archiver's symbol." (elmo-delete-directory temp-dir))) (elmo-progress-notify 'elmo-folder-move-messages (length numbers)) numbers) - (t (luna-call-next-method))))) + (t + (elmo-folder-append-messages folder src-folder numbers same-number + 'elmo-folder-append-messages-*-archive))))) (luna-define-method elmo-folder-message-make-temp-file-p ((folder elmo-archive-folder)) diff --git a/elmo/elmo-cache.el b/elmo/elmo-cache.el index 278633c..5db0fd9 100644 --- a/elmo/elmo-cache.el +++ b/elmo/elmo-cache.el @@ -36,7 +36,8 @@ (require 'elmo-map) (eval-and-compile - (luna-define-class elmo-cache-folder (elmo-map-folder) (dir-name directory)) + (luna-define-class elmo-cache-folder (elmo-map-folder elmo-file-tag) + (dir-name directory)) (luna-define-internal-accessors 'elmo-cache-folder)) (luna-define-method elmo-folder-initialize ((folder elmo-cache-folder) diff --git a/elmo/elmo-file.el b/elmo/elmo-file.el index dbf8b0b..4b84d7a 100644 --- a/elmo/elmo-file.el +++ b/elmo/elmo-file.el @@ -66,7 +66,8 @@ :group 'elmo) (eval-and-compile - (luna-define-class elmo-file-folder (elmo-map-folder) (file-path)) + (luna-define-class elmo-file-folder (elmo-map-folder elmo-file-tag) + (file-path)) (luna-define-internal-accessors 'elmo-file-folder)) (luna-define-method elmo-folder-initialize ((folder diff --git a/elmo/elmo-filter.el b/elmo/elmo-filter.el index 5d3ec54..700be31 100644 --- a/elmo/elmo-filter.el +++ b/elmo/elmo-filter.el @@ -223,6 +223,24 @@ (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) diff --git a/elmo/elmo-flag.el b/elmo/elmo-flag.el index 687d422..8f71c94 100644 --- a/elmo/elmo-flag.el +++ b/elmo/elmo-flag.el @@ -204,19 +204,16 @@ (message "Creating msgdb...done") new-msgdb))) -(luna-define-method elmo-folder-append-messages ((folder elmo-flag-folder) - src-folder - numbers - &optional same-number) - (dolist (number numbers) - (elmo-global-flag-set (elmo-flag-folder-flag-internal folder) - src-folder number (elmo-message-field - src-folder - number - 'message-id))) - (elmo-folder-set-flag src-folder - numbers - (elmo-flag-folder-flag-internal folder)) +(defun elmo-folder-append-messages-*-flag (dst-folder + src-folder + numbers + same-number) + (let ((flag (elmo-flag-folder-flag-internal dst-folder))) + (dolist (number numbers) + (elmo-global-flag-set flag src-folder number + (elmo-message-field + src-folder number 'message-id))) + (elmo-folder-set-flag src-folder numbers flag)) numbers) (luna-define-method elmo-folder-append-buffer ((folder elmo-flag-folder) diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index ce4b708..2aee276 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -2676,16 +2676,18 @@ If optional argument REMOVE is non-nil, remove FLAG." response (elmo-imap4-response-value response 'status)) (elmo-imap4-response-value response 'uidnext))) -(luna-define-method elmo-folder-append-messages :around - ((folder elmo-imap4-folder) src-folder numbers &optional same-number) - (if (and (eq (elmo-folder-type-internal src-folder) 'imap4) - (elmo-imap4-identical-system-p folder src-folder) - (elmo-folder-plugged-p folder)) +(defun elmo-folder-append-messages-imap4-imap4 (dst-folder + src-folder + numbers + same-number) + (if (and (elmo-imap4-identical-system-p dst-folder src-folder) + (elmo-folder-plugged-p dst-folder)) ;; Plugged (prog1 - (elmo-imap4-copy-messages src-folder folder numbers) + (elmo-imap4-copy-messages src-folder dst-folder numbers) (elmo-progress-notify 'elmo-folder-move-messages (length numbers))) - (luna-call-next-method))) + (elmo-folder-append-messages dst-folder src-folder numbers same-number + 'elmo-folder-append-messages-imap4-imap4))) (luna-define-method elmo-message-deletable-p ((folder elmo-imap4-folder) number) diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el index 2775ee4..a347bd3 100644 --- a/elmo/elmo-localdir.el +++ b/elmo/elmo-localdir.el @@ -46,7 +46,7 @@ ;;; ELMO Local directory folder (eval-and-compile - (luna-define-class elmo-localdir-folder (elmo-folder) + (luna-define-class elmo-localdir-folder (elmo-folder elmo-file-tag) (dir-name directory)) (luna-define-internal-accessors 'elmo-localdir-folder)) @@ -213,41 +213,40 @@ folder (elmo-msgdb-get-message-id-from-buffer) flags) t))) -(luna-define-method elmo-folder-append-messages :around - ((folder elmo-localdir-folder) - src-folder numbers &optional same-number) - (if (elmo-folder-message-file-p src-folder) - (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder)))) - (dir (elmo-localdir-folder-directory-internal folder)) - (table (elmo-folder-flag-table folder)) - (succeeds numbers) - (next-num (1+ (car (elmo-folder-status folder)))) - flags id) - (while numbers - (setq flags (elmo-message-flags src-folder (car numbers))) - (elmo-copy-file - (elmo-message-file-name src-folder (car numbers)) - (expand-file-name - (int-to-string - (if same-number (car numbers) next-num)) - dir)) - ;; save flag-table only when src folder's msgdb is loaded. - (when (setq id (and src-msgdb-exists - (elmo-message-field src-folder (car numbers) - 'message-id))) - (elmo-flag-table-set table id flags)) - (elmo-progress-notify 'elmo-folder-move-messages) - (if (and (setq numbers (cdr numbers)) - (not same-number)) - (setq next-num - (if (elmo-localdir-locked-p) - ;; MDA is running. - (1+ (car (elmo-folder-status folder))) - (1+ next-num))))) - (when (elmo-folder-persistent-p folder) - (elmo-folder-close-flag-table folder)) - succeeds) - (luna-call-next-method))) +(defun elmo-folder-append-messages-*-localdir (folder + src-folder + numbers + same-number) + (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder)))) + (dir (elmo-localdir-folder-directory-internal folder)) + (table (elmo-folder-flag-table folder)) + (succeeds numbers) + (next-num (1+ (car (elmo-folder-status folder)))) + flags id) + (while numbers + (setq flags (elmo-message-flags src-folder (car numbers))) + (elmo-copy-file + (elmo-message-file-name src-folder (car numbers)) + (expand-file-name + (int-to-string + (if same-number (car numbers) next-num)) + dir)) + ;; save flag-table only when src folder's msgdb is loaded. + (when (setq id (and src-msgdb-exists + (elmo-message-field src-folder (car numbers) + 'message-id))) + (elmo-flag-table-set table id flags)) + (elmo-progress-notify 'elmo-folder-move-messages) + (if (and (setq numbers (cdr numbers)) + (not same-number)) + (setq next-num + (if (elmo-localdir-locked-p) + ;; MDA is running. + (1+ (car (elmo-folder-status folder))) + (1+ next-num))))) + (when (elmo-folder-persistent-p folder) + (elmo-folder-close-flag-table folder)) + succeeds)) (luna-define-method elmo-folder-delete-messages-internal ((folder elmo-localdir-folder) numbers) diff --git a/elmo/elmo-maildir.el b/elmo/elmo-maildir.el index 9d0b42f..0037342 100644 --- a/elmo/elmo-maildir.el +++ b/elmo/elmo-maildir.el @@ -64,7 +64,7 @@ but some file systems don't support colons in filenames." ;;; ELMO Maildir folder (eval-and-compile (luna-define-class elmo-maildir-folder - (elmo-map-folder) + (elmo-map-folder elmo-file-tag) (directory unread-locations flagged-locations answered-locations)) @@ -488,36 +488,35 @@ file name for maildir directories." (incf cur-number)) temp-dir)) -(luna-define-method elmo-folder-append-messages :around - ((folder elmo-maildir-folder) - src-folder numbers &optional same-number) - (if (elmo-folder-message-file-p src-folder) - (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder)))) - (dir (elmo-maildir-folder-directory-internal folder)) - (table (elmo-folder-flag-table folder)) - (succeeds numbers) - filename flags id) - (dolist (number numbers) - (setq flags (elmo-message-flags src-folder number) - filename (elmo-maildir-temporal-filename dir)) - (elmo-copy-file - (elmo-message-file-name src-folder number) - filename) - (elmo-maildir-move-file - filename - (expand-file-name - (concat "new/" (file-name-nondirectory filename)) - dir)) - ;; src folder's msgdb is loaded. - (when (setq id (and src-msgdb-exists - (elmo-message-field src-folder number - 'message-id))) - (elmo-flag-table-set table id flags)) - (elmo-progress-notify 'elmo-folder-move-messages)) - (when (elmo-folder-persistent-p folder) - (elmo-folder-close-flag-table folder)) - succeeds) - (luna-call-next-method))) +(defun elmo-folder-append-messages-*-maildir (folder + src-folder + numbers + same-number) + (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder)))) + (dir (elmo-maildir-folder-directory-internal folder)) + (table (elmo-folder-flag-table folder)) + (succeeds numbers) + filename flags id) + (dolist (number numbers) + (setq flags (elmo-message-flags src-folder number) + filename (elmo-maildir-temporal-filename dir)) + (elmo-copy-file + (elmo-message-file-name src-folder number) + filename) + (elmo-maildir-move-file + filename + (expand-file-name + (concat "new/" (file-name-nondirectory filename)) + dir)) + ;; src folder's msgdb is loaded. + (when (setq id (and src-msgdb-exists + (elmo-message-field src-folder number + 'message-id))) + (elmo-flag-table-set table id flags)) + (elmo-progress-notify 'elmo-folder-move-messages)) + (when (elmo-folder-persistent-p folder) + (elmo-folder-close-flag-table folder)) + succeeds)) (luna-define-method elmo-map-folder-delete-messages ((folder elmo-maildir-folder) locations) diff --git a/elmo/elmo-multi.el b/elmo/elmo-multi.el index d9c2cf1..880310c 100644 --- a/elmo/elmo-multi.el +++ b/elmo/elmo-multi.el @@ -530,6 +530,29 @@ (when (cdr element) (elmo-folder-recover-messages (car element) (cdr element))))) +(defun elmo-folder-append-messages-multi-* (dst-folder + src-folder + numbers + same-number) + (if same-number + (elmo-folder-append-messages dst-folder src-folder numbers same-number + 'elmo-folder-append-messages-multi-*) + (let ((divider (elmo-multi-folder-divide-number-internal src-folder)) + (cur-number 0) + succeeds) + (dolist (element (elmo-multi-split-numbers src-folder numbers)) + (setq cur-number (+ cur-number 1)) + (when (cdr element) + (setq succeeds + (nconc + succeeds + (mapcar + (lambda (x) + (+ (* divider cur-number) x)) + (elmo-folder-append-messages + dst-folder (car element) (cdr element))))))) + succeeds))) + (require 'product) (product-provide (provide 'elmo-multi) (require 'elmo-version)) diff --git a/elmo/elmo-null.el b/elmo/elmo-null.el index b2b5faa..4cfec7e 100644 --- a/elmo/elmo-null.el +++ b/elmo/elmo-null.el @@ -67,11 +67,10 @@ (luna-define-method elmo-folder-writable-p ((folder elmo-null-folder)) t) -(luna-define-method elmo-folder-append-messages ((folder elmo-null-folder) - src-folder - numbers - &optional - same-number) +(defun elmo-folder-append-messages-*-null (dst-folder + src-folder + numbers + same-number) (elmo-progress-notify 'elmo-folder-move-messages (length numbers)) numbers) diff --git a/elmo/elmo-pipe.el b/elmo/elmo-pipe.el index 2abbbfb..704175b 100644 --- a/elmo/elmo-pipe.el +++ b/elmo/elmo-pipe.el @@ -84,11 +84,22 @@ (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) diff --git a/elmo/elmo-sendlog.el b/elmo/elmo-sendlog.el index ce01c2b..7c2c961 100644 --- a/elmo/elmo-sendlog.el +++ b/elmo/elmo-sendlog.el @@ -37,7 +37,8 @@ ;;; ELMO sendlog folder (eval-and-compile - (luna-define-class elmo-sendlog-folder (elmo-map-folder) (dir-name directory)) + (luna-define-class elmo-sendlog-folder (elmo-map-folder elmo-file-tag) + (dir-name directory)) (luna-define-internal-accessors 'elmo-sendlog-folder)) (luna-define-method elmo-folder-initialize ((folder elmo-sendlog-folder) diff --git a/elmo/elmo.el b/elmo/elmo.el index d23975a..e52ae66 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -434,21 +434,6 @@ If optional argument NUMBER is specified, the new message number is set \(if possible\). Return nil on failure.") -(luna-define-generic elmo-folder-append-messages (folder - src-folder - numbers - &optional - same-number) - "Append messages from folder. -FOLDER is the ELMO folder structure. -Caller should make sure FOLDER is `writable'. -\(Can be checked with `elmo-folder-writable-p'\). -SRC-FOLDER is the source ELMO folder structure. -NUMBERS is the message numbers to be appended in the SRC-FOLDER. -If second optional argument SAME-NUMBER is specified, -message number is preserved \(if possible\). -Returns a list of message numbers successfully appended.") - (luna-define-generic elmo-folder-pack-numbers (folder) "Pack message numbers of FOLDER.") @@ -1081,13 +1066,66 @@ If optional argument IF-EXISTS is nil, load on demand. (+ 1 (elmo-max-of-list (or (elmo-folder-list-messages folder) '(0))))) -(luna-define-method elmo-folder-append-messages ((folder elmo-folder) - src-folder - numbers - &optional - same-number) - (elmo-generic-folder-append-messages folder src-folder numbers - same-number)) +(eval-and-compile + (luna-define-class elmo-file-tag)) + +(defconst elmo-append-messages-disptch-table + '(((nil . null) . elmo-folder-append-messages-*-null) + ((filter . nil) . elmo-folder-append-messages-filter-*) + ((nil . filter) . elmo-folder-append-messages-*-filter) + ((pipe . nil) . elmo-folder-append-messages-pipe-*) + ((nil . pipe) . elmo-folder-append-messages-*-pipe) + ((multi . nil) . elmo-folder-append-messages-multi-*) + ((nil . flag) . elmo-folder-append-messages-*-flag) + ((imap4 . imap4) . elmo-folder-append-messages-imap4-imap4) + ((elmo-file-tag . localdir) . elmo-folder-append-messages-*-localdir) + ((elmo-file-tag . maildir) . elmo-folder-append-messages-*-maildir) + ((nil . archive) . elmo-folder-append-messages-*-archive) + ((nil . nil) . elmo-generic-folder-append-messages))) + +(defun elmo-folder-type-p (folder type) + (or (null type) + (eq (elmo-folder-type-internal folder) type) + (labels ((member-if (predicate list) + (and list + (or (funcall predicate (car list)) + (member-if predicate (cdr list))))) + (subtypep (name type) + (or (eq name type) + (let ((class (luna-find-class name))) + (and class + (member-if (lambda (name) + (subtypep name type)) + (luna-class-parents class))))))) + (subtypep (luna-class-name folder) + (or (intern-soft (format "elmo-%s-folder" type)) + type))))) + +(defun elmo-folder-append-messages (dst-folder src-folder numbers + &optional same-number caller) + "Append messages from folder. +DST-FOLDER is the ELMO folder structure. +Caller should make sure DST-FOLDER is `writable'. +\(Can be checked with `elmo-folder-writable-p'\). +SRC-FOLDER is the source ELMO folder structure. +NUMBERS is the message numbers to be appended in the SRC-FOLDER. +If second optional argument SAME-NUMBER is specified, +message number is preserved \(if possible\). +Returns a list of message numbers successfully appended." + (let ((rest (if caller + (cdr (memq (rassq caller elmo-append-messages-disptch-table) + elmo-append-messages-disptch-table)) + elmo-append-messages-disptch-table)) + result) + (while rest + (let ((types (car (car rest)))) + (if (and (elmo-folder-type-p src-folder (car types)) + (elmo-folder-type-p dst-folder (cdr types))) + (setq result (funcall (cdr (car rest)) + dst-folder src-folder numbers same-number) + rest nil) + (setq rest (cdr rest))))) + result)) (defun elmo-generic-folder-append-messages (folder src-folder numbers same-number)