(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
(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
name)
(if (string-match "flag/\\([a-z]+\\)" name)
(setq name (match-string 1 name))
- (setq name (symbol-name (car elmo-global-flag-list))))
+ (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)
(elmo-localdir-folder-set-directory-internal
folder
msgdb-path)
+ (if (file-exists-p (expand-file-name "max" msgdb-path))
+ (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
elem
(elmo-flag-folder-minfo-hash-internal folder))))
(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)))
(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-flag-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))
+ (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-flags)))))
(defun elmo-flag-folder-delete-message (folder number
&optional keep-referrer)
(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))
src-folder
number
'message-id)))
+ (elmo-folder-set-flag src-folder
+ numbers
+ (elmo-flag-folder-flag-internal folder))
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"))
;;; Utilities
(defmacro elmo-flag-get-folder (flag)
"Get the flag folder structure for FLAG."
- `(when (memq ,flag elmo-global-flag-list)
+ `(when (memq ,flag elmo-global-flags)
(elmo-make-folder (concat "'flag/" (symbol-name ,flag)))))
(defun elmo-flag-folder-referrer (folder number)
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)))
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)))
;;;
(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)
(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 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-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))
+
;;; 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."
- (elmo-global-flag-initialize)
(when (and (file-exists-p (expand-file-name elmo-global-mark-filename
elmo-msgdb-directory))
(elmo-global-flag-p 'important)
(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
(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))
+ t)))
+
(require 'product)
(product-provide (provide 'elmo-flag) (require 'elmo-version))