X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-flag.el;h=b7e4e7163cb903913e3b50d093f2c39796171a16;hb=4859025578bfb97612b900fb35fbf68313f7e1b0;hp=662ba04fe57c6c723f2291beeeec9d18590862d6;hpb=0a4f27eec0a2e5035d6bb853a62dd7631ea8cb2a;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-flag.el b/elmo/elmo-flag.el index 662ba04..b7e4e71 100644 --- a/elmo/elmo-flag.el +++ b/elmo/elmo-flag.el @@ -25,33 +25,60 @@ ;;; 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))) (or (cdr (assq (intern name) elmo-global-flag-folder-alist)) - (let (msgdb-path) - (elmo-flag-folder-set-flag-internal folder (intern name)) + (let ((flag (intern name)) + msgdb-path) + (elmo-flag-folder-set-flag-internal folder flag) + (unless (elmo-global-flag-p 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) @@ -62,39 +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 (intern name) folder) 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) + (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) @@ -104,18 +150,18 @@ target-folder key) (dolist (pair (car elem)) (when (and (car pair) (cdr pair)) + (elmo-clear-hash-val (concat (number-to-string (cdr pair)) ":" + (car pair)) + (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?) (elmo-message-unset-flag target-folder (cdr pair) (elmo-flag-folder-flag-internal folder)) - (elmo-folder-close target-folder)) - (elmo-clear-hash-val (concat (number-to-string (cdr pair)) ":" - (car pair)) - (elmo-flag-folder-minfo-hash-internal - folder)))) + (elmo-folder-close target-folder)))) (elmo-clear-hash-val (concat "#" (number-to-string number)) (elmo-flag-folder-minfo-hash-internal folder)) @@ -126,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)) @@ -142,47 +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))) +(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) - unread - &optional number) + &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. @@ -196,25 +241,15 @@ NUMBER is the number of the message." folder))))) ;;; Global-Flag API -(defun elmo-global-flag-initialize () - "Initialize flag folders. -This function is necessary to be called before using `elmo-flag-folder'." - (unless elmo-global-flag-folder-alist - (dolist (flag elmo-global-flag-list) - (setq elmo-global-flag-folder-alist - (cons (elmo-make-folder - (concat "'flag/" (symbol-name flag))) - elmo-global-flag-folder-alist))))) - (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))) @@ -232,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))) ;;; @@ -251,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 @@ -274,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 @@ -330,8 +378,11 @@ MESSAGE-ID is the message-id of the message." FOLDER is the folder structure. NUMBERS is the message number. 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) +the message is not flagged in any folder. +If DELETE-IF-NONE is a symbol `always', +delete message without flagged in other folder." + (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 @@ -346,8 +397,11 @@ the message is not flagged in any folder." (elmo-clear-hash-val key (elmo-flag-folder-minfo-hash-internal flag-folder)) ;; Does not have any referrer, remove. - (when (and delete-if-none (null (car elem))) - (elmo-flag-folder-delete-message flag-folder (nth 2 elem) 'keep) + (when (and delete-if-none + (or (eq delete-if-none 'always) + (null (car elem)))) + (elmo-flag-folder-delete-message flag-folder (nth 2 elem) + (null (car elem))) (elmo-localdir-delete-message flag-folder (nth 2 elem)) (elmo-folder-commit flag-folder))))))) @@ -359,21 +413,78 @@ 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. +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-flags) + flags)))) + (while flags + (unless (elmo-global-flag-p (car flags)) + (setq result (delq (car flags) result))) + (setq flags (cdr flags))) + (when ignore-preserved + (dolist (flag elmo-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)") +(defun elmo-global-mark-migrate () + "Migrate from 'mark to 'flag. For automatic migration." + (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-msgdb-path + (elmo-flag-get-folder 'important))))) + (elmo-global-mark-upgrade))) + (defun elmo-global-mark-upgrade () "Upgrade old `global-mark' structure." (interactive) (when (file-exists-p (expand-file-name elmo-global-mark-filename elmo-msgdb-directory)) (message "Upgrading flag structure...") - (elmo-global-flag-initialize) (when (elmo-global-flag-p 'important) (let ((global-marks (elmo-object-load @@ -387,6 +498,15 @@ the message is not flagged in any folder." (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))