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 elmo-file-tag)
  40                      (dir-name directory))
  41   (luna-define-internal-accessors 'elmo-cache-folder))
  42
  43 (luna-define-method elmo-folder-initialize ((folder elmo-cache-folder)
  44                                             name)
  45   (when (string-match "\\([^/]*\\)/?\\(.*\\)$" name)
  46     (elmo-cache-folder-set-dir-name-internal
  47      folder
  48      (elmo-match-string 2 name))
  49     (elmo-cache-folder-set-directory-internal
  50      folder
  51      (expand-file-name (elmo-match-string 2 name)
  52                        elmo-cache-directory))
  53     folder))
  54
  55 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-cache-folder))
  56   (expand-file-name (elmo-cache-folder-dir-name-internal folder)
  57                     (expand-file-name "internal/cache"
  58                                       elmo-msgdb-directory)))
  59
  60 (luna-define-method elmo-map-folder-list-message-locations
  61   ((folder elmo-cache-folder))
  62   (elmo-cache-folder-list-message-locations folder))
  63
  64 (defun elmo-cache-folder-list-message-locations (folder)
  65   (mapcar 'file-name-nondirectory
  66           (elmo-delete-if
  67            'file-directory-p
  68            (directory-files (elmo-cache-folder-directory-internal folder)
  69                             t "^[^@]+@[^@]+$" t))))
  70
  71 (luna-define-method elmo-folder-list-subfolders ((folder elmo-cache-folder)
  72                                                  &optional one-level)
  73   (delq nil (mapcar
  74              (lambda (f) (if (file-directory-p f)
  75                              (concat (elmo-folder-prefix-internal folder)
  76                                      "cache/"
  77                                      (file-name-nondirectory f))))
  78              (directory-files (elmo-cache-folder-directory-internal folder)
  79                               t "^[01][0-9A-F]$"))))
  80
  81 (luna-define-method elmo-folder-message-file-p ((folder elmo-cache-folder))
  82   t)
  83
  84 (luna-define-method elmo-message-file-name ((folder elmo-cache-folder)
  85                                             number)
  86   (expand-file-name
  87    (elmo-map-message-location folder number)
  88    (elmo-cache-folder-directory-internal folder)))
  89
  90 (luna-define-method elmo-folder-msgdb-create ((folder elmo-cache-folder)
  91                                               numbers flag-table)
  92   (let ((new-msgdb (elmo-make-msgdb))
  93         entity message-id flags)
  94     (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
  95         "Creating msgdb"
  96       (dolist (number numbers)
  97         (setq entity
  98               (elmo-msgdb-create-message-entity-from-file
  99                (elmo-msgdb-message-entity-handler new-msgdb)
 100                number
 101                (elmo-message-file-name folder number)))
 102         (when entity
 103           (setq message-id (elmo-message-entity-field entity 'message-id)
 104                 flags (elmo-flag-table-get flag-table message-id))
 105           (elmo-global-flags-set flags folder number message-id)
 106           (elmo-msgdb-append-entity new-msgdb entity flags))
 107         (elmo-progress-notify 'elmo-folder-msgdb-create)))
 108     new-msgdb))
 109
 110 (luna-define-method elmo-folder-append-buffer ((folder elmo-cache-folder)
 111                                                &optional flags number)
 112   ;; dir-name is changed according to msgid.
 113   (unless (elmo-cache-folder-dir-name-internal folder)
 114     (let ((msgid (std11-field-body "message-id"))
 115           file dir)
 116       (when msgid
 117         (setq file (elmo-file-cache-get-path msgid))
 118         (setq dir (directory-file-name (file-name-directory file)))
 119         (unless (file-exists-p dir)
 120           (elmo-make-directory dir))
 121         (when (and (file-writable-p file)
 122                    (not (file-exists-p file)))
 123           (write-region-as-binary
 124            (point-min) (point-max) file nil 'no-msg)
 125           (elmo-folder-preserve-flags folder msgid flags)
 126           t)))))
 127
 128 (luna-define-method elmo-map-folder-delete-messages ((folder elmo-cache-folder)
 129                                                      locations)
 130   (dolist (location locations)
 131     (elmo-file-cache-delete
 132      (expand-file-name location
 133                        (elmo-cache-folder-directory-internal folder))))
 134   t)
 135
 136 (luna-define-method elmo-message-fetch
 137   ((folder elmo-cache-folder) number strategy &optional unseen section)
 138   ;; disable cache process
 139   (erase-buffer)
 140   (when (elmo-message-fetch-internal folder number strategy section unseen)
 141     (when (and (not unseen)
 142                (elmo-message-flagged-p folder number 'unread))
 143       (elmo-message-unset-flag folder number 'unread))
 144     t))
 145
 146 (luna-define-method elmo-map-message-fetch ((folder elmo-cache-folder)
 147                                             location strategy
 148                                             &optional section unseen)
 149   (let ((file (expand-file-name
 150                location
 151                (elmo-cache-folder-directory-internal folder))))
 152     (when (file-exists-p file)
 153       (insert-file-contents-as-binary file))))
 154
 155 (luna-define-method elmo-folder-writable-p ((folder elmo-cache-folder))
 156   t)
 157
 158 (luna-define-method elmo-folder-exists-p ((folder elmo-cache-folder))
 159   t)
 160
 161 (luna-define-method elmo-message-file-p ((folder elmo-cache-folder) number)
 162   t)
 163
 164 (require 'product)
 165 (product-provide (provide 'elmo-cache) (require 'elmo-version))
 166
 167 ;;; elmo-cache.el ends here