elmo/elmo-map.el

   1 ;;; elmo-map.el --- A ELMO folder class with message number mapping.
   2
   3 ;; Copyright (C) 2000 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 ;; Folders which do not have unique message numbers but unique message names
  28 ;; should inherit this folder.
  29
  30 ;;; Code:
  31 ;;
  32 (require 'elmo)
  33 (require 'elmo-msgdb)
  34
  35 (eval-when-compile (require 'cl))
  36
  37 (eval-and-compile
  38   ;; location-hash: location->number mapping
  39   ;; number-hash:   number->location mapping
  40   (luna-define-class elmo-map-folder (elmo-folder)
  41                      (location-alist number-max location-hash))
  42   (luna-define-internal-accessors 'elmo-map-folder))
  43
  44 (defun elmo-map-folder-numbers-to-locations (folder numbers)
  45   (let (locations pair)
  46     (dolist (number numbers)
  47       (if (setq pair (elmo-get-hash-val
  48                       (concat "#" (int-to-string number))
  49                       (elmo-map-folder-location-hash-internal folder)))
  50           (setq locations (cons (cdr pair) locations))))
  51     (nreverse locations)))
  52
  53 (defun elmo-map-folder-locations-to-numbers (folder locations)
  54   (let (numbers pair)
  55     (dolist (location locations)
  56       (if (setq pair (elmo-get-hash-val
  57                       location
  58                       (elmo-map-folder-location-hash-internal folder)))
  59           (setq numbers (cons (car pair) numbers))))
  60     (nreverse numbers)))
  61
  62 (luna-define-generic elmo-map-folder-list-message-locations (folder)
  63   "Return a location list of the FOLDER.")
  64
  65 (luna-define-generic elmo-map-folder-unflag-important (folder locations)
  66   "")
  67
  68 (luna-define-generic elmo-map-folder-flag-as-important (folder locations)
  69   "")
  70
  71 (luna-define-generic elmo-map-folder-unflag-read (folder locations)
  72   "")
  73
  74 (luna-define-generic elmo-map-folder-flag-as-read (folder locations)
  75   "")
  76
  77 (luna-define-generic elmo-map-folder-unflag-answered (folder locations)
  78   "")
  79
  80 (luna-define-generic elmo-map-folder-flag-as-answered (folder locations)
  81   "")
  82
  83 (luna-define-generic elmo-map-message-fetch (folder location
  84                                                     strategy
  85                                                     &optional
  86                                                     section
  87                                                     unseen)
  88   "")
  89
  90 (luna-define-generic elmo-map-folder-list-unreads (folder)
  91   "")
  92
  93 (luna-define-method elmo-map-folder-list-unreads ((folder elmo-map-folder))
  94   t)
  95
  96 (luna-define-generic elmo-map-folder-list-importants (folder)
  97   "")
  98
  99 (luna-define-method elmo-map-folder-list-importants ((folder elmo-map-folder))
 100   t)
 101
 102 (luna-define-generic elmo-map-folder-list-answereds (folder)
 103   "")
 104
 105 (luna-define-method elmo-map-folder-list-answereds ((folder elmo-map-folder))
 106   t)
 107
 108 (luna-define-generic elmo-map-folder-delete-messages (folder locations)
 109   "")
 110
 111 (luna-define-method elmo-folder-status ((folder elmo-map-folder))
 112   (elmo-folder-open-internal folder)
 113   (elmo-folder-set-killed-list-internal
 114    folder
 115    (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
 116   (let ((numbers (mapcar
 117                   'car
 118                   (elmo-map-folder-location-alist-internal folder))))
 119     (setq numbers (elmo-living-messages
 120                    numbers
 121                    (elmo-folder-killed-list-internal folder)))
 122     (prog1
 123         (cons (elmo-max-of-list numbers)
 124               (length numbers))
 125       ;; Don't close after status.
 126       (unless (elmo-folder-reserve-status-p folder)
 127         (elmo-folder-close-internal folder)))))
 128
 129 (defun elmo-map-message-number (folder location)
 130   "Return number of the message in the FOLDER with LOCATION."
 131   (car (elmo-get-hash-val
 132         location
 133         (elmo-map-folder-location-hash-internal folder))))
 134
 135 (defun elmo-map-message-location (folder number)
 136   "Return location of the message in the FOLDER with NUMBER."
 137   (cdr (elmo-get-hash-val
 138         (concat "#" (int-to-string number))
 139         (elmo-map-folder-location-hash-internal folder))))
 140
 141 (luna-define-method elmo-folder-pack-numbers ((folder elmo-map-folder))
 142   (let* ((msgdb (elmo-folder-msgdb folder))
 143          (numbers (sort (elmo-folder-list-messages folder nil 'in-msgdb) '<))
 144          (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
 145          (number 1)
 146          total location entity)
 147     (setq total (length numbers))
 148     (elmo-with-progress-display (> total elmo-display-progress-threshold)
 149         (elmo-folder-pack-numbers total "Packing...")
 150       (dolist (old-number numbers)
 151         (setq entity (elmo-msgdb-message-entity msgdb old-number))
 152         (elmo-message-entity-set-number entity number)
 153         (elmo-msgdb-append-entity new-msgdb entity
 154                                   (elmo-msgdb-flags msgdb old-number))
 155         (setq location
 156               (cons (cons number
 157                           (elmo-map-message-location folder old-number))
 158                     location))
 159         (setq number (1+ number))))
 160     (message "Packing...done")
 161     (elmo-map-folder-location-setup folder (nreverse location))
 162     (elmo-folder-set-msgdb-internal folder new-msgdb)))
 163
 164 (defun elmo-map-folder-location-setup (folder locations)
 165   (elmo-map-folder-set-location-alist-internal
 166    folder
 167    locations)
 168   (elmo-map-folder-set-location-hash-internal
 169    folder (elmo-make-hash
 170            (* 2 (length locations))))
 171   (elmo-map-folder-set-number-max-internal folder 0)
 172   ;; Set number-max and hashtables.
 173   (dolist (location-cons locations)
 174     (if (< (elmo-map-folder-number-max-internal folder)
 175            (car location-cons))
 176         (elmo-map-folder-set-number-max-internal folder (car location-cons)))
 177     (elmo-set-hash-val (cdr location-cons)
 178                        location-cons
 179                        (elmo-map-folder-location-hash-internal folder))
 180     (elmo-set-hash-val (concat "#" (int-to-string (car location-cons)))
 181                        location-cons
 182                        (elmo-map-folder-location-hash-internal folder))))
 183
 184 (defun elmo-map-folder-update-locations (folder locations)
 185   ;; A subroutine to make location-alist.
 186   ;; location-alist is existing location-alist.
 187   ;; locations is the newest locations.
 188   (let* ((location-alist (elmo-map-folder-location-alist-internal folder))
 189          (locations-in-db (mapcar 'cdr location-alist))
 190          new-locs new-alist deleted-locs pair i)
 191     (setq new-locs
 192           (elmo-delete-if (function
 193                            (lambda (x) (member x locations-in-db)))
 194                           locations))
 195     (setq deleted-locs
 196           (elmo-delete-if (function
 197                            (lambda (x) (member x locations)))
 198                           locations-in-db))
 199     (dolist (location deleted-locs)
 200       (setq location-alist
 201             (delq (setq pair
 202                         (elmo-get-hash-val
 203                          location
 204                          (elmo-map-folder-location-hash-internal
 205                           folder)))
 206                   location-alist))
 207       (when pair
 208         (elmo-clear-hash-val (concat "#" (int-to-string (car pair)))
 209                              (elmo-map-folder-location-hash-internal
 210                               folder))
 211         (elmo-clear-hash-val location
 212                              (elmo-map-folder-location-hash-internal
 213                               folder))))
 214     (setq i (elmo-map-folder-number-max-internal folder))
 215     (dolist (location new-locs)
 216       (setq i (1+ i))
 217       (elmo-map-folder-set-number-max-internal folder i)
 218       (setq new-alist (cons (setq pair (cons i location)) new-alist))
 219       (setq new-alist (nreverse new-alist))
 220       (elmo-set-hash-val (concat "#" (int-to-string i))
 221                          pair
 222                          (elmo-map-folder-location-hash-internal
 223                           folder))
 224       (elmo-set-hash-val location
 225                          pair
 226                          (elmo-map-folder-location-hash-internal
 227                           folder)))
 228     (setq location-alist
 229           (sort (nconc location-alist new-alist)
 230                 (lambda (x y) (< (car x) (car y)))))
 231     (elmo-map-folder-set-location-alist-internal folder location-alist)))
 232
 233 (luna-define-method elmo-folder-open-internal ((folder elmo-map-folder))
 234   (elmo-map-folder-location-setup
 235    folder
 236    (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))
 237   (if (elmo-folder-plugged-p folder)
 238       (elmo-map-folder-update-locations
 239        folder
 240        (elmo-map-folder-list-message-locations folder))))
 241
 242 (luna-define-method elmo-folder-commit :after ((folder elmo-map-folder))
 243   (when (elmo-folder-persistent-p folder)
 244     (elmo-msgdb-location-save (elmo-folder-msgdb-path folder)
 245                               (elmo-map-folder-location-alist-internal
 246                                folder))))
 247
 248 (luna-define-method elmo-folder-close-internal ((folder elmo-map-folder))
 249   (elmo-map-folder-set-location-alist-internal folder nil)
 250   (elmo-map-folder-set-location-hash-internal folder nil))
 251
 252 (luna-define-method elmo-folder-check ((folder elmo-map-folder))
 253   (elmo-map-folder-update-locations
 254    folder
 255    (elmo-map-folder-list-message-locations folder)))
 256
 257 (luna-define-method elmo-folder-next-message-number ((folder elmo-map-folder))
 258   (1+ (elmo-map-folder-number-max-internal folder)))
 259
 260 (luna-define-method elmo-folder-clear :around ((folder elmo-map-folder)
 261                                                &optional keep-killed)
 262   (unless keep-killed
 263     (elmo-map-folder-set-number-max-internal folder 0)
 264     (elmo-map-folder-set-location-alist-internal folder nil)
 265     ;; clear hashtable.
 266     (elmo-map-folder-set-location-hash-internal folder (elmo-make-hash)))
 267   (luna-call-next-method))
 268
 269 (luna-define-method elmo-folder-list-messages-internal
 270   ((folder elmo-map-folder) &optional nohide)
 271   (mapcar 'car (elmo-map-folder-location-alist-internal folder)))
 272
 273 (luna-define-method elmo-folder-unflag-important :before ((folder
 274                                                            elmo-map-folder)
 275                                                           numbers
 276                                                           &optional
 277                                                           is-local)
 278   (unless is-local
 279     (elmo-map-folder-unflag-important
 280      folder
 281      (elmo-map-folder-numbers-to-locations folder numbers))))
 282
 283 (luna-define-method elmo-folder-flag-as-important :before ((folder
 284                                                             elmo-map-folder)
 285                                                            numbers
 286                                                            &optional
 287                                                            is-local)
 288   (unless is-local
 289     (elmo-map-folder-flag-as-important
 290      folder
 291      (elmo-map-folder-numbers-to-locations folder numbers))))
 292
 293 (luna-define-method elmo-folder-unflag-read :before ((folder elmo-map-folder)
 294                                                      numbers
 295                                                      &optional is-local)
 296   (unless is-local
 297     (elmo-map-folder-unflag-read
 298      folder
 299      (elmo-map-folder-numbers-to-locations folder numbers))))
 300
 301 (luna-define-method elmo-folder-flag-as-read :before ((folder
 302                                                        elmo-map-folder)
 303                                                       numbers
 304                                                       &optional is-local)
 305   (unless is-local
 306     (elmo-map-folder-flag-as-read
 307      folder
 308      (elmo-map-folder-numbers-to-locations folder numbers))))
 309
 310 (luna-define-method elmo-folder-unflag-answered :before ((folder
 311                                                           elmo-map-folder)
 312                                                          numbers
 313                                                          &optional is-local)
 314   (elmo-map-folder-unflag-answered
 315    folder
 316    (elmo-map-folder-numbers-to-locations folder numbers)))
 317
 318 (luna-define-method elmo-folder-flag-as-answered :before ((folder
 319                                                            elmo-map-folder)
 320                                                           numbers
 321                                                           &optional is-local)
 322   (elmo-map-folder-flag-as-answered
 323    folder
 324    (elmo-map-folder-numbers-to-locations folder numbers)))
 325
 326 (luna-define-method elmo-message-fetch-internal ((folder elmo-map-folder)
 327                                                  number strategy
 328                                                  &optional section unread)
 329   (elmo-map-message-fetch
 330    folder
 331    (elmo-map-message-location folder number)
 332    strategy section unread))
 333
 334 (luna-define-method elmo-folder-list-unreads :around ((folder elmo-map-folder))
 335   (let ((locations (elmo-map-folder-list-unreads folder)))
 336     (if (listp locations)
 337         (elmo-map-folder-locations-to-numbers folder locations)
 338       (luna-call-next-method))))
 339
 340 (luna-define-method elmo-folder-list-importants :around ((folder
 341                                                           elmo-map-folder))
 342   (let ((locations (elmo-map-folder-list-importants folder)))
 343     (if (listp locations)
 344         (elmo-map-folder-locations-to-numbers folder locations)
 345       (luna-call-next-method))))
 346
 347 (luna-define-method elmo-folder-list-answereds :around ((folder
 348                                                          elmo-map-folder))
 349   (let ((locations (elmo-map-folder-list-answereds folder)))
 350     (if (listp locations)
 351         (elmo-map-folder-locations-to-numbers folder locations)
 352       (luna-call-next-method))))
 353
 354 (luna-define-method elmo-folder-delete-messages ((folder elmo-map-folder)
 355                                                  numbers)
 356   (elmo-map-folder-delete-messages
 357    folder
 358    (elmo-map-folder-numbers-to-locations folder numbers))
 359   (dolist (number numbers)
 360     (elmo-map-folder-set-location-alist-internal
 361      folder
 362      (delq (elmo-get-hash-val
 363             (concat "#" (int-to-string number))
 364             (elmo-map-folder-location-hash-internal
 365              folder))
 366            (elmo-map-folder-location-alist-internal folder)))
 367     (elmo-clear-hash-val (concat "#" (int-to-string number))
 368                          (elmo-map-folder-location-hash-internal
 369                           folder)))
 370   t) ; success
 371
 372 (require 'product)
 373 (product-provide (provide 'elmo-map) (require 'elmo-version))
 374
 375 ;;; elmo-map.el ends here