X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-flag.el;h=b7e4e7163cb903913e3b50d093f2c39796171a16;hb=93025ed9d6792ef40793910e2a2b7ac46029b5cb;hp=13c71f2fe7de767cf381e2b0a3130535a6679592;hpb=32ac1acbf55fe280df031e13eb8f551234d442dc;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-flag.el b/elmo/elmo-flag.el index 13c71f2..b7e4e71 100644 --- a/elmo/elmo-flag.el +++ b/elmo/elmo-flag.el @@ -25,30 +25,50 @@ ;;; 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)) + (flag minfo minfo-hash max-number)) (luna-define-internal-accessors 'elmo-flag-folder)) (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) @@ -69,53 +89,58 @@ (elmo-localdir-folder-set-directory-internal folder msgdb-path) - (if (file-exists-p (expand-file-name ".minfo" msgdb-path)) - (elmo-flag-folder-set-minfo-internal + (if (file-exists-p (expand-file-name "max" msgdb-path)) + (elmo-flag-folder-set-max-number-internal folder - (elmo-object-load (expand-file-name ".minfo" msgdb-path)))) - (elmo-flag-folder-set-minfo-hash-internal + (elmo-object-load (expand-file-name "max" msgdb-path)))) + (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)) + (elmo-flag-folder-max-number-internal folder)))) (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) @@ -130,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?) @@ -147,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)) @@ -163,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. @@ -221,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))) @@ -245,11 +267,10 @@ FOLDER is the elmo folder structure. FLAG is the symbol of the flag." (when (elmo-global-flag-p flag) (let ((flag-folder (elmo-flag-get-folder flag)) - result entity) + result number) (dolist (elem (elmo-flag-folder-minfo-internal flag-folder)) - (if (setq entity (elmo-message-entity folder (nth 1 elem))) - (setq result (cons (elmo-message-entity-number entity) - result)))) + (if (setq number (elmo-message-number folder (nth 1 elem))) + (setq result (cons number result)))) result))) ;;; @@ -264,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 @@ -287,22 +314,30 @@ NUMBER is the message number." (elmo-flag-folder-minfo-hash-internal flag-folder))) ;; Append new element. + (elmo-flag-folder-set-max-number-internal + flag-folder + (+ (or (elmo-flag-folder-max-number-internal flag-folder) + ;; This is the first time. + (car (elmo-folder-status flag-folder))) + 1)) (setq new-file (expand-file-name (int-to-string - (setq new-number (1+ (car (elmo-folder-status flag-folder))))) + (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 @@ -346,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 @@ -377,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. @@ -388,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)) @@ -399,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)") @@ -408,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))) @@ -431,6 +498,15 @@ If optional IGNORE-PRESERVED is non-nil, preserved flags (elmo-global-flag-set 'important nil nil (car elem)))))) (message "Upgrading flag structure...done"))) +(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-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) (product-provide (provide 'elmo-flag) (require 'elmo-version))