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 (defvar elmo-sendlog-buffer-name "*elmo-sendlog*")
  38
  39 ;;; ELMO sendlog folder
  40 (eval-and-compile
  41   (luna-define-class elmo-sendlog-folder (elmo-map-folder) (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-dir)))
  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-dir))
  60         result)
  61     (if (not (file-readable-p filename))
  62         nil
  63       (elmo-set-work-buf
  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 new-mark
  86                                               already-mark seen-mark
  87                                               important-mark
  88                                               seen-list)
  89   (let ((i 0)
  90         (len (length numbers))
  91         overview number-alist mark-alist entity message-id
  92         num mark)
  93     (message "Creating msgdb...")
  94     (while numbers
  95       (setq entity
  96             (elmo-msgdb-create-overview-entity-from-file
  97              (car numbers) (elmo-message-file-name folder (car numbers))))
  98       (if (null entity)
  99           (elmo-folder-set-killed-list-internal
 100            folder
 101            (nconc
 102             (elmo-folder-killed-list-internal folder)
 103             (list (car numbers))))
 104         (setq num (elmo-msgdb-overview-entity-get-number entity))
 105         (setq overview
 106               (elmo-msgdb-append-element
 107                overview entity))
 108         (setq message-id (elmo-msgdb-overview-entity-get-id entity))
 109         (setq number-alist
 110               (elmo-msgdb-number-add number-alist
 111                                      num
 112                                      message-id))
 113         (if (setq mark (or (elmo-msgdb-global-mark-get message-id)
 114                            (if (member message-id seen-list) nil new-mark)))
 115             (setq mark-alist
 116                   (elmo-msgdb-mark-append
 117                    mark-alist
 118                    num mark)))
 119         (when (> len elmo-display-progress-threshold)
 120           (setq i (1+ i))
 121           (elmo-display-progress
 122            'elmo-sendlog-folder-msgdb-create "Creating msgdb..."
 123            (/ (* i 100) len))))
 124       (setq numbers (cdr numbers)))
 125     (message "Creating msgdb...done")
 126     (list overview number-alist mark-alist)))
 127
 128 (luna-define-method elmo-message-fetch-with-cache-process
 129   ((folder elmo-sendlog-folder) number strategy &optional section unseen)
 130   ;; disbable cache process
 131   (elmo-message-fetch-internal folder number strategy section unseen))
 132
 133 (luna-define-method elmo-map-message-fetch ((folder elmo-sendlog-folder)
 134                                             location strategy
 135                                             &optional section unseen)
 136   (let ((filename (elmo-file-cache-get-path location)))
 137     (if (file-exists-p filename)
 138         (insert-file-contents-as-binary filename)
 139       (error "Now this message is not cached. Please s all"))))
 140
 141 (luna-define-method elmo-folder-creatable-p ((folder elmo-sendlog-folder))
 142   nil)
 143
 144 (luna-define-method elmo-folder-writable-p ((folder elmo-sendlog-folder))
 145   nil)
 146
 147 (luna-define-method elmo-folder-exists-p ((folder elmo-sendlog-folder))
 148   t)
 149
 150 (luna-define-method elmo-folder-delete-messages ((folder elmo-sendlog-folder)
 151                                                  numbers)
 152   (let ((killed-list (elmo-folder-killed-list-internal folder)))
 153     (dolist (number numbers)
 154       (setq killed-list
 155             (elmo-msgdb-set-as-killed killed-list number)))
 156     (elmo-folder-set-killed-list-internal folder killed-list))
 157   t)
 158
 159 (luna-define-method elmo-folder-search ((folder elmo-sendlog-folder)
 160                                         condition &optional from-msgs)
 161   (let* ((msgs (or from-msgs (elmo-folder-list-messages folder)))
 162          (number-list msgs)
 163          (i 0)
 164          (num (length msgs))
 165          file
 166          matched
 167          case-fold-search)
 168     (while msgs
 169       (if (and (setq file (elmo-message-file-name folder (car msgs)))
 170                (file-exists-p file)
 171                (elmo-file-field-condition-match file
 172                                                 condition
 173                                                 (car msgs)
 174                                                 number-list))
 175           (setq matched (nconc matched (list (car msgs)))))
 176       (elmo-display-progress
 177        'elmo-internal-folder-search "Searching..."
 178        (/ (* (setq i (1+ i)) 100) num))
 179       (setq msgs (cdr msgs)))
 180     matched))
 181
 182 (luna-define-method elmo-message-file-p ((folder elmo-sendlog-folder) number)
 183   t)
 184
 185 ;;; To override elmo-map-folder methods.
 186 (luna-define-method elmo-folder-list-unreads-internal
 187   ((folder elmo-sendlog-folder) unread-marks &optional mark-alist)
 188   t)
 189
 190 (luna-define-method elmo-folder-unmark-important ((folder elmo-sendlog-folder)
 191                                                   numbers)
 192   t)
 193
 194 (luna-define-method elmo-folder-mark-as-important ((folder elmo-sendlog-folder)
 195                                                    numbers)
 196   t)
 197
 198 (luna-define-method elmo-folder-unmark-read ((folder elmo-sendlog-folder)
 199                                              numbers)
 200   t)
 201
 202 (luna-define-method elmo-folder-mark-as-read ((folder elmo-sendlog-folder)
 203                                               numbers)
 204   t)
 205
 206 (require 'product)
 207 (product-provide (provide 'elmo-sendlog) (require 'elmo-version))
 208
 209 ;;; elmo-sendlog.el ends here