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 (eval-and-compile
  39   (luna-define-class elmo-cache-folder (elmo-map-folder) (dir-name directory))
  40   (luna-define-internal-accessors 'elmo-cache-folder))
  41
  42 (luna-define-method elmo-folder-initialize ((folder elmo-cache-folder)
  43                                             name)
  44   (when (string-match "\\([^/]*\\)/?\\(.*\\)$" name)
  45     (elmo-cache-folder-set-dir-name-internal
  46      folder
  47      (elmo-match-string 2 name))
  48     (elmo-cache-folder-set-directory-internal
  49      folder
  50      (expand-file-name (elmo-match-string 2 name)
  51                        elmo-cache-directory))
  52     folder))
  53
  54 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-cache-folder))
  55   (expand-file-name (elmo-cache-folder-dir-name-internal folder)
  56                     (expand-file-name "internal/cache"
  57                                       elmo-msgdb-directory)))
  58
  59 (luna-define-method elmo-map-folder-list-message-locations
  60   ((folder elmo-cache-folder))
  61   (elmo-cache-folder-list-message-locations folder))
  62
  63 (defun elmo-cache-folder-list-message-locations (folder)
  64   (mapcar 'file-name-nondirectory
  65           (elmo-delete-if
  66            'file-directory-p
  67            (directory-files (elmo-cache-folder-directory-internal folder)
  68                             t "^[^@]+@[^@]+$" t))))
  69
  70 (luna-define-method elmo-folder-list-subfolders ((folder elmo-cache-folder)
  71                                                  &optional one-level)
  72   (delq nil (mapcar
  73              (lambda (f) (if (file-directory-p f)
  74                              (concat (elmo-folder-prefix-internal folder)
  75                                      "cache/"
  76                                      (file-name-nondirectory f))))
  77              (directory-files (elmo-cache-folder-directory-internal folder)
  78                               t "^[^.].*+"))))
  79
  80 (luna-define-method elmo-folder-message-file-p ((folder elmo-cache-folder))
  81   t)
  82
  83 (luna-define-method elmo-message-file-name ((folder elmo-cache-folder)
  84                                             number)
  85   (expand-file-name
  86    (elmo-map-message-location folder number)
  87    (elmo-cache-folder-directory-internal folder)))
  88
  89 (luna-define-method elmo-folder-msgdb-create ((folder elmo-cache-folder)
  90                                               numbers new-mark
  91                                               already-mark seen-mark
  92                                               important-mark
  93                                               seen-list)
  94   (let ((i 0)
  95         (len (length numbers))
  96         overview number-alist mark-alist entity message-id
  97         num mark)
  98     (message "Creating msgdb...")
  99     (while numbers
 100       (setq entity
 101             (elmo-msgdb-create-overview-entity-from-file
 102              (car numbers) (elmo-message-file-name folder (car numbers))))
 103       (if (null entity)
 104           ()
 105         (setq num (elmo-msgdb-overview-entity-get-number entity))
 106         (setq overview
 107               (elmo-msgdb-append-element
 108                overview entity))
 109         (setq message-id (elmo-msgdb-overview-entity-get-id entity))
 110         (setq number-alist
 111               (elmo-msgdb-number-add number-alist
 112                                      num
 113                                      message-id))
 114         (if (setq mark (or (elmo-msgdb-global-mark-get message-id)
 115                            (if (member message-id seen-list) nil new-mark)))
 116             (setq mark-alist
 117                   (elmo-msgdb-mark-append
 118                    mark-alist
 119                    num mark)))
 120         (when (> len elmo-display-progress-threshold)
 121           (setq i (1+ i))
 122           (elmo-display-progress
 123            'elmo-cache-folder-msgdb-create "Creating msgdb..."
 124            (/ (* i 100) len))))
 125       (setq numbers (cdr numbers)))
 126     (message "Creating msgdb...done")
 127     (list overview number-alist mark-alist)))
 128
 129 (luna-define-method elmo-folder-append-buffer ((folder elmo-cache-folder)
 130                                                unread
 131                                                &optional number)
 132   ;; dir-name is changed according to msgid.
 133   (unless (elmo-cache-folder-dir-name-internal folder)
 134     (let* ((file (elmo-file-cache-get-path (std11-field-body "message-id")))
 135            (dir (directory-file-name (file-name-directory file))))
 136       (unless (file-exists-p dir)
 137         (elmo-make-directory dir))
 138       (when (file-writable-p file)
 139         (write-region-as-binary
 140          (point-min) (point-max) file nil 'no-msg))))
 141   t)
 142
 143 (luna-define-method elmo-map-folder-delete-messages ((folder elmo-cache-folder)
 144                                                      locations)
 145   (dolist (location locations)
 146     (elmo-file-cache-delete
 147      (expand-file-name location
 148                        (elmo-cache-folder-directory-internal folder)))))
 149
 150 (luna-define-method elmo-message-fetch-with-cache-process
 151   ((folder elmo-cache-folder) number strategy &optional section unseen)
 152   ;; disbable cache process
 153   (elmo-message-fetch-internal folder number strategy section unseen))
 154
 155 (luna-define-method elmo-map-message-fetch ((folder elmo-cache-folder)
 156                                             location strategy
 157                                             &optional section unseen)
 158   (let ((file (expand-file-name
 159                location
 160                (elmo-cache-folder-directory-internal folder))))
 161     (when (file-exists-p file)
 162       (insert-file-contents-as-binary file))))
 163
 164 (luna-define-method elmo-folder-writable-p ((folder elmo-cache-folder))
 165   t)
 166
 167 (luna-define-method elmo-folder-exists-p ((folder elmo-cache-folder))
 168   t)
 169
 170 (luna-define-method elmo-message-file-p ((folder elmo-cache-folder) number)
 171   t)
 172
 173 ;;; To override elmo-map-folder methods.
 174 (luna-define-method elmo-folder-list-unreads-internal
 175   ((folder elmo-cache-folder) unread-marks &optional mark-alist)
 176   t)
 177
 178 (luna-define-method elmo-folder-unmark-important ((folder elmo-cache-folder)
 179                                                   numbers)
 180   t)
 181
 182 (luna-define-method elmo-folder-mark-as-important ((folder elmo-cache-folder)
 183                                                    numbers)
 184   t)
 185
 186 (luna-define-method elmo-folder-unmark-read ((folder elmo-cache-folder)
 187                                              numbers)
 188   t)
 189
 190 (luna-define-method elmo-folder-mark-as-read ((folder elmo-cache-folder)
 191                                               numbers)
 192   t)
 193
 194 (require 'product)
 195 (product-provide (provide 'elmo-cache) (require 'elmo-version))
 196
 197 ;;; elmo-cache.el ends here