X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo.el;h=c3c0bd7900b785ad1472a288cd596ee29204eba3;hb=2706485848c7fabd109477e1d7fad89a6249f0b2;hp=df61b7f0b2d2f64594851d9bd2e843258f6f05da;hpb=3d982b21b06c48c4e48e4b78649412f914ab59d8;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo.el b/elmo/elmo.el index df61b7f..c3c0bd7 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -95,8 +95,14 @@ Otherwise, entire fetching of the message is aborted without confirmation." (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.") + +(elmo-define-signal message-number-changed (old-number new-number) + "Notify change of message number within the folder.") ;; autoloads (eval-and-compile @@ -108,9 +114,12 @@ Otherwise, entire fetching of the message is aborted without confirmation." (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. @@ -142,6 +151,7 @@ If a folder name begins with PREFIX, use BACKEND." 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)) @@ -151,12 +161,14 @@ If a folder name begins with PREFIX, use BACKEND." (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)) @@ -175,10 +187,18 @@ If optional argument NON-PERSISTENT is non-nil, the folder msgdb is not saved." :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). @@ -197,6 +217,9 @@ If optional LOAD-MSGDB is non-nil, msgdb is loaded. (luna-define-generic elmo-folder-open-internal (folder) "Open FOLDER (without loading saved folder status).") +(luna-define-generic elmo-folder-open-internal-p (folder) + "Return non-nil if FOLDER is opened internally.") + (luna-define-generic elmo-folder-check (folder) "Check the FOLDER to obtain newest information at the next list operation.") @@ -414,21 +437,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.") @@ -708,6 +716,10 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") nil ; default is do nothing. ) +(luna-define-method elmo-folder-open-internal-p ((folder elmo-folder)) + t ; default is always opened internally + ) + (luna-define-method elmo-folder-check ((folder elmo-folder)) nil) ; default is noop. @@ -766,14 +778,19 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") 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) @@ -790,10 +807,17 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (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 @@ -808,9 +832,24 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (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) @@ -828,7 +867,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (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) @@ -838,7 +877,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (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. @@ -922,7 +961,8 @@ If optional argument IF-EXISTS is nil, load on demand. (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) @@ -941,7 +981,7 @@ If optional argument IF-EXISTS is nil, load on demand. "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) @@ -973,7 +1013,7 @@ If optional argument IF-EXISTS is nil, load on demand. append-list delete-list diff) (cons (if (equal in-folder in-db) 0 - (setq diff (elmo-list-diff in-folder in-db nil)) + (setq diff (elmo-list-diff in-folder in-db)) (setq append-list (car diff)) (setq delete-list (cadr diff)) (if append-list @@ -1032,20 +1072,73 @@ 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-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 @@ -1094,7 +1187,6 @@ If optional argument IF-EXISTS is nil, load on demand. same-number) (save-excursion (let* ((messages msgs) - (elmo-inhibit-display-retrieval-progress t) (len (length msgs)) succeeds i result) (if (eq dst-folder 'null) @@ -1103,7 +1195,8 @@ If optional argument IF-EXISTS is nil, load on demand. (error "move: %d is not writable" (elmo-folder-name-internal dst-folder))) (when messages - ;; src is already opened. + (unless (elmo-folder-open-internal-p src-folder) + (elmo-folder-open-internal src-folder)) (elmo-folder-open-internal dst-folder) (unless (setq succeeds (elmo-folder-append-messages dst-folder src-folder @@ -1125,7 +1218,7 @@ If optional argument IF-EXISTS is nil, load on demand. result) (if no-delete (progn - ;; (message "Copying messages...done") +;;; (message "Copying messages...done") t) (if (eq len 0) (message "No message was moved.") @@ -1158,6 +1251,14 @@ If optional argument IF-EXISTS is nil, load on demand. (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." @@ -1177,7 +1278,7 @@ If CACHED is t, message is set as cached.") (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) @@ -1264,14 +1365,16 @@ If optional IS-LOCAL is non-nil, update only local (not server) status." ;; XXX Transitional implementation. (elmo-folder-unset-flag folder (list number) flag is-local)) -(luna-define-generic elmo-message-field (folder number field) +(luna-define-generic elmo-message-field (folder number field &optional type) "Get message field value in the msgdb. FOLDER is the ELMO folder structure. NUMBER is a number of the message. -FIELD is a symbol of the field.") +FIELD is a symbol of the field. +If optional argument TYPE is specified, return converted value.") -(luna-define-method elmo-message-field ((folder elmo-folder) number field) - (elmo-msgdb-message-field (elmo-folder-msgdb folder) number field)) +(luna-define-method elmo-message-field ((folder elmo-folder) + number field &optional type) + (elmo-msgdb-message-field (elmo-folder-msgdb folder) number field type)) (luna-define-generic elmo-message-set-field (folder number field value) "Set message field value in the msgdb. @@ -1356,10 +1459,10 @@ If Optional LOCAL is non-nil, don't update server flag." ;; 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." @@ -1389,20 +1492,22 @@ If Optional LOCAL is non-nil, don't update server flag." (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 @@ -1425,6 +1530,7 @@ If Optional LOCAL is non-nil, don't update server flag." unread section) (with-temp-buffer + (set-buffer-multibyte nil) (when (elmo-message-fetch folder number strategy unread section) (buffer-string)))) @@ -1486,6 +1592,23 @@ If Optional LOCAL is non-nil, don't update server flag." 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 @@ -1538,17 +1661,18 @@ If update process is interrupted, return nil.") (elmo-list-diff (elmo-folder-list-messages folder) (elmo-folder-list-messages folder nil 'in-msgdb))) (when diff-new + (setq diff-new (sort diff-new #'<)) (unless disable-killed (setq diff-new (elmo-living-messages diff-new killed-list))) - (when mask + (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))) (let* ((diff (elmo-list-diff diff-new new-list)) - (disappeared (car diff))) + (disappeared (sort (car diff) #'<))) (when disappeared (elmo-folder-kill-messages-range folder (car disappeared) @@ -1607,7 +1731,8 @@ If update process is interrupted, return nil.") (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)) @@ -1659,8 +1784,8 @@ Return a hashtable for newsgroups." (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) @@ -1679,6 +1804,42 @@ Return a hashtable for 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." @@ -1722,7 +1883,7 @@ Return a hashtable for newsgroups." (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. @@ -1762,6 +1923,13 @@ Return a hashtable for newsgroups." '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