;;; Commentary:
;;
+
+;;; Code:
(require 'elmo-util)
(require 'elmo-localdir)
(eval-when-compile (require 'cl))
-;;; Code:
(defcustom elmo-global-flags '(important)
"A list of flag symbol which is managed globally by the flag folder."
:type '(repeat symbol)
(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))
(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)
(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
1))
(setq new-file
(expand-file-name
- (int-to-string
+ (number-to-string
(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))
- (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
(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.
elmo-global-flags
additional-flags
(and (file-directory-p dir)
- (mapcar 'intern
+ (mapcar (lambda (x)
+ (intern (elmo-recover-string-from-filename x)))
(elmo-list-delete
'(".." ".")
(directory-files dir))))))
projects / elisp / wanderlust.git / blobdiff