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-set-flag (folder locations flag)
  66   "Set FLAG to LOCATIONS.")
  67
  68 (luna-define-generic elmo-map-folder-unset-flag (folder locations flag)
  69   "Unset FLAG from LOCATIONS.")
  70
  71 (luna-define-generic elmo-map-message-fetch (folder location
  72                                                     strategy
  73                                                     &optional
  74                                                     section
  75                                                     unseen)
  76   "")
  77
  78 (luna-define-generic elmo-map-folder-delete-messages (folder locations)
  79   "")
  80
  81 (luna-define-method elmo-folder-status ((folder elmo-map-folder))
  82   (elmo-folder-open-internal folder)
  83   (elmo-folder-set-killed-list-internal
  84    folder
  85    (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
  86   (let ((numbers (mapcar
  87                   'car
  88                   (elmo-map-folder-location-alist-internal folder))))
  89     (setq numbers (elmo-living-messages
  90                    numbers
  91                    (elmo-folder-killed-list-internal folder)))
  92     (prog1
  93         (cons (elmo-max-of-list numbers)
  94               (length numbers))
  95       ;; Don't close after status.
  96       (unless (elmo-folder-reserve-status-p folder)
  97         (elmo-folder-close-internal folder)))))
  98
  99 (defun elmo-map-message-number (folder location)
 100   "Return number of the message in the FOLDER with LOCATION."
 101   (car (elmo-get-hash-val
 102         location
 103         (elmo-map-folder-location-hash-internal folder))))
 104
 105 (defun elmo-map-message-location (folder number)
 106   "Return location of the message in the FOLDER with NUMBER."
 107   (cdr (elmo-get-hash-val
 108         (concat "#" (int-to-string number))
 109         (elmo-map-folder-location-hash-internal folder))))
 110
 111 (luna-define-method elmo-folder-pack-numbers ((folder elmo-map-folder))
 112   (let* ((msgdb (elmo-folder-msgdb folder))
 113          (numbers
 114           (sort (elmo-folder-list-messages folder nil
 115                                            (not elmo-pack-number-check-strict))
 116                 '<))
 117          (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
 118          (number 1)
 119          total location entity)
 120     (setq total (length numbers))
 121     (elmo-with-progress-display (> total elmo-display-progress-threshold)
 122         (elmo-folder-pack-numbers total "Packing...")
 123       (dolist (old-number numbers)
 124         (setq entity (elmo-msgdb-message-entity msgdb old-number))
 125         (elmo-message-entity-set-number entity number)
 126         (elmo-msgdb-append-entity new-msgdb entity
 127                                   (elmo-msgdb-flags msgdb old-number))
 128         (setq location
 129               (cons (cons number
 130                           (elmo-map-message-location folder old-number))
 131                     location))
 132         (elmo-emit-signal 'message-number-changed folder old-number number)
 133         (setq number (1+ number))))
 134     (message "Packing...done")
 135     (elmo-map-folder-location-setup folder (nreverse location))
 136     (elmo-folder-set-msgdb-internal folder new-msgdb)))
 137
 138 (defun elmo-map-folder-location-setup (folder locations)
 139   (elmo-map-folder-set-location-alist-internal
 140    folder
 141    locations)
 142   (elmo-map-folder-set-location-hash-internal
 143    folder (elmo-make-hash
 144            (* 2 (length locations))))
 145   (elmo-map-folder-set-number-max-internal folder 0)
 146   ;; Set number-max and hashtables.
 147   (dolist (location-cons locations)
 148     (if (< (elmo-map-folder-number-max-internal folder)
 149            (car location-cons))
 150         (elmo-map-folder-set-number-max-internal folder (car location-cons)))
 151     (elmo-set-hash-val (cdr location-cons)
 152                        location-cons
 153                        (elmo-map-folder-location-hash-internal folder))
 154     (elmo-set-hash-val (concat "#" (int-to-string (car location-cons)))
 155                        location-cons
 156                        (elmo-map-folder-location-hash-internal folder))))
 157
 158 (defun elmo-map-folder-update-locations (folder locations)
 159   ;; A subroutine to make location-alist.
 160   ;; location-alist is existing location-alist.
 161   ;; locations is the newest locations.
 162   (let* ((location-alist (elmo-map-folder-location-alist-internal folder))
 163          (locations-in-db (mapcar 'cdr location-alist))
 164          new-locs new-alist deleted-locs pair i)
 165     (setq new-locs
 166           (elmo-delete-if (function
 167                            (lambda (x) (member x locations-in-db)))
 168                           locations))
 169     (setq deleted-locs
 170           (elmo-delete-if (function
 171                            (lambda (x) (member x locations)))
 172                           locations-in-db))
 173     (dolist (location deleted-locs)
 174       (setq location-alist
 175             (delq (setq pair
 176                         (elmo-get-hash-val
 177                          location
 178                          (elmo-map-folder-location-hash-internal
 179                           folder)))
 180                   location-alist))
 181       (when pair
 182         (elmo-clear-hash-val (concat "#" (int-to-string (car pair)))
 183                              (elmo-map-folder-location-hash-internal
 184                               folder))
 185         (elmo-clear-hash-val location
 186                              (elmo-map-folder-location-hash-internal
 187                               folder))))
 188     (setq i (elmo-map-folder-number-max-internal folder))
 189     (dolist (location new-locs)
 190       (setq i (1+ i))
 191       (elmo-map-folder-set-number-max-internal folder i)
 192       (setq new-alist (cons (setq pair (cons i location)) new-alist))
 193       (setq new-alist (nreverse new-alist))
 194       (elmo-set-hash-val (concat "#" (int-to-string i))
 195                          pair
 196                          (elmo-map-folder-location-hash-internal
 197                           folder))
 198       (elmo-set-hash-val location
 199                          pair
 200                          (elmo-map-folder-location-hash-internal
 201                           folder)))
 202     (setq location-alist
 203           (sort (nconc location-alist new-alist)
 204                 (lambda (x y) (< (car x) (car y)))))
 205     (elmo-map-folder-set-location-alist-internal folder location-alist)))
 206
 207 (luna-define-method elmo-folder-open-internal ((folder elmo-map-folder))
 208   (elmo-map-folder-location-setup
 209    folder
 210    (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))
 211   (if (elmo-folder-plugged-p folder)
 212       (elmo-map-folder-update-locations
 213        folder
 214        (elmo-map-folder-list-message-locations folder))))
 215
 216 (luna-define-method elmo-folder-commit :after ((folder elmo-map-folder))
 217   (when (elmo-folder-persistent-p folder)
 218     (elmo-msgdb-location-save (elmo-folder-msgdb-path folder)
 219                               (elmo-map-folder-location-alist-internal
 220                                folder))))
 221
 222 (luna-define-method elmo-folder-close-internal ((folder elmo-map-folder))
 223   (elmo-map-folder-set-location-alist-internal folder nil)
 224   (elmo-map-folder-set-location-hash-internal folder nil))
 225
 226 (luna-define-method elmo-folder-check ((folder elmo-map-folder))
 227   (elmo-map-folder-update-locations
 228    folder
 229    (elmo-map-folder-list-message-locations folder)))
 230
 231 (luna-define-method elmo-folder-next-message-number ((folder elmo-map-folder))
 232   (1+ (elmo-map-folder-number-max-internal folder)))
 233
 234 (luna-define-method elmo-folder-clear :around ((folder elmo-map-folder)
 235                                                &optional keep-killed)
 236   (unless keep-killed
 237     (elmo-map-folder-set-number-max-internal folder 0)
 238     (elmo-map-folder-set-location-alist-internal folder nil)
 239     ;; clear hashtable.
 240     (elmo-map-folder-set-location-hash-internal folder (elmo-make-hash)))
 241   (luna-call-next-method))
 242
 243 (luna-define-method elmo-folder-list-messages-internal
 244   ((folder elmo-map-folder) &optional nohide)
 245   (mapcar 'car (elmo-map-folder-location-alist-internal folder)))
 246
 247 (luna-define-method elmo-folder-set-flag :before ((folder elmo-map-folder)
 248                                                   numbers
 249                                                   flag
 250                                                   &optional is-local)
 251   (unless is-local
 252     (elmo-map-folder-set-flag
 253      folder
 254      (elmo-map-folder-numbers-to-locations folder numbers)
 255      flag)))
 256
 257 (luna-define-method elmo-folder-unset-flag :before ((folder elmo-map-folder)
 258                                                     numbers
 259                                                     flag
 260                                                     &optional is-local)
 261   (unless is-local
 262     (elmo-map-folder-unset-flag
 263      folder
 264      (elmo-map-folder-numbers-to-locations folder numbers)
 265      flag)))
 266
 267 (luna-define-method elmo-message-fetch-internal ((folder elmo-map-folder)
 268                                                  number strategy
 269                                                  &optional section unread)
 270   (elmo-map-message-fetch
 271    folder
 272    (elmo-map-message-location folder number)
 273    strategy section unread))
 274
 275 (luna-define-method elmo-folder-list-flagged-internal ((folder elmo-map-folder)
 276                                                        flag)
 277   (let ((locations (elmo-map-folder-list-flagged folder flag)))
 278     (if (listp locations)
 279         (elmo-map-folder-locations-to-numbers folder locations)
 280       t)))
 281
 282 (luna-define-generic elmo-map-folder-list-flagged (folder flag)
 283   "Return a list of message location in the FOLDER with FLAG.
 284 Return t if the message list is not available.")
 285
 286 (luna-define-method elmo-map-folder-list-flagged ((folder elmo-map-folder)
 287                                                   flag)
 288   t)
 289
 290 (luna-define-method elmo-folder-delete-messages-internal ((folder
 291                                                            elmo-map-folder)
 292                                                           numbers)
 293   (elmo-map-folder-delete-messages
 294    folder
 295    (elmo-map-folder-numbers-to-locations folder numbers)))
 296
 297 (luna-define-method elmo-folder-detach-messages :around ((folder
 298                                                           elmo-map-folder)
 299                                                          numbers)
 300   (when (luna-call-next-method)
 301     (dolist (number numbers)
 302       (elmo-map-folder-set-location-alist-internal
 303        folder
 304        (delq (elmo-get-hash-val
 305               (concat "#" (int-to-string number))
 306               (elmo-map-folder-location-hash-internal
 307                folder))
 308              (elmo-map-folder-location-alist-internal folder)))
 309       (elmo-clear-hash-val (concat "#" (int-to-string number))
 310                            (elmo-map-folder-location-hash-internal
 311                             folder)))
 312     t)) ; success
 313
 314 (require 'product)
 315 (product-provide (provide 'elmo-map) (require 'elmo-version))
 316
 317 ;;; elmo-map.el ends here