elmo/elmo-cache.el

   1 ;;; elmo-cache.el --- Cache modules for ELMO.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4 ;; Copyright (C) 2000 Kenichi OKADA <okada@opaopa.org>
   5
   6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   7 ;;      Kenichi OKADA <okada@opaopa.org>
   8 ;; Keywords: mail, net news
   9
  10 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26 ;;
  27
  28 ;;; Commentary:
  29 ;;
  30
  31 ;;; Code:
  32 ;;
  33 (require 'elmo-vars)
  34 (require 'elmo-util)
  35 (require 'elmo)
  36 (require 'elmo-map)
  37
  38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  39 ;;
  40 ;; cache backend by Kenichi OKADA <okada@opaopa.org>
  41 ;;
  42 (eval-and-compile
  43   (luna-define-class elmo-cache-folder (elmo-map-folder) (dir-name directory))
  44   (luna-define-internal-accessors 'elmo-cache-folder))
  45
  46 (luna-define-method elmo-folder-initialize ((folder elmo-cache-folder)
  47                                             name)
  48   (when (string-match "\\([^/]*\\)/?\\(.*\\)$" name)
  49     (elmo-cache-folder-set-dir-name-internal
  50      folder
  51      (elmo-match-string 2 name))
  52     (elmo-cache-folder-set-directory-internal
  53      folder
  54      (expand-file-name (elmo-match-string 2 name)
  55                        elmo-cache-directory))
  56     folder))
  57
  58 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-cache-folder))
  59   (expand-file-name (elmo-cache-folder-dir-name-internal folder)
  60                     (expand-file-name "internal/cache"
  61                                       elmo-msgdb-directory)))
  62
  63 (luna-define-method elmo-map-folder-list-message-locations
  64   ((folder elmo-cache-folder))
  65   (elmo-cache-folder-list-message-locations folder))
  66
  67 (defun elmo-cache-folder-list-message-locations (folder)
  68   (mapcar 'file-name-nondirectory
  69           (elmo-delete-if
  70            'file-directory-p
  71            (directory-files (elmo-cache-folder-directory-internal folder)
  72                             t "^[^@]+@[^@]+$" t))))
  73
  74 (luna-define-method elmo-folder-list-subfolders ((folder elmo-cache-folder)
  75                                                  &optional one-level)
  76   (delq nil (mapcar
  77              (lambda (f) (if (file-directory-p f)
  78                              (concat (elmo-folder-prefix-internal folder)
  79                                      "cache/"
  80                                      (file-name-nondirectory f))))
  81              (directory-files (elmo-cache-folder-directory-internal folder)
  82                               t "^[^.].*+"))))
  83
  84 (luna-define-method elmo-folder-message-file-p ((folder elmo-cache-folder))
  85   t)
  86
  87 (luna-define-method elmo-message-file-name ((folder elmo-cache-folder)
  88                                             number)
  89   (expand-file-name
  90    (elmo-map-message-location folder number)
  91    (elmo-cache-folder-directory-internal folder)))
  92
  93 (luna-define-method elmo-folder-msgdb-create ((folder elmo-cache-folder)
  94                                               numbers new-mark
  95                                               already-mark seen-mark
  96                                               important-mark
  97                                               seen-list)
  98   (let ((i 0)
  99         (len (length numbers))
 100         overview number-alist mark-alist entity message-id
 101         num mark)
 102     (message "Creating msgdb...")
 103     (while numbers
 104       (setq entity
 105             (elmo-msgdb-create-overview-entity-from-file
 106              (car numbers) (elmo-message-file-name folder (car numbers))))
 107       (if (null entity)
 108           ()
 109         (setq num (elmo-msgdb-overview-entity-get-number entity))
 110         (setq overview
 111               (elmo-msgdb-append-element
 112                overview entity))
 113         (setq message-id (elmo-msgdb-overview-entity-get-id entity))
 114         (setq number-alist
 115               (elmo-msgdb-number-add number-alist
 116                                      num
 117                                      message-id))
 118         (if (setq mark (or (elmo-msgdb-global-mark-get message-id)
 119                            (if (member message-id seen-list) nil new-mark)))
 120             (setq mark-alist
 121                   (elmo-msgdb-mark-append
 122                    mark-alist
 123                    num mark)))
 124         (when (> len elmo-display-progress-threshold)
 125           (setq i (1+ i))
 126           (elmo-display-progress
 127            'elmo-cache-folder-msgdb-create "Creating msgdb..."
 128            (/ (* i 100) len))))
 129       (setq numbers (cdr numbers)))
 130     (message "Creating msgdb...done")
 131     (list overview number-alist mark-alist)))
 132
 133 (luna-define-method elmo-folder-append-buffer ((folder elmo-cache-folder)
 134                                                unread
 135                                                &optional number)
 136   ;; dir-name is changed according to msgid.
 137   (unless (elmo-cache-folder-dir-name-internal folder)
 138     (let* ((file (elmo-file-cache-get-path (std11-field-body "message-id")))
 139            (dir (directory-file-name (file-name-directory file))))
 140       (unless (file-exists-p dir)
 141         (elmo-make-directory dir))
 142       (when (file-writable-p file)
 143         (write-region-as-binary
 144          (point-min) (point-max) file nil 'no-msg))))
 145   t)
 146
 147 (luna-define-method elmo-map-folder-delete-messages ((folder elmo-cache-folder)
 148                                                      locations)
 149   (dolist (location locations)
 150     (elmo-file-cache-delete
 151      (expand-file-name location
 152                        (elmo-cache-folder-directory-internal folder)))))
 153
 154 (luna-define-method elmo-message-fetch-with-cache-process
 155   ((folder elmo-cache-folder) number strategy &optional section unseen)
 156   ;; disbable cache process
 157   (elmo-message-fetch-internal folder number strategy section unseen))
 158
 159 (luna-define-method elmo-map-message-fetch ((folder elmo-cache-folder)
 160                                             location strategy
 161                                             &optional section unseen)
 162   (let ((file (expand-file-name
 163                location
 164                (elmo-cache-folder-directory-internal folder))))
 165     (when (file-exists-p file)
 166       (insert-file-contents-as-binary file))))
 167
 168 (luna-define-method elmo-folder-creatable-p ((folder elmo-cache-folder))
 169   nil)
 170
 171 (luna-define-method elmo-folder-writable-p ((folder elmo-cache-folder))
 172   t)
 173
 174 (luna-define-method elmo-folder-exists-p ((folder elmo-cache-folder))
 175   t)
 176
 177 (luna-define-method elmo-folder-search ((folder elmo-cache-folder)
 178                                         condition &optional from-msgs)
 179   (let* ((msgs (or from-msgs (elmo-folder-list-messages folder)))
 180          (number-list msgs)
 181          (i 0)
 182          (num (length msgs))
 183          file
 184          matched
 185          case-fold-search)
 186     (while msgs
 187       (if (and (setq file (elmo-message-file-name folder (car msgs)))
 188                (file-exists-p file)
 189                (elmo-file-field-condition-match file
 190                                                 condition
 191                                                 (car msgs)
 192                                                 number-list))
 193           (setq matched (nconc matched (list (car msgs)))))
 194       (elmo-display-progress
 195        'elmo-internal-folder-search "Searching..."
 196        (/ (* (setq i (1+ i)) 100) num))
 197       (setq msgs (cdr msgs)))
 198     matched))
 199
 200 (luna-define-method elmo-message-file-p ((folder elmo-cache-folder) number)
 201   t)
 202
 203 ;;; To override elmo-map-folder methods.
 204 (luna-define-method elmo-folder-list-unreads-internal
 205   ((folder elmo-cache-folder) unread-marks &optional mark-alist)
 206   t)
 207
 208 (luna-define-method elmo-folder-unmark-important ((folder elmo-cache-folder)
 209                                                   numbers)
 210   t)
 211
 212 (luna-define-method elmo-folder-mark-as-important ((folder elmo-cache-folder)
 213                                                    numbers)
 214   t)
 215
 216 (luna-define-method elmo-folder-unmark-read ((folder elmo-cache-folder)
 217                                              numbers)
 218   t)
 219
 220 (luna-define-method elmo-folder-mark-as-read ((folder elmo-cache-folder)
 221                                               numbers)
 222   t)
 223
 224 (require 'product)
 225 (product-provide (provide 'elmo-cache) (require 'elmo-version))
 226
 227 ;;; elmo-cache.el ends here