(elmo-define-signal flag-changed (numbers)
"Notify the change flag of the messages with NUMBERS.")
-(elmo-define-signal cache-changed (number)
- "Notify the change cache status of the message with NUMBER.")
+(elmo-define-signal status-changed (numbers)
+ "Notify the change status of the message with NUMBERS.")
(elmo-define-signal update-overview (number)
"Notify update overview of the message with NUMBER.")
(autoload 'elmo-global-flag-detach "elmo-flag")
(autoload 'elmo-global-flag-detach-messages "elmo-flag")
(autoload 'elmo-global-flag-set "elmo-flag")
+ (autoload 'elmo-global-flag-replace-referrer "elmo-flag")
(autoload 'elmo-get-global-flags "elmo-flag")
(autoload 'elmo-global-flags-initialize "elmo-flag")
(autoload 'elmo-global-mark-migrate "elmo-flag")
- (autoload 'elmo-folder-list-global-flag-messages "elmo-flag"))
+ (autoload 'elmo-folder-list-global-flag-messages "elmo-flag")
+ (autoload 'elmo-search-register-engine "elmo-search"))
(defun elmo-define-folder (prefix backend)
"Define a folder.
persistent ; non-nil if persistent.
process-duplicates ; read or hide
biff ; folder for biff
+ mime-charset ; charset for encode & decode
))
(luna-define-internal-accessors 'elmo-folder))
(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)
+(defun elmo-make-folder (name &optional non-persistent mime-charset)
"Make an ELMO folder structure specified by NAME.
-If optional argument NON-PERSISTENT is non-nil, the folder msgdb is not saved."
+If optional argument NON-PERSISTENT is non-nil, the folder msgdb is not saved.
+If optional argument MIME-CHARSET is specified, it is used for
+encode and decode a multibyte string."
(let ((type (elmo-folder-type name))
prefix split class folder original)
(setq original (elmo-string name))
:type type
:prefix prefix
:name original
- :persistent (not non-persistent)))
+ :persistent (not non-persistent)
+ :mime-charset mime-charset))
(save-match-data
(elmo-folder-send folder 'elmo-folder-initialize name))))
+(defvar elmo-get-folder-function nil)
+
+(defun elmo-get-folder (name)
+ (or (and elmo-get-folder-function
+ (funcall elmo-get-folder-function name))
+ (elmo-make-folder name)))
+
;; Note that this function is for internal use only.
(luna-define-generic elmo-folder-msgdb (folder)
"Return the msgdb of FOLDER (on-demand loading).
\(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.")
t))
(luna-define-method elmo-folder-rename ((folder elmo-folder) new-name)
- (let* ((new-folder (elmo-make-folder new-name)))
+ (let ((new-folder (elmo-make-folder
+ new-name
+ nil
+ (elmo-folder-mime-charset-internal folder))))
(unless (eq (elmo-folder-type-internal folder)
(elmo-folder-type-internal new-folder))
(error "Not same folder type"))
- (if (or (file-exists-p (elmo-folder-msgdb-path new-folder))
- (elmo-folder-exists-p new-folder))
- (error "Already exists folder: %s" new-name))
+ (when (or (file-exists-p (elmo-folder-msgdb-path new-folder))
+ (elmo-folder-exists-p new-folder))
+ (error "Already exists folder: %s" new-name))
(elmo-folder-send folder 'elmo-folder-rename-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-delete-messages ((folder elmo-folder)
(setq results (elmo-msgdb-search msgdb condition numbers))
(if (listp results)
results
- (let ((len (length numbers))
- matched)
- (elmo-with-progress-display (> len elmo-display-progress-threshold)
- (elmo-folder-search len "Searching...")
+ (elmo-condition-optimize condition)
+ (when (and (consp condition)
+ (eq (car condition) 'and)
+ (listp (setq results (elmo-msgdb-search msgdb
+ (nth 1 condition)
+ numbers))))
+ (setq numbers results
+ condition (nth 2 condition)))
+ (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)
+ (let* ((handler (luna-make-entity 'modb-buffer-entity-handler))
+ (result (elmo-condition-match
+ condition
+ (lambda (condition handler entity)
+ (elmo-msgdb-message-match-condition handler
+ condition
+ entity))
+ (list
+ handler
+ (elmo-msgdb-make-message-entity
+ handler
+ :number number
+ :buffer (current-buffer))))))
+ (and result (not (elmo-filter-condition-p result)))))
+
(luna-define-method elmo-message-match-condition ((folder elmo-folder)
number condition
numbers)
(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)
(set-buffer-multibyte default-enable-multibyte-characters)
(decode-coding-region (point-min) (point-max)
elmo-mime-display-as-is-coding-system)
- (elmo-buffer-field-condition-match condition number numbers)))))
+ (elmo-message-buffer-match-condition condition number)))))
(luna-define-method elmo-folder-pack-numbers ((folder elmo-folder))
nil) ; default is noop.
(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)
(error "move: %d is not writable"
(elmo-folder-name-internal dst-folder)))
(when messages
- ;; src is already opened.
+ (elmo-folder-open-internal src-folder)
(elmo-folder-open-internal dst-folder)
(unless (setq succeeds (elmo-folder-append-messages dst-folder
src-folder
result)
(if no-delete
(progn
- ;; (message "Copying messages...done")
+;;; (message "Copying messages...done")
t)
(if (eq len 0)
(message "No message was moved.")
(luna-define-method elmo-message-cached-p ((folder elmo-folder) number)
(elmo-message-flagged-p folder number 'cached))
+(luna-define-generic elmo-message-killed-p (folder number)
+ "Return non-nil if the message is killed.")
+
+(luna-define-method elmo-message-killed-p ((folder elmo-folder) number)
+ (let ((killed-list (elmo-folder-killed-list-internal folder)))
+ (and killed-list
+ (elmo-number-set-member number killed-list))))
+
(defun elmo-message-accessible-p (folder number)
"Get accessibility of the message.
Return non-nil when message is accessible."
(if cached
(elmo-msgdb-set-flag (elmo-folder-msgdb folder) number 'cached)
(elmo-msgdb-unset-flag (elmo-folder-msgdb folder) number 'cached))
- (elmo-emit-signal 'cache-changed folder number))
+ (elmo-emit-signal 'status-changed folder (list number)))
(defun elmo-message-copy-entity (entity)
(elmo-msgdb-copy-message-entity (elmo-message-entity-handler entity)
;; 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."
(length duplicates))
0))
-(defun elmo-folder-confirm-appends (appends)
+(defun elmo-folder-confirm-appends (folder appends)
(let ((len (length appends))
in)
(if (and elmo-folder-update-threshold
(> len elmo-folder-update-threshold)
elmo-folder-update-confirm)
- (if (y-or-n-p (format "Too many messages(%d). Update all? " len))
+ (if (y-or-n-p (format
+ "Too many messages(%d) in %s. Update all? "
+ len (elmo-folder-name-internal folder)))
appends
(setq in elmo-folder-update-threshold)
(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
numbers))
(elmo-folder-unset-flag folder numbers 'all 'local-only))
+(luna-define-generic elmo-folder-recover-messages (folder numbers)
+ "Recover killed messages in the FOLDER with NUMBERS.")
+
+(luna-define-method elmo-folder-recover-messages ((folder elmo-folder) numbers)
+ (let ((msgdb (elmo-folder-msgdb folder)))
+ (elmo-folder-set-killed-list-internal
+ folder
+ (elmo-number-set-delete-list
+ (elmo-folder-killed-list-internal folder)
+ numbers))
+ (dolist (number numbers)
+ (if (elmo-file-cache-exists-p
+ (elmo-message-field folder number 'message-id))
+ (elmo-msgdb-set-flag msgdb number 'cached)
+ (elmo-msgdb-unset-flag msgdb number 'cached)))
+ (elmo-emit-signal 'status-changed folder numbers)))
+
(luna-define-method elmo-folder-clear ((folder elmo-folder)
&optional keep-killed)
(unless keep-killed
(when (and mask (not ignore-msgdb))
(setq diff-new (elmo-list-filter mask diff-new))))
(message "Checking folder diff...done")
- (setq new-list (elmo-folder-confirm-appends diff-new))
+ (setq new-list (elmo-folder-confirm-appends folder diff-new))
;; Append to killed list as (MIN-OF-DISAPPEARED . MAX-OF-DISAPPEARED)
(when (not (eq (length diff-new)
(length new-list)))
(defun elmo-folder-msgdb-load (folder &optional silent)
(unless silent
(message "Loading msgdb for %s..." (elmo-folder-name-internal folder)))
- (let ((msgdb (elmo-load-msgdb (elmo-folder-msgdb-path folder))))
+ (let ((msgdb (elmo-load-msgdb (elmo-folder-msgdb-path folder)
+ (elmo-folder-mime-charset-internal folder))))
(elmo-folder-set-info-max-by-numdb
folder
(elmo-msgdb-list-messages msgdb))
(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)
(elmo-make-directory temp-dir)
temp-dir))
+;; ELMO status structure.
+(defmacro elmo-message-status (folder number &optional flags killed)
+ "Make ELMO status structure from FOLDER and NUMBER.
+A value in this structure is cached at first access."
+ `(vector ,folder ,number ,flags ,killed))
+
+(defmacro elmo-message-status-folder (status)
+ `(aref ,status 0))
+
+(defmacro elmo-message-status-number (status)
+ `(aref ,status 1))
+
+(defmacro elmo-message-status-set-flags (status flags)
+ `(aset ,status 2 (or ,flags '(read))))
+
+(defsubst elmo-message-status-flags (status)
+ (or (aref status 2)
+ (elmo-message-status-set-flags
+ status
+ (elmo-message-flags (elmo-message-status-folder status)
+ (elmo-message-status-number status)))))
+
+(defsubst elmo-message-status-cached-p (status)
+ (memq 'cached (elmo-message-status-flags status)))
+
+(defmacro elmo-message-status-set-killed (status killed)
+ `(aset ,status 3 (if ,killed 'killed 'living)))
+
+(defsubst elmo-message-status-killed-p (status)
+ (eq 'killed
+ (or (aref status 3)
+ (elmo-message-status-set-killed
+ status
+ (elmo-message-killed-p (elmo-message-status-folder status)
+ (elmo-message-status-number status))))))
+
;;;
(defun elmo-init ()
"Initialize ELMO module."
(elmo-define-folder ?| 'pipe)
(elmo-define-folder ?. 'maildir)
(elmo-define-folder ?' 'internal)
-(elmo-define-folder ?\[ 'nmz)
+(elmo-define-folder ?\[ 'search)
(elmo-define-folder ?@ 'shimbun)
;;; Obsolete variables.
'elmo-msgdb-directory)
(elmo-define-obsolete-variable 'elmo-global-flag-list
'elmo-global-flags)
+(elmo-define-obsolete-variable 'elmo-nmz-default-index-path
+ 'elmo-search-namazu-default-index-path)
+(elmo-define-obsolete-variable 'elmo-nmz-index-alias-alist
+ 'elmo-search-namazu-index-alias-alist)
+(elmo-define-obsolete-variable 'elmo-nmz-use-drive-letter
+ 'elmo-search-use-drive-letter)
+
;; Obsolete functions.
;; 2001-12-11: *-dir -> *-directory
projects / elisp / wanderlust.git / blobdiff