X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-flag.el;h=b7e4e7163cb903913e3b50d093f2c39796171a16;hb=93025ed9d6792ef40793910e2a2b7ac46029b5cb;hp=3cbc30b7022269bc87366e72d87eabcea7b63cad;hpb=959e923132dcd06b6a517440aa8c251e5961941c;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-flag.el b/elmo/elmo-flag.el index 3cbc30b..b7e4e71 100644 --- a/elmo/elmo-flag.el +++ b/elmo/elmo-flag.el @@ -25,20 +25,34 @@ ;;; Commentary: ;; + +;;; Code: (require 'elmo-util) (require 'elmo-localdir) (eval-when-compile (require 'cl)) -;;; Code: -(defcustom elmo-global-flag-list '(important) +(defcustom elmo-global-flags '(important) "A list of flag symbol which is managed globally by the flag folder." :type '(repeat symbol) :group 'elmo) +(defcustom elmo-local-flags '(unread any digest) + "A list of flag symbol which is not treated as global flag." + :type '(repeat symbol) + :group 'elmo) + (defvar elmo-global-flag-folder-alist nil "Internal variable to hold global-flag-folder structures.") (eval-and-compile + (defconst elmo-flag-char-regexp "]!#$&'+,./0-9:;<=>?@A-Z[^_`a-z|}~-")) + +(defun elmo-flag-valid-p (flag) + (string-match (eval-when-compile + (concat "^[" elmo-flag-char-regexp "]+$")) + (if (stringp flag) flag (symbol-name flag)))) + +(eval-and-compile (luna-define-class elmo-flag-folder (elmo-localdir-folder) (flag minfo minfo-hash max-number)) (luna-define-internal-accessors 'elmo-flag-folder)) @@ -46,9 +60,15 @@ (luna-define-method elmo-folder-initialize ((folder elmo-flag-folder) name) - (if (string-match "flag/\\([a-z]+\\)" name) - (setq name (match-string 1 name)) - (setq name (symbol-name (car elmo-global-flag-list))) + (unless (string-match (eval-when-compile + (concat "^flag\\(/\\([" + elmo-flag-char-regexp + "]+\\)\\)?$")) + name) + (error "Error in folder name `%s'" (elmo-folder-name-internal folder))) + (if (match-beginning 1) + (setq name (match-string 2 name)) + (setq name (symbol-name (car elmo-global-flags))) (elmo-folder-set-name-internal folder (concat (elmo-folder-name-internal folder) "/" name))) @@ -57,8 +77,8 @@ msgdb-path) (elmo-flag-folder-set-flag-internal folder flag) (unless (elmo-global-flag-p flag) - (setq elmo-global-flag-list - (nconc elmo-global-flag-list (list flag)))) + (setq elmo-global-flags + (nconc elmo-global-flags (list flag)))) ;; must be AFTER set flag slot. (setq msgdb-path (elmo-folder-msgdb-path folder)) (unless (file-directory-p msgdb-path) @@ -73,39 +93,40 @@ (elmo-flag-folder-set-max-number-internal folder (elmo-object-load (expand-file-name "max" msgdb-path)))) - (if (file-exists-p (expand-file-name ".minfo" msgdb-path)) - (elmo-flag-folder-set-minfo-internal - folder - (elmo-object-load (expand-file-name ".minfo" msgdb-path)))) - (elmo-flag-folder-set-minfo-hash-internal + (elmo-flag-folder-set-minfo folder - (elmo-make-hash (length (elmo-flag-folder-minfo-internal folder)))) - (dolist (elem (elmo-flag-folder-minfo-internal folder)) - (elmo-set-hash-val (nth 1 elem) elem - (elmo-flag-folder-minfo-hash-internal folder)) - (elmo-set-hash-val (concat "#" (number-to-string (nth 2 elem))) - elem - (elmo-flag-folder-minfo-hash-internal folder)) - (dolist (pair (car elem)) - (elmo-set-hash-val (concat (number-to-string (cdr pair)) - ":" (car pair)) - elem - (elmo-flag-folder-minfo-hash-internal folder)))) + (and (file-exists-p (expand-file-name ".minfo" msgdb-path)) + (elmo-object-load (expand-file-name ".minfo" msgdb-path)))) (setq elmo-global-flag-folder-alist (cons (cons flag folder) elmo-global-flag-folder-alist)) folder))) +(defun elmo-flag-folder-set-minfo (folder minfo) + (let ((hash (elmo-make-hash (length minfo)))) + (dolist (elem minfo) + (elmo-set-hash-val (nth 1 elem) elem hash) + (elmo-set-hash-val (concat "#" (number-to-string (nth 2 elem))) + elem hash) + (dolist (pair (car elem)) + (elmo-set-hash-val (concat (number-to-string (cdr pair)) + ":" (car pair)) + elem hash))) + (elmo-flag-folder-set-minfo-internal folder minfo) + (elmo-flag-folder-set-minfo-hash-internal folder hash))) + (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-flag-folder)) (expand-file-name (concat "flag/" - (symbol-name - (elmo-flag-folder-flag-internal folder))) + (elmo-replace-string-as-filename + (symbol-name + (elmo-flag-folder-flag-internal folder)))) elmo-msgdb-directory)) (luna-define-method elmo-folder-commit :after ((folder elmo-flag-folder)) (elmo-object-save (expand-file-name ".minfo" (elmo-folder-msgdb-path folder)) - (elmo-flag-folder-minfo-internal folder)) + (elmo-flag-folder-minfo-internal folder) + elmo-mime-charset) (if (elmo-flag-folder-max-number-internal folder) (elmo-object-save (expand-file-name "max" (elmo-folder-msgdb-path folder)) @@ -113,17 +134,13 @@ (luna-define-method elmo-folder-list-subfolders ((folder elmo-flag-folder) &optional one-level) - (let ((dir (expand-file-name "flag" elmo-msgdb-directory))) - (mapcar (lambda (flag) - (concat - (elmo-folder-prefix-internal folder) - (symbol-name (elmo-folder-type-internal folder)) - "/" - (symbol-name flag))) - (elmo-uniq-list - (append - (mapcar 'intern (delete ".." (delete "." (directory-files dir)))) - elmo-global-flag-list))))) + (mapcar (lambda (flag) + (concat + (elmo-folder-prefix-internal folder) + (symbol-name (elmo-folder-type-internal folder)) + "/" + (symbol-name flag))) + elmo-global-flags)) (defun elmo-flag-folder-delete-message (folder number &optional keep-referrer) @@ -138,7 +155,7 @@ (elmo-flag-folder-minfo-hash-internal folder)) (unless keep-referrer - (setq target-folder (elmo-make-folder (car pair))) + (setq target-folder (elmo-get-folder (car pair))) (elmo-folder-open target-folder 'load-msgdb) ;; Unset the flag of the original folder. ;; (XXX Should the message-id checked?) @@ -155,9 +172,9 @@ (delq elem (elmo-flag-folder-minfo-internal folder)))) t) -(luna-define-method elmo-folder-delete-messages ((folder - elmo-flag-folder) - numbers) +(luna-define-method elmo-folder-delete-messages-internal ((folder + elmo-flag-folder) + numbers) (dolist (number numbers) (elmo-flag-folder-delete-message folder number) (elmo-localdir-delete-message folder number)) @@ -171,49 +188,46 @@ (when numbers (let ((dir (elmo-localdir-folder-directory-internal folder)) (new-msgdb (elmo-make-msgdb)) - entity (i 0) - (len (length numbers))) - (message "Creating msgdb...") - (while numbers - (when (setq entity (elmo-localdir-msgdb-create-entity - new-msgdb dir (car numbers))) - (elmo-msgdb-append-entity new-msgdb entity - (list (elmo-flag-folder-flag-internal - folder)))) - (when (> len elmo-display-progress-threshold) - (setq i (1+ i)) - (elmo-display-progress - 'elmo-flag-folder-msgdb-create "Creating msgdb..." - (/ (* i 100) len))) - (setq numbers (cdr numbers))) - (message "Creating msgdb...done") + (flags (list (elmo-flag-folder-flag-internal folder))) + entity) + (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers)) + "Creating msgdb" + (dolist (number numbers) + (when (setq entity (elmo-localdir-msgdb-create-entity + new-msgdb dir number)) + (elmo-msgdb-append-entity new-msgdb entity flags)) + (elmo-progress-notify 'elmo-folder-msgdb-create))) 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) &optional flag number) (error "Cannot append to the flag folder")) +(luna-define-method elmo-folder-unset-flag :before ((folder elmo-flag-folder) + numbers + flag + &optional is-local) + (when (eq flag (elmo-flag-folder-flag-internal folder)) + (error "Cannot unset flag `%s' in this folder" flag))) + ;;; Utilities (defmacro elmo-flag-get-folder (flag) "Get the flag folder structure for FLAG." - `(when (memq ,flag elmo-global-flag-list) - (elmo-make-folder (concat "'flag/" (symbol-name ,flag))))) + `(when (memq ,flag elmo-global-flags) + (elmo-get-folder (concat "'flag/" (symbol-name ,flag))))) (defun elmo-flag-folder-referrer (folder number) "Return a list of referrer message information. @@ -229,13 +243,13 @@ NUMBER is the number of the message." ;;; Global-Flag API (defun elmo-global-flag-p (flag) "Return non-nil when FLAG is global." - (memq flag elmo-global-flag-list)) + (memq flag elmo-global-flags)) (defun elmo-global-flags (fname number) "Return a list of global flags for the message. FNAME is the name string of the folder. NUMBER is the number of the message." - (let ((flag-list elmo-global-flag-list) + (let ((flag-list elmo-global-flags) folder matches) (while flag-list (setq folder (elmo-flag-get-folder (car flag-list))) @@ -271,10 +285,16 @@ NUMBER is the message number." (dolist (flag flags) (elmo-global-flag-set flag folder number message-id))) +(defun elmo-local-flag-p (flag) + "Return non-nil when flag is not appropriate for global flag." + (memq flag elmo-local-flags)) + (defsubst elmo-global-flag-set-internal (flag folder number message-id) + (when (elmo-local-flag-p flag) + (error "Cannot treat `%s' as global flag" flag)) (when message-id (let ((flag-folder (elmo-flag-get-folder flag)) - cache new-file new-number elem) + filename cache new-file new-number elem) (if (setq elem (elmo-get-hash-val message-id (elmo-flag-folder-minfo-hash-internal @@ -306,17 +326,18 @@ NUMBER is the message number." (setq new-number (elmo-flag-folder-max-number-internal flag-folder))) (elmo-localdir-folder-directory-internal flag-folder))) - (with-temp-buffer - (setq cache (and message-id (elmo-file-cache-get message-id))) - (if (and cache (eq (elmo-file-cache-status cache) 'entire)) - (elmo-copy-file (elmo-file-cache-path cache) - new-file) - (when (and folder number) - (elmo-message-fetch folder number (elmo-make-fetch-strategy - 'entire) - nil (current-buffer)) - (write-region-as-binary (point-min) (point-max) new-file nil - 'no-msg)))) + (cond + ((setq filename (elmo-message-file-name folder number)) + (elmo-copy-file filename new-file)) + ((and (setq cache (elmo-file-cache-get message-id)) + (eq (elmo-file-cache-status cache) 'entire)) + (elmo-copy-file (elmo-file-cache-path cache) new-file)) + (t + (with-temp-buffer + (elmo-message-fetch folder number + (elmo-make-fetch-strategy 'entire)) + (write-region-as-binary (point-min) (point-max) new-file nil + 'no-msg)))) (elmo-flag-folder-set-minfo-internal flag-folder (cons @@ -360,7 +381,8 @@ If optional DELETE-IF-NONE is non-nil, delete message from flag folder when the message is not flagged in any folder. If DELETE-IF-NONE is a symbol `always', delete message without flagged in other folder." - (unless (eq (elmo-folder-type-internal folder) 'flag) + (unless (and (eq (elmo-folder-type-internal folder) 'flag) + (eq (elmo-flag-folder-flag-internal folder) flag)) (let ((flag-folder (elmo-flag-get-folder flag)) elem key) (when flag-folder @@ -391,10 +413,24 @@ NUMBERS is the message number list. If optional DELETE-IF-NONE is non-nil, delete message from flag folder when the message is not flagged in any folder." (unless (eq (elmo-folder-type-internal folder) 'flag) - (dolist (flag elmo-global-flag-list) + (dolist (flag elmo-global-flags) (dolist (number numbers) (elmo-global-flag-detach flag folder number delete-if-none))))) +(defun elmo-global-flag-replace-referrer (old-folder new-folder) + (dolist (flag elmo-global-flags) + (let* ((folder (elmo-flag-get-folder flag)) + (minfo (elmo-flag-folder-minfo-internal folder)) + modified) + (dolist (entry minfo) + (let ((pair (assoc old-folder (nth 0 entry)))) + (when pair + (setcar pair new-folder) + (setq modified t)))) + (when modified + (elmo-flag-folder-set-minfo folder minfo) + (elmo-folder-commit folder))))) + (defun elmo-get-global-flags (&optional flags ignore-preserved) "Get global flags. Return value is a subset of optional argument FLAGS. @@ -402,7 +438,7 @@ If FLAGS is `t', all global flags becomes candidates. If optional IGNORE-PRESERVED is non-nil, preserved flags \(answered, cached, new, unread\) are not included." (let ((result (copy-sequence (if (eq flags t) - (setq flags elmo-global-flag-list) + (setq flags elmo-global-flags) flags)))) (while flags (unless (elmo-global-flag-p (car flags)) @@ -413,6 +449,23 @@ If optional IGNORE-PRESERVED is non-nil, preserved flags (setq result (delq flag result)))) result)) +(defun elmo-global-flags-initialize (&optional additional-flags) + (let ((dir (expand-file-name "flag" elmo-msgdb-directory))) + (setq elmo-global-flags + (elmo-list-delete + elmo-local-flags + (elmo-uniq-list + (append + elmo-global-flags + additional-flags + (and (file-directory-p dir) + (mapcar (lambda (x) + (intern (elmo-recover-string-from-filename x))) + (elmo-list-delete + '(".." ".") + (directory-files dir)))))) + #'delq)))) + ;;; To migrate from global mark folder (defvar elmo-global-mark-filename "global-mark" "Obsolete variable. (Just for migration)") @@ -422,7 +475,7 @@ If optional IGNORE-PRESERVED is non-nil, preserved flags (when (and (file-exists-p (expand-file-name elmo-global-mark-filename elmo-msgdb-directory)) (elmo-global-flag-p 'important) - (not (file-exists-p (elmo-folder-expand-msgdb-path + (not (file-exists-p (elmo-folder-msgdb-path (elmo-flag-get-folder 'important))))) (elmo-global-mark-upgrade))) @@ -448,7 +501,10 @@ If optional IGNORE-PRESERVED is non-nil, preserved flags (luna-define-method elmo-folder-delete :around ((folder elmo-flag-folder)) (let ((flag (elmo-flag-folder-flag-internal folder))) (when (luna-call-next-method) - (setq elmo-global-flag-list (delq flag elmo-global-flag-list)) + (setq elmo-global-flags (delq flag elmo-global-flags)) + (setq elmo-global-flag-folder-alist + (delq (assq flag elmo-global-flag-folder-alist) + elmo-global-flag-folder-alist)) t))) (require 'product)