(defmacro elmo-folder-send (folder message &rest args)
"Let FOLDER receive the MESSAGE with ARGS."
- (` (luna-send (, folder) (, message) (, folder) (,@ args))))
+ `(luna-send ,folder ,message ,folder ,@args))
;;;###autoload
(defun elmo-make-folder (name &optional non-persistent mime-charset)
\(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.")
numbers))))
(setq numbers results
condition (nth 2 condition)))
- (let ((len (length numbers))
- matched)
- (elmo-with-progress-display (> len elmo-display-progress-threshold)
- (elmo-folder-search len "Searching...")
+ (let (matched)
+ (elmo-with-progress-display (elmo-folder-search (length numbers))
+ "Searching messages"
(dolist (number numbers)
(let (result)
(setq result (elmo-msgdb-match-condition msgdb
(when result
(setq matched (cons number matched))))
(elmo-progress-notify 'elmo-folder-search)))
- (message "Searching...done")
(nreverse matched)))))
(defun elmo-message-buffer-match-condition (condition number)
(when (and filename (file-readable-p filename))
(with-temp-buffer
(set-buffer-multibyte nil)
- ;;(insert-file-contents-as-binary filename)
+;;; (insert-file-contents-as-binary filename)
(elmo-message-fetch folder number
(elmo-make-fetch-strategy 'entire
(and cache t)
(elmo-folder-set-info-hashtb
folder
(if numbers (apply #'max numbers) 0)
- nil ;;(length num-db)
+;;; (length num-db)
+ nil
))
(defun elmo-folder-get-info-max (folder)
"Setup folder info hashtable by INFO-ALIST on HASHTB."
(let* ((hashtb (or hashtb
(elmo-make-hash (length info-alist)))))
- (mapcar
+ (mapc
(lambda (x)
(let ((info (cadr x)))
(and (intern-soft (car x) hashtb)
(+ 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-dispatch-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-dispatch-table)
+ elmo-append-messages-dispatch-table))
+ elmo-append-messages-dispatch-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)
(let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder))))
- unseen table
+ unseen
succeed-numbers failure cache id)
- (setq table (elmo-folder-flag-table folder))
+ (elmo-folder-flag-table folder) ; load
(with-temp-buffer
(set-buffer-multibyte nil)
(while numbers
same-number)
(save-excursion
(let* ((messages msgs)
- (elmo-inhibit-display-retrieval-progress t)
(len (length msgs))
succeeds i result)
(if (eq dst-folder 'null)
result)
(if no-delete
(progn
- ;; (message "Copying messages...done")
+;;; (message "Copying messages...done")
t)
(if (eq len 0)
(message "No message was moved.")
;; Do nothing.
)
-;;(luna-define-generic elmo-folder-append-message-entity (folder entity
-;; &optional
-;; flag-table)
-;; "Append ENTITY to the folder.")
+;;;(luna-define-generic elmo-folder-append-message-entity (folder entity
+;;; &optional
+;;; flag-table)
+;;; "Append ENTITY to the folder.")
(defun elmo-msgdb-merge (folder msgdb-merge)
"Return a list of messages which have duplicated message-id."
(catch 'end
(while t
(setq in (read-from-minibuffer "Update number: "
- (int-to-string in))
- in (string-to-int in))
+ (number-to-string in))
+ in (string-to-number in))
(if (< len in)
(throw 'end len))
(if (y-or-n-p (format
(while alist
(setq newsgroups
(elmo-delete-if
- '(lambda (x)
- (not (intern-soft x elmo-newsgroups-hashtb)))
+ (lambda (x)
+ (not (intern-soft x elmo-newsgroups-hashtb)))
(nth 1 (car alist))))
(if newsgroups
(setcar (cdar alist) newsgroups)
projects / elisp / wanderlust.git / blobdiff