X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo.el;h=5e9787aa9f07416047f30bd331737d784ac689eb;hb=5ee330d2b31a983dbcca7879f7e1b3e93ac3b586;hp=9dcf42e884e4c85687f10e031e914bd12558bc7f;hpb=58eed29a09573026d2997a6facd9bb5049d4e301;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo.el b/elmo/elmo.el index 9dcf42e..5e9787a 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -35,6 +35,7 @@ (require 'elmo-vars) (require 'elmo-util) (require 'elmo-msgdb) +(require 'elmo-signal) (eval-when-compile (require 'cl)) @@ -68,6 +69,12 @@ Otherwise, entire fetching of the message is aborted without confirmation." :type 'boolean :group 'elmo) +(defcustom elmo-msgdb-path-encode-threshold nil + "*Encode msgdb path if its length is longer than this value." + :type '(choice (const :tag "No encode" nil) + number) + :group 'elmo) + (defvar elmo-message-displaying nil "A global switch to indicate message is displaying or not.") @@ -81,8 +88,25 @@ Otherwise, entire fetching of the message is aborted without confirmation." (elmo-define-error 'elmo-authenticate-error "Login failed" 'elmo-open-error) (elmo-define-error 'elmo-imap4-bye-error "IMAP4 session was terminated" 'elmo-open-error) +;; Event declarations +(elmo-define-signal flag-changing (number old-flags new-flags) + "Notify the changing flag of the messages with NUMBER.") + +(elmo-define-signal flag-changed (numbers) + "Notify the change flag of the messages with NUMBERS.") + +(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 + (autoload 'md5 "md5") (autoload 'elmo-dop-queue-flush "elmo-dop") (autoload 'elmo-nntp-post "elmo-nntp") (autoload 'elmo-global-flag-p "elmo-flag") @@ -91,8 +115,10 @@ Otherwise, entire fetching of the message is aborted without confirmation." (autoload 'elmo-global-flag-detach-messages "elmo-flag") (autoload 'elmo-global-flag-set "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. @@ -124,7 +150,7 @@ If a folder name begins with PREFIX, use BACKEND." persistent ; non-nil if persistent. process-duplicates ; read or hide biff ; folder for biff - handlers ; list of event handler. + mime-charset ; charset for encode & decode )) (luna-define-internal-accessors 'elmo-folder)) @@ -137,9 +163,11 @@ If a folder name begins with PREFIX, use BACKEND." (` (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)) @@ -158,10 +186,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). @@ -592,12 +628,6 @@ CACHE-PATH is the cache path to be used as a message cache file." ((folder elmo-folder) &optional visible-only) t) -(defun elmo-folder-encache (folder numbers &optional unread) - "Encache messages in the FOLDER with NUMBERS. -If UNREAD is non-nil, messages are not flaged as read." - (dolist (number numbers) - (elmo-message-encache folder number unread))) - (luna-define-generic elmo-message-encache (folder number &optional read) "Encache message in the FOLDER with NUMBER. If READ is non-nil, message is flaged as read.") @@ -605,15 +635,16 @@ If READ is non-nil, message is flaged as read.") (luna-define-method elmo-message-encache ((folder elmo-folder) number &optional read) (let (path) - (elmo-message-fetch - folder number - (elmo-make-fetch-strategy 'entire - nil ;use-cache - t ;save-cache - (setq path (elmo-file-cache-get-path - (elmo-message-field - folder number 'message-id)))) - nil nil (not read)) + (with-temp-buffer + (elmo-message-fetch + folder number + (elmo-make-fetch-strategy 'entire + nil ;use-cache + t ;save-cache + (setq path (elmo-file-cache-get-path + (elmo-message-field + folder number 'message-id)))) + (not read))) path)) (luna-define-generic elmo-message-fetch-bodystructure (folder number strategy) @@ -621,32 +652,15 @@ If READ is non-nil, message is flaged as read.") (luna-define-generic elmo-message-fetch (folder number strategy &optional - section - outbuf - unread) - "Fetch a message and return as a string. -FOLDER is the ELMO folder structure. -NUMBER is the number of the message in the FOLDER. -STRATEGY is the message fetching strategy. -If optional argument SECTION is specified, only the SECTION of the message -is fetched (if possible). -If second optional argument OUTBUF is specified, fetched message is -inserted to the buffer and returns t if fetch was ended successfully. -If third optional argument UNREAD is non-nil, message is not flaged as read. -Returns non-nil if fetching was succeed.") - -(luna-define-generic elmo-message-fetch-with-cache-process (folder - number strategy - &optional - section - unread) - "Fetch a message into current buffer with cache process. + unread + section) + "Fetch a message into current buffer. FOLDER is the ELMO folder structure. NUMBER is the number of the message in the FOLDER. STRATEGY is the message fetching strategy. -If optional argument SECTION is specified, only the SECTION of the message -is fetched (if possible). -If second optional argument UNREAD is non-nil, message is not flaged as read. +If optional argument UNREAD is non-nil, message is not flaged as read. +If second optional argument SECTION is specified, only the +SECTION of the message is fetched (if possible). Returns non-nil if fetching was succeed.") (luna-define-generic elmo-message-fetch-internal (folder number strategy @@ -771,13 +785,16 @@ 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-msgdb-rename-path folder new-folder))) @@ -795,6 +812,14 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (setq results (elmo-msgdb-search msgdb condition numbers)) (if (listp results) results + (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 ((len (length numbers)) matched) (elmo-with-progress-display (> len elmo-display-progress-threshold) @@ -816,6 +841,22 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (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) @@ -839,11 +880,11 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).") (and cache t) nil cache-path) - nil (current-buffer) t) + 'unread) (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. @@ -978,7 +1019,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 @@ -1076,7 +1117,6 @@ If optional argument IF-EXISTS is nil, load on demand. 'entire t nil (elmo-file-cache-path cache))) (error "Unplugged"))) - nil (current-buffer) 'unread) (> (buffer-size) 0) (elmo-folder-append-buffer @@ -1144,7 +1184,19 @@ If optional argument IF-EXISTS is nil, load on demand. (or (elmo-folder-path-internal folder) (elmo-folder-set-path-internal folder - (elmo-folder-expand-msgdb-path folder)))) + (if (null elmo-msgdb-path-encode-threshold) + (elmo-folder-expand-msgdb-path folder) + (let* ((path (directory-file-name + (elmo-folder-expand-msgdb-path folder))) + (dirname (file-name-nondirectory path))) + (if (<= (length dirname) elmo-msgdb-path-encode-threshold) + path + (require 'md5) + (setq dirname (md5 dirname)) + (when (> (length dirname) elmo-msgdb-path-encode-threshold) + (error "Cannot shrink msgdb path for `%s'" + (elmo-folder-name-internal folder))) + (expand-file-name dirname (file-name-directory path)))))))) (luna-define-generic elmo-message-cached-p (folder number) "Return non-nil if the message is cached.") @@ -1152,6 +1204,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." @@ -1171,7 +1231,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-folder-notify-event folder 'cache-changed 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) @@ -1258,14 +1318,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. @@ -1291,13 +1353,17 @@ VALUE is a value to set.") &optional is-local) (when (elmo-folder-msgdb-internal folder) (dolist (number numbers) - (when (elmo-global-flag-p flag) - (let ((message-id (elmo-message-field folder number 'message-id))) - (elmo-global-flag-set flag folder number message-id))) - (elmo-msgdb-set-flag (elmo-folder-msgdb folder) - number - flag)) - (elmo-folder-notify-event folder 'flag-changed numbers))) + (let ((old-flags (elmo-message-flags folder number))) + (when (elmo-global-flag-p flag) + (let ((message-id (elmo-message-field folder number 'message-id))) + (elmo-global-flag-set flag folder number message-id))) + (elmo-msgdb-set-flag (elmo-folder-msgdb folder) number flag) + (elmo-emit-signal 'flag-changing + folder + number + old-flags + (elmo-message-flags folder number)))) + (elmo-emit-signal 'flag-changed folder numbers))) (defun elmo-message-has-global-flag-p (folder number) "Return non-nil when the message in the FOLDER with NUMBER has global flag." @@ -1331,12 +1397,16 @@ If Optional LOCAL is non-nil, don't update server flag." &optional is-local) (when (elmo-folder-msgdb-internal folder) (dolist (number numbers) - (when (elmo-global-flag-p flag) - (elmo-global-flag-detach flag folder number 'always)) - (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) - number - flag)) - (elmo-folder-notify-event folder 'flag-changed numbers))) + (let ((old-flags (elmo-message-flags folder number))) + (when (elmo-global-flag-p flag) + (elmo-global-flag-detach flag folder number 'always)) + (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) number flag) + (elmo-emit-signal 'flag-changing + folder + number + old-flags + (elmo-message-flags folder number)))) + (elmo-emit-signal 'flag-changed folder numbers))) (luna-define-method elmo-folder-process-crosspost ((folder elmo-folder)) ;; Do nothing. @@ -1375,13 +1445,15 @@ 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 @@ -1406,32 +1478,21 @@ If Optional LOCAL is non-nil, don't update server flag." number strategy) nil) +(defun elmo-message-fetch-string (folder number strategy + &optional + unread + section) + (with-temp-buffer + (set-buffer-multibyte nil) + (when (elmo-message-fetch folder number strategy unread section) + (buffer-string)))) + (luna-define-method elmo-message-fetch ((folder elmo-folder) number strategy &optional - section - outbuf - unread) - (let (result) - (prog1 - (if outbuf - (with-current-buffer outbuf - (erase-buffer) - (setq result (elmo-message-fetch-with-cache-process - folder number strategy section unread))) - (with-temp-buffer - (setq result (elmo-message-fetch-with-cache-process - folder number strategy section unread)) - (buffer-string))) - (when (and result - (not unread) - (elmo-message-flagged-p folder number 'unread)) - (elmo-message-unset-flag folder number 'unread 'local))))) - -(luna-define-method elmo-message-fetch-with-cache-process ((folder elmo-folder) - number strategy - &optional - section unread) + unread + section) + (erase-buffer) (let ((cache-path (elmo-fetch-strategy-cache-path strategy)) (method-priorities (cond ((eq (elmo-fetch-strategy-use-cache strategy) 'maybe) @@ -1440,28 +1501,33 @@ If Optional LOCAL is non-nil, don't update server flag." '(cache entity)) (t '(entity)))) - result err) + result err updated-server-flag) (while (and method-priorities - (null result)) + (not result)) (setq result (case (car method-priorities) (cache (elmo-file-cache-load cache-path section)) (entity - (when (and (condition-case error - (elmo-message-fetch-internal folder number - strategy - section - unread) - (error (setq err error) nil)) - (> (buffer-size) 0)) + (when (condition-case error + (elmo-message-fetch-internal folder number + strategy + section + unread) + (error (setq err error) nil)) + (setq updated-server-flag t) (when (and (elmo-fetch-strategy-save-cache strategy) cache-path) (elmo-file-cache-save cache-path section)) t))) method-priorities (cdr method-priorities))) - (or result - (and err (signal (car err) (cdr err)))))) + (if result + (when (and (not unread) + (elmo-message-flagged-p folder number 'unread)) + (elmo-message-unset-flag folder number 'unread updated-server-flag)) + (when err + (signal (car err) (cdr err)))) + result)) (defun elmo-folder-kill-messages-range (folder beg end) (elmo-folder-set-killed-list-internal @@ -1479,6 +1545,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 @@ -1531,17 +1614,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) @@ -1600,7 +1684,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)) @@ -1672,32 +1757,41 @@ Return a hashtable for newsgroups." (elmo-make-directory temp-dir) temp-dir)) -;; Event notification/observer framework -(eval-and-compile - (luna-define-class elmo-event-handler ())) +;; 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)) -(luna-define-generic elmo-event-handler-flag-changed (handler numbers) - "Notify flag of the messages with NUMBERS is changed.") +(defmacro elmo-message-status-folder (status) + `(aref ,status 0)) -(luna-define-generic elmo-event-handler-cache-changed (handler number) - "Called when cache status of the message with NUMBER is changed.") +(defmacro elmo-message-status-number (status) + `(aref ,status 1)) -(defun elmo-folder-add-handler (folder handler) - (unless (memq handler (elmo-folder-handlers-internal folder)) - (elmo-folder-set-handlers-internal - folder - (cons handler (elmo-folder-handlers-internal folder))))) +(defmacro elmo-message-status-set-flags (status flags) + `(aset ,status 2 (or ,flags '(read)))) -(defun elmo-folder-remove-handler (folder handler) - (elmo-folder-set-handlers-internal - folder - (delq handler (elmo-folder-handlers-internal folder)))) +(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))) -(defun elmo-folder-notify-event (folder event &rest args) - (when (elmo-folder-handlers-internal folder) - (let ((message (format "elmo-event-handler-%s" event))) - (dolist (handler (elmo-folder-handlers-internal folder)) - (apply #'luna-send handler message handler args))))) +(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 () @@ -1742,7 +1836,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. @@ -1782,6 +1876,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