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