elmo/elmo-sendlog.el

   1 ;;; elmo-sendlog.el --- Sendlog folder for ELMO.
   2
   3 ;; Copyright (C) 2001 Kenichi OKADA <okada@opaopa.org>
   4
   5 ;; Author: Kenichi OKADA <okada@opaopa.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 ;;
  28
  29 ;;; Code:
  30 ;;
  31 (require 'elmo-vars)
  32 (require 'elmo-util)
  33 (require 'elmo)
  34 (require 'elmo-map)
  35
  36 (defvar elmo-sendlog-filename "sendlog")
  37
  38 ;;; ELMO sendlog folder
  39 (eval-and-compile
  40   (luna-define-class elmo-sendlog-folder (elmo-map-folder elmo-file-tag)
  41                      (dir-name directory))
  42   (luna-define-internal-accessors 'elmo-sendlog-folder))
  43
  44 (luna-define-method elmo-folder-initialize ((folder elmo-sendlog-folder)
  45                                             name)
  46   folder)
  47
  48 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-sendlog-folder))
  49   (expand-file-name "sendlog"
  50                     (expand-file-name "internal"
  51                                       elmo-msgdb-directory)))
  52
  53 (luna-define-method elmo-map-folder-list-message-locations
  54   ((folder elmo-sendlog-folder))
  55   (elmo-sendlog-folder-list-message-locations folder))
  56
  57 (defun elmo-sendlog-folder-list-message-locations (folder)
  58   (let ((filename (expand-file-name elmo-sendlog-filename
  59                                     elmo-msgdb-directory))
  60         result)
  61     (if (not (file-readable-p filename))
  62         nil
  63       (with-temp-buffer
  64         (as-binary-input-file
  65          (insert-file-contents filename))
  66         (goto-char (point-min))
  67         (catch 'done
  68           (while t
  69             (re-search-forward "id=\\([^@]+@[^@]+\\)$" (point-at-eol) t)
  70             (setq result (append result (list (match-string 1))))
  71             (if (eq (1+ (point-at-eol)) (point-max))
  72                 (throw 'done nil)
  73               (beginning-of-line 2))))))
  74     result))
  75
  76 (luna-define-method elmo-folder-message-file-p ((folder elmo-sendlog-folder))
  77   t)
  78
  79 (luna-define-method elmo-message-file-name ((folder elmo-sendlog-folder)
  80                                             number)
  81   (elmo-file-cache-get-path
  82    (elmo-map-message-location folder number)))
  83
  84 (luna-define-method elmo-folder-msgdb-create ((folder elmo-sendlog-folder)
  85                                               numbers flag-table)
  86   (let ((new-msgdb (elmo-make-msgdb))
  87         entity message-id flags)
  88     (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
  89         "Creating msgdb"
  90       (dolist (number numbers)
  91         (setq entity
  92               (elmo-msgdb-create-message-entity-from-file
  93                (elmo-msgdb-message-entity-handler new-msgdb) number
  94                (elmo-message-file-name folder number)))
  95         (if (null entity)
  96             (elmo-folder-set-killed-list-internal
  97              folder
  98              (nconc
  99               (elmo-folder-killed-list-internal folder)
 100               (list number)))
 101           (setq message-id (elmo-message-entity-field entity 'message-id)
 102                 flags (elmo-flag-table-get flag-table message-id))
 103           (elmo-global-flags-set flags folder number message-id)
 104           (elmo-msgdb-append-entity new-msgdb entity flags))
 105         (elmo-progress-notify 'elmo-folder-msgdb-create)))
 106     new-msgdb))
 107
 108 (luna-define-method elmo-message-fetch
 109   ((folder elmo-sendlog-folder) number strategy &optional unseen section)
 110   ;; disbable cache process
 111   (erase-buffer)
 112   (when (elmo-message-fetch-internal folder number strategy section unseen)
 113     (when (and (not unseen)
 114                (elmo-message-flagged-p folder number 'unread))
 115       (elmo-message-unset-flag folder number 'unread))
 116     t))
 117
 118 (luna-define-method elmo-map-message-fetch ((folder elmo-sendlog-folder)
 119                                             location strategy
 120                                             &optional section unseen)
 121   (let ((filename (elmo-file-cache-get-path location)))
 122     (if (file-exists-p filename)
 123         (insert-file-contents-as-binary filename)
 124       (error "Now this message is not cached. Please s all"))))
 125
 126 (luna-define-method elmo-folder-exists-p ((folder elmo-sendlog-folder))
 127   t)
 128
 129 (luna-define-method elmo-folder-delete-messages ((folder elmo-sendlog-folder)
 130                                                  numbers)
 131   (elmo-folder-kill-messages folder numbers)
 132   t)
 133
 134 (luna-define-method elmo-message-file-p ((folder elmo-sendlog-folder) number)
 135   t)
 136
 137 (luna-define-method elmo-folder-have-subfolder-p ((folder elmo-sendlog-folder))
 138   nil)
 139
 140 (require 'product)
 141 (product-provide (provide 'elmo-sendlog) (require 'elmo-version))
 142
 143 ;;; elmo-sendlog.el ends here