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) (dir-name directory))
  41   (luna-define-internal-accessors 'elmo-sendlog-folder))
  42
  43 (luna-define-method elmo-folder-initialize ((folder elmo-sendlog-folder)
  44                                             name)
  45   folder)
  46
  47 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-sendlog-folder))
  48   (expand-file-name "sendlog"
  49                     (expand-file-name "internal"
  50                                       elmo-msgdb-directory)))
  51
  52 (luna-define-method elmo-map-folder-list-message-locations
  53   ((folder elmo-sendlog-folder))
  54   (elmo-sendlog-folder-list-message-locations folder))
  55
  56 (defun elmo-sendlog-folder-list-message-locations (folder)
  57   (let ((filename (expand-file-name elmo-sendlog-filename
  58                                     elmo-msgdb-directory))
  59         result)
  60     (if (not (file-readable-p filename))
  61         nil
  62       (elmo-set-work-buf
  63        (as-binary-input-file
  64         (insert-file-contents filename))
  65        (goto-char (point-min))
  66        (catch 'done
  67          (while t
  68            (re-search-forward "id=\\([^@]+@[^@]+\\)$" (point-at-eol) t)
  69            (setq result (append result (list (match-string 1))))
  70            (if (eq (1+ (point-at-eol)) (point-max))
  71                (throw 'done nil)
  72              (beginning-of-line 2))))))
  73     result))
  74
  75 (luna-define-method elmo-folder-message-file-p ((folder elmo-sendlog-folder))
  76   t)
  77
  78 (luna-define-method elmo-message-file-name ((folder elmo-sendlog-folder)
  79                                             number)
  80   (elmo-file-cache-get-path
  81    (elmo-map-message-location folder number)))
  82
  83 (luna-define-method elmo-folder-msgdb-create ((folder elmo-sendlog-folder)
  84                                               numbers flag-table)
  85   (let ((i 0)
  86         (len (length numbers))
  87         (new-msgdb (elmo-make-msgdb))
  88         entity message-id flags)
  89     (message "Creating msgdb...")
  90     (while numbers
  91       (setq entity
  92             (elmo-msgdb-create-overview-entity-from-file
  93              (car numbers) (elmo-message-file-name folder (car numbers))))
  94       (if (null entity)
  95           (elmo-folder-set-killed-list-internal
  96            folder
  97            (nconc
  98             (elmo-folder-killed-list-internal folder)
  99             (list (car numbers))))
 100         (setq message-id (elmo-msgdb-overview-entity-get-id entity)
 101               flags (elmo-flag-table-get flag-table message-id))
 102         (elmo-global-flags-set flags folder (car numbers) message-id)
 103         (elmo-msgdb-append-entity new-msgdb entity flags))
 104       (when (> len elmo-display-progress-threshold)
 105         (setq i (1+ i))
 106         (elmo-display-progress
 107          'elmo-sendlog-folder-msgdb-create "Creating msgdb..."
 108          (/ (* i 100) len)))
 109       (setq numbers (cdr numbers)))
 110     (message "Creating msgdb...done")
 111     new-msgdb))
 112
 113 (luna-define-method elmo-message-fetch-with-cache-process
 114   ((folder elmo-sendlog-folder) number strategy &optional section unseen)
 115   ;; disbable cache process
 116   (elmo-message-fetch-internal folder number strategy section unseen))
 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   (let ((killed-list (elmo-folder-killed-list-internal folder)))
 132     (dolist (number numbers)
 133       (setq killed-list
 134             (elmo-msgdb-set-as-killed killed-list number)))
 135     (elmo-folder-set-killed-list-internal folder killed-list))
 136   t)
 137
 138 (luna-define-method elmo-message-file-p ((folder elmo-sendlog-folder) number)
 139   t)
 140
 141 (require 'product)
 142 (product-provide (provide 'elmo-sendlog) (require 'elmo-version))
 143
 144 ;;; elmo-sendlog.el ends here