1 ;;; elmo-flag.el --- global flag handling.
3 ;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
29 (require 'elmo-localdir)
30 (eval-when-compile (require 'cl))
33 (defcustom elmo-global-flags '(important)
34 "A list of flag symbol which is managed globally by the flag folder."
35 :type '(repeat symbol)
38 (defcustom elmo-local-flags '(unread any digest)
39 "A list of flag symbol which is not treated as global flag."
40 :type '(repeat symbol)
43 (defvar elmo-global-flag-folder-alist nil
44 "Internal variable to hold global-flag-folder structures.")
47 (defconst elmo-flag-char-regexp "]!#$&'+,./0-9:;<=>?@A-Z[^_`a-z|}~-"))
49 (defun elmo-flag-valid-p (flag)
50 (string-match (eval-when-compile
51 (concat "^[" elmo-flag-char-regexp "]+$"))
52 (if (stringp flag) flag (symbol-name flag))))
55 (luna-define-class elmo-flag-folder (elmo-localdir-folder)
56 (flag minfo minfo-hash max-number))
57 (luna-define-internal-accessors 'elmo-flag-folder))
59 (luna-define-method elmo-folder-initialize ((folder
62 (unless (string-match (eval-when-compile
63 (concat "^flag\\(/\\(["
67 (error "Error in folder name `%s'" (elmo-folder-name-internal folder)))
68 (if (match-beginning 1)
69 (setq name (match-string 2 name))
70 (setq name (symbol-name (car elmo-global-flags)))
71 (elmo-folder-set-name-internal
73 (concat (elmo-folder-name-internal folder) "/" name)))
74 (or (cdr (assq (intern name) elmo-global-flag-folder-alist))
75 (let ((flag (intern name))
77 (elmo-flag-folder-set-flag-internal folder flag)
78 (unless (elmo-global-flag-p flag)
79 (setq elmo-global-flags
80 (nconc elmo-global-flags (list flag))))
81 ;; must be AFTER set flag slot.
82 (setq msgdb-path (elmo-folder-msgdb-path folder))
83 (unless (file-directory-p msgdb-path)
84 (elmo-make-directory msgdb-path))
85 (elmo-localdir-folder-set-dir-name-internal
88 (elmo-localdir-folder-set-directory-internal
91 (if (file-exists-p (expand-file-name "max" msgdb-path))
92 (elmo-flag-folder-set-max-number-internal
94 (elmo-object-load (expand-file-name "max" msgdb-path))))
95 (elmo-flag-folder-set-minfo
97 (and (file-exists-p (expand-file-name ".minfo" msgdb-path))
98 (elmo-object-load (expand-file-name ".minfo" msgdb-path))))
99 (setq elmo-global-flag-folder-alist
100 (cons (cons flag folder) elmo-global-flag-folder-alist))
103 (defun elmo-flag-folder-set-minfo (folder minfo)
104 (let ((hash (elmo-make-hash (length minfo))))
106 (elmo-set-hash-val (nth 1 elem) elem hash)
107 (elmo-set-hash-val (concat "#" (number-to-string (nth 2 elem)))
109 (dolist (pair (car elem))
110 (elmo-set-hash-val (concat (number-to-string (cdr pair))
113 (elmo-flag-folder-set-minfo-internal folder minfo)
114 (elmo-flag-folder-set-minfo-hash-internal folder hash)))
116 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-flag-folder))
117 (expand-file-name (concat "flag/"
118 (elmo-replace-string-as-filename
120 (elmo-flag-folder-flag-internal folder))))
121 elmo-msgdb-directory))
123 (luna-define-method elmo-folder-commit :after ((folder
126 (expand-file-name ".minfo" (elmo-folder-msgdb-path folder))
127 (elmo-flag-folder-minfo-internal folder)
129 (if (elmo-flag-folder-max-number-internal folder)
131 (expand-file-name "max" (elmo-folder-msgdb-path folder))
132 (elmo-flag-folder-max-number-internal folder))))
134 (luna-define-method elmo-folder-list-subfolders ((folder elmo-flag-folder)
136 (mapcar (lambda (flag)
138 (elmo-folder-prefix-internal folder)
139 (symbol-name (elmo-folder-type-internal folder))
144 (defun elmo-flag-folder-delete-message (folder number
145 &optional keep-referrer)
146 (let* ((elem (elmo-get-hash-val (concat "#" (number-to-string number))
147 (elmo-flag-folder-minfo-hash-internal
150 (dolist (pair (car elem))
151 (when (and (car pair) (cdr pair))
152 (elmo-clear-hash-val (concat (number-to-string (cdr pair)) ":"
154 (elmo-flag-folder-minfo-hash-internal
156 (unless keep-referrer
157 (setq target-folder (elmo-get-folder (car pair)))
158 (elmo-folder-open target-folder 'load-msgdb)
159 ;; Unset the flag of the original folder.
160 ;; (XXX Should the message-id checked?)
161 (elmo-message-unset-flag target-folder (cdr pair)
162 (elmo-flag-folder-flag-internal folder))
163 (elmo-folder-close target-folder))))
164 (elmo-clear-hash-val (concat "#" (number-to-string number))
165 (elmo-flag-folder-minfo-hash-internal
167 (elmo-clear-hash-val (nth 1 elem) (elmo-flag-folder-minfo-hash-internal
169 (elmo-flag-folder-set-minfo-internal
171 (delq elem (elmo-flag-folder-minfo-internal folder))))
174 (luna-define-method elmo-folder-delete-messages-internal ((folder
177 (dolist (number numbers)
178 (elmo-flag-folder-delete-message folder number)
179 (elmo-localdir-delete-message folder number))
180 (elmo-folder-commit folder)
183 ;; Same as localdir except that the flag is always the flag.
184 (luna-define-method elmo-folder-msgdb-create ((folder elmo-flag-folder)
188 (let ((dir (elmo-localdir-folder-directory-internal folder))
189 (new-msgdb (elmo-make-msgdb))
190 (flags (list (elmo-flag-folder-flag-internal folder)))
192 (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
194 (dolist (number numbers)
195 (when (setq entity (elmo-localdir-msgdb-create-entity
196 new-msgdb dir number))
197 (elmo-msgdb-append-entity new-msgdb entity flags))
198 (elmo-progress-notify 'elmo-folder-msgdb-create)))
201 (defun elmo-folder-append-messages-*-flag (dst-folder
205 (let ((flag (elmo-flag-folder-flag-internal dst-folder)))
206 (dolist (number numbers)
207 (elmo-global-flag-set flag src-folder number
209 src-folder number 'message-id)))
210 (elmo-folder-set-flag src-folder numbers flag))
213 (luna-define-method elmo-folder-append-buffer ((folder elmo-flag-folder)
214 &optional flag number)
215 (error "Cannot append to the flag folder"))
217 (luna-define-method elmo-folder-unset-flag :before ((folder elmo-flag-folder)
221 (when (eq flag (elmo-flag-folder-flag-internal folder))
222 (error "Cannot unset flag `%s' in this folder" flag)))
226 (defmacro elmo-flag-get-folder (flag)
227 "Get the flag folder structure for FLAG."
228 `(when (memq ,flag elmo-global-flags)
229 (elmo-get-folder (concat "'flag/" (symbol-name ,flag)))))
231 (defun elmo-flag-folder-referrer (folder number)
232 "Return a list of referrer message information.
233 Each element is a cons cell like following:
235 FNAME is the name of the folder which the message is contained.
236 NUMBER is the number of the message."
237 (when (eq (elmo-folder-type-internal folder) 'flag)
238 (car (elmo-get-hash-val (concat "#" (number-to-string number))
239 (elmo-flag-folder-minfo-hash-internal
243 (defun elmo-global-flag-p (flag)
244 "Return non-nil when FLAG is global."
245 (memq flag elmo-global-flags))
247 (defun elmo-global-flags (fname number)
248 "Return a list of global flags for the message.
249 FNAME is the name string of the folder.
250 NUMBER is the number of the message."
251 (let ((flag-list elmo-global-flags)
254 (setq folder (elmo-flag-get-folder (car flag-list)))
255 (when (elmo-get-hash-val
256 (concat (number-to-string number) ":" fname)
257 (elmo-flag-folder-minfo-hash-internal folder))
258 (setq matches (cons (elmo-flag-folder-flag-internal folder)
260 (setq flag-list (cdr flag-list)))
263 (defun elmo-folder-list-global-flag-messages (folder flag)
264 "List messages which have global flag.
265 FOLDER is the elmo folder structure.
266 FLAG is the symbol of the flag."
267 (when (elmo-global-flag-p flag)
268 (let ((flag-folder (elmo-flag-get-folder flag))
270 (dolist (elem (elmo-flag-folder-minfo-internal flag-folder))
271 (if (setq number (elmo-message-number folder (nth 1 elem)))
272 (setq result (cons number result))))
276 ;; minfo is a list of following cell.
277 ;; ((((FNAME . NUMBER)...(FNAME . NUMBER)) MESSAGE-ID NUMBER-IN-FLAG-FOLDER)
278 ;; minfo-index is the hash table of above with following indice;
279 (defun elmo-global-flags-set (flags folder number message-id)
280 "Set global flags to the message.
281 FLAGS is a list of symbol of the flag.
282 FOLDER is the elmo folder structure.
283 NUMBER is the message number."
285 (elmo-global-flag-set flag folder number message-id)))
287 (defun elmo-local-flag-p (flag)
288 "Return non-nil when flag is not appropriate for global flag."
289 (memq flag elmo-local-flags))
291 (defsubst elmo-global-flag-set-internal (flag folder number message-id)
292 (when (elmo-local-flag-p flag)
293 (error "Cannot treat `%s' as global flag" flag))
295 (let ((flag-folder (elmo-flag-get-folder flag))
296 filename cache new-file new-number elem)
297 (if (setq elem (elmo-get-hash-val
299 (elmo-flag-folder-minfo-hash-internal
301 ;; Same ID already exists.
302 (when (and folder number
303 (not (member (cons (elmo-folder-name-internal folder)
304 number) (car elem))))
306 (cons (cons (elmo-folder-name-internal folder)
308 (setq new-number (nth 2 elem))
309 (elmo-set-hash-val (concat (number-to-string number)
310 ":" (elmo-folder-name-internal
313 (elmo-flag-folder-minfo-hash-internal
315 ;; Append new element.
316 (elmo-flag-folder-set-max-number-internal
318 (+ (or (elmo-flag-folder-max-number-internal flag-folder)
319 ;; This is the first time.
320 (car (elmo-folder-status flag-folder)))
326 (elmo-flag-folder-max-number-internal flag-folder)))
327 (elmo-localdir-folder-directory-internal flag-folder)))
329 ((setq filename (elmo-message-file-name folder number))
330 (elmo-copy-file filename new-file))
331 ((and (setq cache (elmo-file-cache-get message-id))
332 (eq (elmo-file-cache-status cache) 'entire))
333 (elmo-copy-file (elmo-file-cache-path cache) new-file))
336 (elmo-message-fetch folder number
337 (elmo-make-fetch-strategy 'entire))
338 (write-region-as-binary (point-min) (point-max) new-file nil
340 (elmo-flag-folder-set-minfo-internal
344 (when (and folder number)
345 (list (cons (elmo-folder-name-internal folder)
349 (elmo-flag-folder-minfo-internal flag-folder)))
350 (when (and folder number)
351 (elmo-set-hash-val (concat (number-to-string number)
352 ":" (elmo-folder-name-internal
355 (elmo-flag-folder-minfo-hash-internal
357 (elmo-set-hash-val message-id elem
358 (elmo-flag-folder-minfo-hash-internal
360 (elmo-set-hash-val (concat "#" (number-to-string new-number)) elem
361 (elmo-flag-folder-minfo-hash-internal
363 (elmo-folder-commit flag-folder)
366 (defun elmo-global-flag-set (flag folder number message-id)
367 "Set global flag to the message.
368 FLAG is a symbol of the flag.
369 FOLDER is the elmo folder structure.
370 NUMBER is the message number.
371 MESSAGE-ID is the message-id of the message."
372 (when (elmo-global-flag-p flag)
373 (elmo-global-flag-set-internal flag folder number message-id)))
375 (defun elmo-global-flag-detach (flag folder number &optional delete-if-none)
376 "Detach the message from the global flag.
377 FOLDER is the folder structure.
378 NUMBERS is the message number.
379 If optional DELETE-IF-NONE is non-nil, delete message from flag folder when
380 the message is not flagged in any folder.
381 If DELETE-IF-NONE is a symbol `always',
382 delete message without flagged in other folder."
383 (unless (and (eq (elmo-folder-type-internal folder) 'flag)
384 (eq (elmo-flag-folder-flag-internal folder) flag))
385 (let ((flag-folder (elmo-flag-get-folder flag))
388 (setq key (concat (number-to-string number) ":"
389 (elmo-folder-name-internal folder))
390 elem (elmo-get-hash-val
392 (elmo-flag-folder-minfo-hash-internal flag-folder)))
394 (setcar elem (delete (cons (elmo-folder-name-internal folder)
396 (elmo-clear-hash-val key (elmo-flag-folder-minfo-hash-internal
398 ;; Does not have any referrer, remove.
399 (when (and delete-if-none
400 (or (eq delete-if-none 'always)
402 (elmo-flag-folder-delete-message flag-folder (nth 2 elem)
404 (elmo-localdir-delete-message flag-folder (nth 2 elem))
405 (elmo-folder-commit flag-folder)))))))
407 (defun elmo-global-flag-detach-messages (folder numbers &optional
409 "Detach all messages specified from all global flags.
410 FOLDER is the folder structure.
411 NUMBERS is the message number list.
412 If optional DELETE-IF-NONE is non-nil, delete message from flag folder when
413 the message is not flagged in any folder."
414 (unless (eq (elmo-folder-type-internal folder) 'flag)
415 (dolist (flag elmo-global-flags)
416 (dolist (number numbers)
417 (elmo-global-flag-detach flag folder number delete-if-none)))))
419 (defun elmo-global-flag-replace-referrer (old-folder new-folder)
420 (dolist (flag elmo-global-flags)
421 (let* ((folder (elmo-flag-get-folder flag))
422 (minfo (elmo-flag-folder-minfo-internal folder))
424 (dolist (entry minfo)
425 (let ((pair (assoc old-folder (nth 0 entry))))
427 (setcar pair new-folder)
430 (elmo-flag-folder-set-minfo folder minfo)
431 (elmo-folder-commit folder)))))
433 (defun elmo-get-global-flags (&optional flags ignore-preserved)
435 Return value is a subset of optional argument FLAGS.
436 If FLAGS is `t', all global flags becomes candidates.
437 If optional IGNORE-PRESERVED is non-nil, preserved flags
438 \(answered, cached, new, unread\) are not included."
439 (let ((result (copy-sequence (if (eq flags t)
440 (setq flags elmo-global-flags)
443 (unless (elmo-global-flag-p (car flags))
444 (setq result (delq (car flags) result)))
445 (setq flags (cdr flags)))
446 (when ignore-preserved
447 (dolist (flag elmo-preserved-flags)
448 (setq result (delq flag result))))
451 (defun elmo-global-flags-initialize (&optional additional-flags)
452 (let ((dir (expand-file-name "flag" elmo-msgdb-directory)))
453 (setq elmo-global-flags
460 (and (file-directory-p dir)
462 (intern (elmo-recover-string-from-filename x)))
465 (directory-files dir))))))
468 ;;; To migrate from global mark folder
469 (defvar elmo-global-mark-filename "global-mark"
470 "Obsolete variable. (Just for migration)")
472 (defun elmo-global-mark-migrate ()
473 "Migrate from 'mark to 'flag. For automatic migration."
474 (when (and (file-exists-p (expand-file-name elmo-global-mark-filename
475 elmo-msgdb-directory))
476 (elmo-global-flag-p 'important)
477 (not (file-exists-p (elmo-folder-msgdb-path
478 (elmo-flag-get-folder 'important)))))
479 (elmo-global-mark-upgrade)))
481 (defun elmo-global-mark-upgrade ()
482 "Upgrade old `global-mark' structure."
484 (when (file-exists-p (expand-file-name
485 elmo-global-mark-filename elmo-msgdb-directory))
486 (message "Upgrading flag structure...")
487 (when (elmo-global-flag-p 'important)
491 elmo-global-mark-filename elmo-msgdb-directory)))
492 (folder (elmo-flag-get-folder 'important))
494 (dolist (elem global-marks)
495 (setq file-cache (elmo-file-cache-get (car elem)))
496 (when (eq (elmo-file-cache-status file-cache) 'entire)
497 (elmo-global-flag-set 'important nil nil (car elem))))))
498 (message "Upgrading flag structure...done")))
500 (luna-define-method elmo-folder-delete :around ((folder elmo-flag-folder))
501 (let ((flag (elmo-flag-folder-flag-internal folder)))
502 (when (luna-call-next-method)
503 (setq elmo-global-flags (delq flag elmo-global-flags))
504 (setq elmo-global-flag-folder-alist
505 (delq (assq flag elmo-global-flag-folder-alist)
506 elmo-global-flag-folder-alist))
510 (product-provide (provide 'elmo-flag) (require 'elmo-version))
512 ;;; elmo-flag.el ends here