(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-10-01 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * 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 <lapis-lazuli@pop06.odn.ne.jp>
* elmo-map.el (elmo-location-map-setup): Change an argument
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
(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)
(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))
(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)
: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
(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)
(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)
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)
;;; 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))
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)
;;; 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))
(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)
(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))
(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)
(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)
;;; 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)
\(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.")
(+ 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)
projects / elisp / wanderlust.git / commitdiff