(elmo-folder-initialize): Complete abbreviated
[elisp/wanderlust.git] / elmo / elmo-flag.el
1 ;;; elmo-flag.el --- global flag handling.
2
3 ;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
4
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
7
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
9
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)
13 ;; any later version.
14 ;;
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.
19 ;;
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.
24 ;;
25
26 ;;; Commentary:
27 ;;
28 (require 'elmo-util)
29 (require 'elmo-localdir)
30 (eval-when-compile (require 'cl))
31
32 ;;; Code:
33 (defcustom elmo-global-flag-list '(important)
34   "A list of flag symbol which is managed globally by the flag folder."
35   :type '(repeat symbol)
36   :group 'elmo)
37
38 (defvar elmo-global-flag-folder-alist nil
39   "Internal variable to hold global-flag-folder structures.")
40
41 (eval-and-compile
42   (luna-define-class elmo-flag-folder (elmo-localdir-folder)
43                      (flag minfo minfo-hash))
44   (luna-define-internal-accessors 'elmo-flag-folder))
45
46 (luna-define-method elmo-folder-initialize ((folder
47                                              elmo-flag-folder)
48                                             name)
49   (if (string-match "flag/\\([a-z]+\\)" name)
50       (setq name (match-string 1 name))
51     (setq name (symbol-name (car elmo-global-flag-list)))
52     (elmo-folder-set-name-internal
53      folder
54      (concat (elmo-folder-name-internal folder) "/" name)))
55   (or (cdr (assq (intern name) elmo-global-flag-folder-alist))
56       (let ((flag (intern name))
57             msgdb-path)
58         (elmo-flag-folder-set-flag-internal folder flag)
59         (unless (elmo-global-flag-p flag)
60           (setq elmo-global-flag-list
61                 (nconc elmo-global-flag-list (list flag))))
62         ;; must be AFTER set flag slot.
63         (setq msgdb-path (elmo-folder-msgdb-path folder))
64         (unless (file-directory-p msgdb-path)
65           (elmo-make-directory msgdb-path))
66         (elmo-localdir-folder-set-dir-name-internal
67          folder
68          msgdb-path)
69         (elmo-localdir-folder-set-directory-internal
70          folder
71          msgdb-path)
72         (if (file-exists-p (expand-file-name ".minfo" msgdb-path))
73             (elmo-flag-folder-set-minfo-internal
74              folder
75              (elmo-object-load (expand-file-name ".minfo" msgdb-path))))
76         (elmo-flag-folder-set-minfo-hash-internal
77          folder
78          (elmo-make-hash (length (elmo-flag-folder-minfo-internal folder))))
79         (dolist (elem (elmo-flag-folder-minfo-internal folder))
80           (elmo-set-hash-val (nth 1 elem) elem
81                              (elmo-flag-folder-minfo-hash-internal folder))
82           (elmo-set-hash-val (concat "#" (number-to-string (nth 2 elem)))
83                              elem
84                              (elmo-flag-folder-minfo-hash-internal folder))
85           (dolist (pair (car elem))
86             (elmo-set-hash-val (concat (number-to-string (cdr pair))
87                                        ":" (car pair))
88                                elem
89                                (elmo-flag-folder-minfo-hash-internal folder))))
90         (setq elmo-global-flag-folder-alist
91               (cons (cons flag folder) elmo-global-flag-folder-alist))
92         folder)))
93
94 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-flag-folder))
95   (expand-file-name (concat "flag/"
96                             (symbol-name
97                              (elmo-flag-folder-flag-internal folder)))
98                     elmo-msgdb-directory))
99
100 (luna-define-method elmo-folder-commit :after ((folder
101                                                 elmo-flag-folder))
102   (elmo-object-save
103    (expand-file-name ".minfo" (elmo-folder-msgdb-path folder))
104    (elmo-flag-folder-minfo-internal folder)))
105
106 (luna-define-method elmo-folder-list-subfolders ((folder elmo-flag-folder)
107                                                  &optional one-level)
108   (mapcar (lambda (flag)
109             (concat
110              (elmo-folder-prefix-internal folder)
111              (symbol-name (elmo-folder-type-internal folder))
112              "/"
113              (symbol-name flag)))
114           elmo-global-flag-list))
115
116 (defun elmo-flag-folder-delete-message (folder number
117                                                &optional keep-referrer)
118   (let* ((elem (elmo-get-hash-val (concat "#" (number-to-string number))
119                                   (elmo-flag-folder-minfo-hash-internal
120                                    folder)))
121          target-folder key)
122     (dolist (pair (car elem))
123       (when (and (car pair) (cdr pair))
124         (elmo-clear-hash-val (concat (number-to-string (cdr pair)) ":"
125                                      (car pair))
126                              (elmo-flag-folder-minfo-hash-internal
127                               folder))
128         (unless keep-referrer
129           (setq target-folder (elmo-make-folder (car pair)))
130           (elmo-folder-open target-folder 'load-msgdb)
131           ;; Unset the flag of the original folder.
132           ;; (XXX Should the message-id checked?)
133           (elmo-message-unset-flag target-folder (cdr pair)
134                                    (elmo-flag-folder-flag-internal folder))
135           (elmo-folder-close target-folder))))
136     (elmo-clear-hash-val (concat "#" (number-to-string number))
137                          (elmo-flag-folder-minfo-hash-internal
138                           folder))
139     (elmo-clear-hash-val (nth 1 elem) (elmo-flag-folder-minfo-hash-internal
140                                        folder))
141     (elmo-flag-folder-set-minfo-internal
142      folder
143      (delq elem (elmo-flag-folder-minfo-internal folder))))
144   t)
145
146 (luna-define-method elmo-folder-delete-messages ((folder
147                                                   elmo-flag-folder)
148                                                  numbers)
149   (dolist (number numbers)
150     (elmo-flag-folder-delete-message folder number)
151     (elmo-localdir-delete-message folder number))
152   (elmo-folder-commit folder)
153   t)
154
155 ;; Same as localdir except that the flag is always the flag.
156 (luna-define-method elmo-folder-msgdb-create ((folder elmo-flag-folder)
157                                               numbers
158                                               flag-table)
159   (when numbers
160     (let ((dir (elmo-localdir-folder-directory-internal folder))
161           (new-msgdb (elmo-make-msgdb))
162           entity (i 0)
163           (len (length numbers)))
164       (message "Creating msgdb...")
165       (while numbers
166         (when (setq entity (elmo-localdir-msgdb-create-entity
167                             new-msgdb dir (car numbers)))
168           (elmo-msgdb-append-entity new-msgdb entity
169                                     (list (elmo-flag-folder-flag-internal
170                                            folder))))
171         (when (> len elmo-display-progress-threshold)
172           (setq i (1+ i))
173           (elmo-display-progress
174            'elmo-flag-folder-msgdb-create "Creating msgdb..."
175            (/ (* i 100) len)))
176         (setq numbers (cdr numbers)))
177       (message "Creating msgdb...done")
178       new-msgdb)))
179
180 (luna-define-method elmo-folder-append-messages ((folder elmo-flag-folder)
181                                                  src-folder
182                                                  numbers
183                                                  &optional same-number)
184   (dolist (number numbers)
185     (elmo-global-flag-set (elmo-flag-folder-flag-internal folder)
186                           src-folder number (elmo-message-field
187                                              src-folder
188                                              number
189                                              'message-id)))
190   (elmo-folder-set-flag src-folder
191                         numbers
192                         (elmo-flag-folder-flag-internal folder))
193   numbers)
194
195 (luna-define-method elmo-folder-append-buffer ((folder elmo-flag-folder)
196                                                unread
197                                                &optional number)
198   (error "Cannot append to the flag folder"))
199
200 ;;; Utilities
201
202 (defmacro elmo-flag-get-folder (flag)
203   "Get the flag folder structure for FLAG."
204   `(when (memq ,flag elmo-global-flag-list)
205      (elmo-make-folder (concat  "'flag/" (symbol-name ,flag)))))
206
207 (defun elmo-flag-folder-referrer (folder number)
208   "Return a list of referrer message information.
209 Each element is a cons cell like following:
210 \(FNAME . NUMBER\)
211 FNAME is the name of the folder which the message is contained.
212 NUMBER is the number of the message."
213   (when (eq (elmo-folder-type-internal folder) 'flag)
214     (car (elmo-get-hash-val (concat "#" (number-to-string number))
215                             (elmo-flag-folder-minfo-hash-internal
216                              folder)))))
217
218 ;;; Global-Flag API
219 (defun elmo-global-flag-p (flag)
220   "Return non-nil when FLAG is global."
221   (memq flag elmo-global-flag-list))
222
223 (defun elmo-global-flags (fname number)
224   "Return a list of global flags for the message.
225 FNAME is the name string of the folder.
226 NUMBER is the number of the message."
227   (let ((flag-list elmo-global-flag-list)
228         folder matches)
229     (while flag-list
230       (setq folder (elmo-flag-get-folder (car flag-list)))
231       (when (elmo-get-hash-val
232              (concat (number-to-string number) ":" fname)
233              (elmo-flag-folder-minfo-hash-internal folder))
234         (setq matches (cons (elmo-flag-folder-flag-internal folder)
235                             matches)))
236       (setq flag-list (cdr flag-list)))
237     matches))
238
239 (defun elmo-folder-list-global-flag-messages (folder flag)
240   "List messages which have global flag.
241 FOLDER is the elmo folder structure.
242 FLAG is the symbol of the flag."
243   (when (elmo-global-flag-p flag)
244     (let ((flag-folder (elmo-flag-get-folder flag))
245           result entity)
246       (dolist (elem (elmo-flag-folder-minfo-internal flag-folder))
247         (if (setq entity (elmo-message-entity folder (nth 1 elem)))
248             (setq result (cons (elmo-message-entity-number entity)
249                                result))))
250       result)))
251
252 ;;;
253 ;; minfo is a list of following cell.
254 ;; ((((FNAME . NUMBER)...(FNAME . NUMBER)) MESSAGE-ID NUMBER-IN-FLAG-FOLDER)
255 ;; minfo-index is the hash table of above with following indice;
256 (defun elmo-global-flags-set (flags folder number message-id)
257   "Set global flags to the message.
258 FLAGS is a list of symbol of the flag.
259 FOLDER is the elmo folder structure.
260 NUMBER is the message number."
261   (dolist (flag flags)
262     (elmo-global-flag-set flag folder number message-id)))
263
264 (defsubst elmo-global-flag-set-internal (flag folder number message-id)
265   (when message-id
266     (let ((flag-folder (elmo-flag-get-folder flag))
267           cache new-file new-number elem)
268       (if (setq elem (elmo-get-hash-val
269                       message-id
270                       (elmo-flag-folder-minfo-hash-internal
271                        flag-folder)))
272           ;; Same ID already exists.
273           (when (and folder number
274                      (not (member (cons (elmo-folder-name-internal folder)
275                                         number) (car elem))))
276             (setcar elem
277                     (cons (cons (elmo-folder-name-internal folder)
278                                 number) (car elem)))
279             (setq new-number (nth 2 elem))
280             (elmo-set-hash-val (concat (number-to-string number)
281                                        ":" (elmo-folder-name-internal
282                                             folder))
283                                elem
284                                (elmo-flag-folder-minfo-hash-internal
285                                 flag-folder)))
286         ;; Append new element.
287         (setq new-file
288               (expand-file-name
289                (int-to-string
290                 (setq new-number (1+ (car (elmo-folder-status flag-folder)))))
291                (elmo-localdir-folder-directory-internal flag-folder)))
292         (with-temp-buffer
293           (setq cache (and message-id (elmo-file-cache-get message-id)))
294           (if (and cache (eq (elmo-file-cache-status cache) 'entire))
295               (elmo-copy-file (elmo-file-cache-path cache)
296                               new-file)
297             (when (and folder number)
298               (elmo-message-fetch folder number (elmo-make-fetch-strategy
299                                                  'entire)
300                                   nil (current-buffer))
301               (write-region-as-binary (point-min) (point-max) new-file nil
302                                       'no-msg))))
303         (elmo-flag-folder-set-minfo-internal
304          flag-folder
305          (cons
306           (setq elem (list
307                       (when (and folder number)
308                         (list (cons (elmo-folder-name-internal folder)
309                                     number)))
310                       message-id
311                       new-number))
312           (elmo-flag-folder-minfo-internal flag-folder)))
313         (when (and folder number)
314           (elmo-set-hash-val (concat (number-to-string number)
315                                      ":" (elmo-folder-name-internal
316                                           folder))
317                              elem
318                              (elmo-flag-folder-minfo-hash-internal
319                               flag-folder)))
320         (elmo-set-hash-val message-id elem
321                            (elmo-flag-folder-minfo-hash-internal
322                             flag-folder))
323         (elmo-set-hash-val (concat "#" (number-to-string new-number)) elem
324                            (elmo-flag-folder-minfo-hash-internal
325                             flag-folder)))
326       (elmo-folder-commit flag-folder)
327       new-number)))
328
329 (defun elmo-global-flag-set (flag folder number message-id)
330   "Set global flag to the message.
331 FLAG is a symbol of the flag.
332 FOLDER is the elmo folder structure.
333 NUMBER is the message number.
334 MESSAGE-ID is the message-id of the message."
335   (when (elmo-global-flag-p flag)
336     (elmo-global-flag-set-internal flag folder number message-id)))
337
338 (defun elmo-global-flag-detach (flag folder number &optional delete-if-none)
339   "Detach the message from the global flag.
340 FOLDER is the folder structure.
341 NUMBERS is the message number.
342 If optional DELETE-IF-NONE is non-nil, delete message from flag folder when
343 the message is not flagged in any folder.
344 If DELETE-IF-NONE is a symbol `always',
345 delete message without flagged in other folder."
346   (unless (eq (elmo-folder-type-internal folder) 'flag)
347     (let ((flag-folder (elmo-flag-get-folder flag))
348           elem key)
349       (when flag-folder
350         (setq key (concat (number-to-string number) ":"
351                           (elmo-folder-name-internal folder))
352               elem (elmo-get-hash-val
353                     key
354                     (elmo-flag-folder-minfo-hash-internal flag-folder)))
355         (when elem
356           (setcar elem (delete (cons (elmo-folder-name-internal folder)
357                                      number) (car elem)))
358           (elmo-clear-hash-val key (elmo-flag-folder-minfo-hash-internal
359                                     flag-folder))
360           ;; Does not have any referrer, remove.
361           (when (and delete-if-none
362                      (or (eq delete-if-none 'always)
363                          (null (car elem))))
364             (elmo-flag-folder-delete-message flag-folder (nth 2 elem)
365                                              (null (car elem)))
366             (elmo-localdir-delete-message flag-folder (nth 2 elem))
367             (elmo-folder-commit flag-folder)))))))
368
369 (defun elmo-global-flag-detach-messages (folder numbers &optional
370                                                 delete-if-none)
371   "Detach all messages specified from all global flags.
372 FOLDER is the folder structure.
373 NUMBERS is the message number list.
374 If optional DELETE-IF-NONE is non-nil, delete message from flag folder when
375 the message is not flagged in any folder."
376   (unless (eq (elmo-folder-type-internal folder) 'flag)
377     (dolist (flag elmo-global-flag-list)
378       (dolist (number numbers)
379         (elmo-global-flag-detach flag folder number delete-if-none)))))
380
381 (defun elmo-get-global-flags (&optional flags ignore-preserved)
382   "Get global flags.
383 Return value is a subset of optional argument FLAGS.
384 If FLAGS is `t', all global flags becomes candidates.
385 If optional IGNORE-PRESERVED is non-nil, preserved flags
386 \(answered, cached, new, unread\) are not included."
387   (let ((result (copy-sequence (if (eq flags t)
388                                    (setq flags elmo-global-flag-list)
389                                  flags))))
390     (while flags
391       (unless (elmo-global-flag-p (car flags))
392         (setq result (delq (car flags) result)))
393       (setq flags (cdr flags)))
394     (when ignore-preserved
395       (dolist (flag '(answered cached new unread))
396         (setq result (delq flag result))))
397     result))
398
399 ;;; To migrate from global mark folder
400 (defvar elmo-global-mark-filename "global-mark"
401   "Obsolete variable. (Just for migration)")
402
403 (defun elmo-global-mark-migrate ()
404   "Migrate from 'mark to 'flag. For automatic migration."
405   (when (and (file-exists-p (expand-file-name elmo-global-mark-filename
406                                               elmo-msgdb-directory))
407              (elmo-global-flag-p 'important)
408              (not (file-exists-p (elmo-folder-expand-msgdb-path
409                                   (elmo-flag-get-folder 'important)))))
410     (elmo-global-mark-upgrade)))
411
412 (defun elmo-global-mark-upgrade ()
413   "Upgrade old `global-mark' structure."
414   (interactive)
415   (when (file-exists-p (expand-file-name
416                         elmo-global-mark-filename elmo-msgdb-directory))
417     (message "Upgrading flag structure...")
418     (when (elmo-global-flag-p 'important)
419       (let ((global-marks
420              (elmo-object-load
421               (expand-file-name
422                elmo-global-mark-filename elmo-msgdb-directory)))
423             (folder (elmo-flag-get-folder 'important))
424             file-cache)
425         (dolist (elem global-marks)
426           (setq file-cache (elmo-file-cache-get (car elem)))
427           (when (eq (elmo-file-cache-status file-cache) 'entire)
428             (elmo-global-flag-set 'important nil nil (car elem))))))
429     (message "Upgrading flag structure...done")))
430
431 (require 'product)
432 (product-provide (provide 'elmo-flag) (require 'elmo-version))
433
434 ;;; elmo-flag.el ends here