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   (or (cdr (assq (intern name) elmo-global-flag-folder-alist))
  53       (progn
  54         (unless (file-directory-p (expand-file-name (concat "flag/" name)
  55                                                 elmo-msgdb-directory))
  56           (elmo-make-directory (expand-file-name (concat "flag/" name)
  57                                                  elmo-msgdb-directory)))
  58         (elmo-localdir-folder-set-dir-name-internal
  59          folder (expand-file-name (concat "flag/" name)
  60                                   elmo-msgdb-directory))
  61         (elmo-localdir-folder-set-directory-internal
  62          folder
  63          (expand-file-name (concat "flag/" name)
  64                            elmo-msgdb-directory))
  65         (if (file-exists-p (expand-file-name
  66                             (concat "flag/" name "/.minfo")
  67                             elmo-msgdb-directory))
  68             (elmo-flag-folder-set-minfo-internal
  69              folder
  70              (elmo-object-load (expand-file-name
  71                                 (concat "flag/" name "/.minfo")
  72                                 elmo-msgdb-directory))))
  73         (elmo-flag-folder-set-minfo-hash-internal
  74          folder
  75          (elmo-make-hash (length (elmo-flag-folder-minfo-internal folder))))
  76         (dolist (elem (elmo-flag-folder-minfo-internal folder))
  77           (elmo-set-hash-val (nth 1 elem) elem
  78                              (elmo-flag-folder-minfo-hash-internal folder))
  79           (elmo-set-hash-val (concat "#" (number-to-string (nth 2 elem)))
  80                              elem
  81                              (elmo-flag-folder-minfo-hash-internal folder))
  82           (dolist (pair (car elem))
  83             (elmo-set-hash-val (concat (number-to-string (cdr pair))
  84                                        ":" (car pair))
  85                                elem
  86                                (elmo-flag-folder-minfo-hash-internal folder))))
  87         (elmo-flag-folder-set-flag-internal folder (intern name))
  88         (setq elmo-global-flag-folder-alist
  89               (cons (cons (intern name) folder) elmo-global-flag-folder-alist))
  90         folder)))
  91
  92 (luna-define-method elmo-folder-commit :after ((folder
  93                                                 elmo-flag-folder))
  94   (elmo-object-save
  95    (expand-file-name (concat "flag/"
  96                              (symbol-name
  97                               (elmo-flag-folder-flag-internal folder))
  98                              "/.minfo") elmo-msgdb-directory)
  99    (elmo-flag-folder-minfo-internal folder)))
 100
 101 (defun elmo-flag-folder-delete-message (folder number
 102                                                &optional keep-referrer)
 103   (let* ((elem (elmo-get-hash-val (concat "#" (number-to-string number))
 104                                   (elmo-flag-folder-minfo-hash-internal
 105                                    folder)))
 106          target-folder key)
 107     (dolist (pair (car elem))
 108       (when (and (car pair) (cdr pair))
 109         (unless keep-referrer
 110           (setq target-folder (elmo-make-folder (car pair)))
 111           (elmo-folder-open target-folder 'load-msgdb)
 112           ;; Unset the flag of the original folder.
 113           ;; (XXX Should the message-id checked?)
 114           (elmo-message-unset-flag target-folder (cdr pair)
 115                                    (elmo-flag-folder-flag-internal folder))
 116           (elmo-folder-close target-folder))
 117         (elmo-clear-hash-val (concat (number-to-string (cdr pair)) ":"
 118                                      (car pair))
 119                              (elmo-flag-folder-minfo-hash-internal
 120                               folder))))
 121     (elmo-clear-hash-val (concat "#" (number-to-string number))
 122                          (elmo-flag-folder-minfo-hash-internal
 123                           folder))
 124     (elmo-clear-hash-val (nth 1 elem) (elmo-flag-folder-minfo-hash-internal
 125                                        folder))
 126     (elmo-flag-folder-set-minfo-internal
 127      folder
 128      (delq elem (elmo-flag-folder-minfo-internal folder))))
 129   t)
 130
 131 (luna-define-method elmo-folder-delete-messages ((folder
 132                                                   elmo-flag-folder)
 133                                                  numbers)
 134   (dolist (number numbers)
 135     (elmo-flag-folder-delete-message folder number)
 136     (elmo-localdir-delete-message folder number))
 137   (elmo-folder-commit folder)
 138   t)
 139
 140 ;; Same as localdir except that the flag is always the flag.
 141 (luna-define-method elmo-folder-msgdb-create ((folder elmo-flag-folder)
 142                                               numbers
 143                                               flag-table)
 144   (when numbers
 145     (let ((dir (elmo-localdir-folder-directory-internal folder))
 146           (new-msgdb (elmo-make-msgdb))
 147           entity (i 0)
 148           (len (length numbers)))
 149       (message "Creating msgdb...")
 150       (while numbers
 151         (when (setq entity (elmo-localdir-msgdb-create-entity
 152                             dir (car numbers)))
 153           (elmo-msgdb-append-entity new-msgdb entity
 154                                     (list (elmo-flag-folder-flag-internal
 155                                            folder))))
 156         (when (> len elmo-display-progress-threshold)
 157           (setq i (1+ i))
 158           (elmo-display-progress
 159            'elmo-flag-folder-msgdb-create "Creating msgdb..."
 160            (/ (* i 100) len)))
 161         (setq numbers (cdr numbers)))
 162       (message "Creating msgdb...done")
 163       new-msgdb)))
 164
 165 (luna-define-method elmo-folder-append-buffer ((folder elmo-flag-folder)
 166                                                unread
 167                                                &optional number)
 168   (error "Cannot append to the flag folder"))
 169
 170 ;;; Utilities
 171
 172 (defmacro elmo-flag-get-folder (flag)
 173   "Get the flag folder structure for FLAG."
 174   `(when (memq ,flag elmo-global-flag-list)
 175      (elmo-make-folder (concat  "'flag/" (symbol-name ,flag)))))
 176
 177 (defun elmo-flag-folder-referrer (folder number)
 178   "Return a list of referrer message information.
 179 Each element is a cons cell like following:
 180 \(FNAME . NUMBER\)
 181 FNAME is the name of the folder which the message is contained.
 182 NUMBER is the number of the message."
 183   (when (eq (elmo-folder-type-internal folder) 'flag)
 184     (car (elmo-get-hash-val (concat "#" (number-to-string number))
 185                             (elmo-flag-folder-minfo-hash-internal
 186                              folder)))))
 187
 188 ;;; Global-Flag API
 189 (defun elmo-global-flag-initialize ()
 190   "Initialize flag folders.
 191 This function is necessary to be called before using `elmo-flag-folder'."
 192   (unless elmo-global-flag-folder-alist
 193     (dolist (flag elmo-global-flag-list)
 194       (setq elmo-global-flag-folder-alist
 195             (cons (elmo-make-folder
 196                    (concat "'flag/" (symbol-name flag)))
 197                   elmo-global-flag-folder-alist)))))
 198
 199 (defun elmo-global-flag-p (flag)
 200   "Return non-nil when FLAG is global."
 201   (memq flag elmo-global-flag-list))
 202
 203 (defun elmo-global-flags (fname number)
 204   "Return a list of global flags for the message.
 205 FNAME is the name string of the folder.
 206 NUMBER is the number of the message."
 207   (let ((flag-list elmo-global-flag-list)
 208         folder matches)
 209     (while flag-list
 210       (setq folder (elmo-flag-get-folder (car flag-list)))
 211       (when (elmo-get-hash-val
 212              (concat (number-to-string number) ":" fname)
 213              (elmo-flag-folder-minfo-hash-internal folder))
 214         (setq matches (cons (elmo-flag-folder-flag-internal folder)
 215                             matches)))
 216       (setq flag-list (cdr flag-list)))
 217     matches))
 218
 219 ;;;
 220 ;; minfo is a list of following cell.
 221 ;; ((((FNAME . NUMBER)...(FNAME . NUMBER)) MESSAGE-ID NUMBER-IN-FLAG-FOLDER)
 222 ;; minfo-index is the hash table of above with following indice;
 223 (defun elmo-global-flags-set (flags folder number message-id)
 224   "Set global flags to the message.
 225 FLAGS is a list of symbol of the flag.
 226 FOLDER is the elmo folder structure.
 227 NUMBER is the message number."
 228   (dolist (flag flags)
 229     (elmo-global-flag-set flag folder number message-id)))
 230
 231 (defsubst elmo-global-flag-set-internal (flag folder number message-id)
 232   (when message-id
 233     (let ((flag-folder (elmo-flag-get-folder flag))
 234           cache new-file new-number elem)
 235       (if (setq elem (elmo-get-hash-val
 236                       message-id
 237                       (elmo-flag-folder-minfo-hash-internal
 238                        flag-folder)))
 239           ;; Same ID already exists.
 240           (when (and folder number
 241                      (not (member (cons (elmo-folder-name-internal folder)
 242                                         number) (car elem))))
 243             (setcar elem
 244                     (cons (cons (elmo-folder-name-internal folder)
 245                                 number) (car elem)))
 246             (setq new-number (nth 2 elem))
 247             (elmo-set-hash-val (concat (number-to-string number)
 248                                        ":" (elmo-folder-name-internal
 249                                             folder))
 250                                elem
 251                                (elmo-flag-folder-minfo-hash-internal
 252                                 flag-folder)))
 253         ;; Append new element.
 254         (setq new-file
 255               (expand-file-name
 256                (int-to-string
 257                 (setq new-number (1+ (car (elmo-folder-status flag-folder)))))
 258                (elmo-localdir-folder-directory-internal flag-folder)))
 259         (with-temp-buffer
 260           (setq cache (and message-id (elmo-file-cache-get message-id)))
 261           (if (and cache (eq (elmo-file-cache-status cache) 'entire))
 262               (elmo-copy-file (elmo-file-cache-path cache)
 263                               new-file)
 264             (when (and folder number)
 265               (elmo-message-fetch folder number (elmo-make-fetch-strategy
 266                                                  'entire)
 267                                   nil (current-buffer))
 268               (write-region-as-binary (point-min) (point-max) new-file nil
 269                                       'no-msg))))
 270         (elmo-flag-folder-set-minfo-internal
 271          flag-folder
 272          (cons
 273           (setq elem (list
 274                       (when (and folder number)
 275                         (list (cons (elmo-folder-name-internal folder)
 276                                     number)))
 277                       message-id
 278                       new-number))
 279           (elmo-flag-folder-minfo-internal flag-folder)))
 280         (when (and folder number)
 281           (elmo-set-hash-val (concat (number-to-string number)
 282                                      ":" (elmo-folder-name-internal
 283                                           folder))
 284                              elem
 285                              (elmo-flag-folder-minfo-hash-internal
 286                               flag-folder)))
 287         (elmo-set-hash-val message-id elem
 288                            (elmo-flag-folder-minfo-hash-internal
 289                             flag-folder))
 290         (elmo-set-hash-val (concat "#" (number-to-string new-number)) elem
 291                            (elmo-flag-folder-minfo-hash-internal
 292                             flag-folder)))
 293       (elmo-folder-commit flag-folder)
 294       new-number)))
 295
 296 (defun elmo-global-flag-set (flag folder number message-id)
 297   "Set global flag to the message.
 298 FLAG is a symbol of the flag.
 299 FOLDER is the elmo folder structure.
 300 NUMBER is the message number.
 301 MESSAGE-ID is the message-id of the message."
 302   (when (elmo-global-flag-p flag)
 303     (elmo-global-flag-set-internal flag folder number message-id)))
 304
 305 (defun elmo-global-flag-detach (flag folder number &optional delete-if-none)
 306   "Detach the message from the global flag.
 307 FOLDER is the folder structure.
 308 NUMBERS is the message number.
 309 If optional DELETE-IF-NONE is non-nil, delete message from flag folder when
 310 the message is not flagged in any folder."
 311   (unless (eq (elmo-folder-type-internal folder) 'flag)
 312     (let ((flag-folder (elmo-flag-get-folder flag))
 313           elem key)
 314       (when flag-folder
 315         (setq key (concat (number-to-string number) ":"
 316                           (elmo-folder-name-internal folder))
 317               elem (elmo-get-hash-val
 318                     key
 319                     (elmo-flag-folder-minfo-hash-internal flag-folder)))
 320         (when elem
 321           (setcar elem (delete (cons (elmo-folder-name-internal folder)
 322                                      number) (car elem)))
 323           (elmo-clear-hash-val key (elmo-flag-folder-minfo-hash-internal
 324                                     flag-folder))
 325           ;; Does not have any referrer, remove.
 326           (when (and delete-if-none (null (car elem)))
 327             (elmo-flag-folder-delete-message flag-folder (nth 2 elem) 'keep)
 328             (elmo-localdir-delete-message flag-folder (nth 2 elem))
 329             (elmo-folder-commit flag-folder)))))))
 330
 331 (defun elmo-global-flag-detach-messages (folder numbers)
 332   "Detach all messages specified from all global flags.
 333 FOLDER is the folder structure.
 334 NUMBERS is the message number list."
 335   (unless (eq (elmo-folder-type-internal folder) 'flag)
 336     (dolist (flag elmo-global-flag-list)
 337       (dolist (number numbers)
 338         (elmo-global-flag-detach flag folder number)))))
 339
 340 ;;; To migrate from global mark folder
 341 (defvar elmo-global-mark-filename "global-mark"
 342   "Obsolete variable. (Just for migration)")
 343
 344 (defun elmo-global-mark-upgrade ()
 345   "Upgrade old `global-mark' structure."
 346   (interactive)
 347   (when (file-exists-p (expand-file-name
 348                         elmo-global-mark-filename elmo-msgdb-directory))
 349     (message "Upgrading flag structure...")
 350     (elmo-global-flag-initialize)
 351     (when (elmo-global-flag-p 'important)
 352       (let ((global-marks
 353              (elmo-object-load
 354               (expand-file-name
 355                elmo-global-mark-filename elmo-msgdb-directory)))
 356             (folder (elmo-flag-get-folder 'important))
 357             file-cache)
 358         (dolist (elem global-marks)
 359           (setq file-cache (elmo-file-cache-get (car elem)))
 360           (when (eq (elmo-file-cache-status file-cache) 'entire)
 361             (elmo-global-flag-set 'important nil nil (car elem))))))
 362     (message "Upgrading flag structure...done")))
 363
 364 (require 'product)
 365 (product-provide (provide 'elmo-flag) (require 'elmo-version))
 366
 367 ;;; elmo-flag.el ends here