elmo/elmo-file.el

   1 ;;; elmo-file.el --- File interface for ELMO.
   2
   3 ;; Copyright (C) 2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.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)
  32 (require 'elmo-map)
  33 (require 'mime-edit)
  34
  35 (eval-and-compile
  36   (luna-define-class elmo-file-folder (elmo-map-folder) (file-path))
  37   (luna-define-internal-accessors 'elmo-file-folder))
  38
  39 (luna-define-method elmo-folder-initialize ((folder
  40                                              elmo-file-folder)
  41                                             name)
  42   (elmo-file-folder-set-file-path-internal folder name)
  43   folder)
  44
  45 (luna-define-method elmo-folder-expand-msgdb-path ((folder
  46                                                     elmo-file-folder))
  47   (expand-file-name
  48    (elmo-replace-string-as-filename (elmo-folder-name-internal folder))
  49    (expand-file-name "file" elmo-msgdb-directory)))
  50
  51 (defun elmo-file-make-date-string (attrs)
  52   (let ((s (current-time-string (nth 5 attrs))))
  53     (string-match "\\`\\([A-Z][a-z][a-z]\\) +[A-Z][a-z][a-z] +[0-9][0-9]? *[0-9][0-9]?:[0-9][0-9]:[0-9][0-9] *[0-9]?[0-9]?[0-9][0-9]"
  54                   s)
  55     (concat (elmo-match-string 1 s) ", "
  56             (timezone-make-date-arpa-standard s (current-time-zone)))))
  57
  58 (defun elmo-file-msgdb-create-entity (msgdb folder number)
  59   "Create msgdb entity for the message in the FOLDER with NUMBER."
  60   (let* ((file (elmo-message-file-name folder number))
  61          (attrs (file-attributes file)))
  62     (and (not (file-directory-p file))
  63          attrs
  64          (elmo-msgdb-make-message-entity
  65           (elmo-msgdb-message-entity-handler msgdb)
  66           :message-id (concat "<" (elmo-replace-in-string
  67                                    file "/" ":")
  68                               "@" (system-name))
  69           :number number
  70           :size (nth 7 attrs)
  71           :date (elmo-file-make-date-string attrs)
  72           :subject (file-name-nondirectory file)
  73           :from (concat (user-full-name (nth 2 attrs))
  74                         " <" (user-login-name (nth 2 attrs)) "@"
  75                         (system-name) ">")))))
  76
  77 (luna-define-method elmo-folder-msgdb-create ((folder elmo-file-folder)
  78                                               numlist flag-table)
  79   (let ((new-msgdb (elmo-make-msgdb))
  80         entity mark i percent num)
  81     (setq num (length numlist))
  82     (setq i 0)
  83     (message "Creating msgdb...")
  84     (while numlist
  85       (setq entity
  86             (elmo-file-msgdb-create-entity new-msgdb folder (car numlist)))
  87       (when entity
  88         (elmo-msgdb-append-entity new-msgdb entity '(new unread)))
  89       (when (> num elmo-display-progress-threshold)
  90         (setq i (1+ i))
  91         (setq percent (/ (* i 100) num))
  92         (elmo-display-progress
  93          'elmo-folder-msgdb-create "Creating msgdb..."
  94          percent))
  95       (setq numlist (cdr numlist)))
  96     (message "Creating msgdb...done")
  97     new-msgdb))
  98
  99 (luna-define-method elmo-folder-message-file-p ((folder elmo-file-folder))
 100   t)
 101
 102 (luna-define-method elmo-message-file-name ((folder elmo-file-folder)
 103                                             number)
 104   (expand-file-name (car (split-string
 105                           (elmo-map-message-location folder number)
 106                           "/"))
 107                     (elmo-file-folder-file-path-internal folder)))
 108
 109 (luna-define-method elmo-folder-message-make-temp-file-p
 110   ((folder elmo-file-folder))
 111   t)
 112
 113 (luna-define-method elmo-folder-diff ((folder elmo-file-folder))
 114   (cons nil nil))
 115
 116 (luna-define-method elmo-folder-message-make-temp-files ((folder
 117                                                           elmo-file-folder)
 118                                                          numbers
 119                                                          &optional
 120                                                          start-number)
 121   (let ((temp-dir (elmo-folder-make-temporary-directory folder))
 122         (cur-number (if start-number 0)))
 123     (dolist (number numbers)
 124       (elmo-copy-file
 125        (elmo-message-file-name folder number)
 126        (expand-file-name
 127         (int-to-string (if start-number (incf cur-number) number))
 128         temp-dir)))
 129     temp-dir))
 130
 131 (luna-define-method elmo-map-message-fetch ((folder elmo-file-folder)
 132                                             location strategy
 133                                             &optional section unseen)
 134   (let ((file (expand-file-name (car (split-string location "/"))
 135                                 (elmo-file-folder-file-path-internal folder)))
 136         charset guess uid)
 137     (when (file-exists-p file)
 138       (prog1
 139           (insert-file-contents-as-binary file)
 140         (unless (or (std11-field-body "To")
 141                     (std11-field-body "Cc")
 142                     (std11-field-body "Subject"))
 143             (erase-buffer)
 144             (set-buffer-multibyte t)
 145             (insert-file-contents file)
 146             (setq charset (detect-mime-charset-region (point-min)
 147                                                       (point-max)))
 148             (goto-char (point-min))
 149             (setq guess (mime-find-file-type file))
 150             (setq uid (nth 2 (file-attributes file)))
 151             (insert "From: " (concat (user-full-name uid)
 152                                      " <"(user-login-name uid) "@"
 153                                      (system-name) ">") "\n")
 154             (insert "Subject: " (file-name-nondirectory file) "\n")
 155             (insert "Date: "
 156                     (elmo-file-make-date-string (file-attributes file))
 157                     "\n")
 158             (insert "Message-ID: "
 159                     (concat "<" (elmo-replace-in-string file "/" ":")
 160                             "@" (system-name) ">\n"))
 161             (insert "Content-Type: "
 162                     (concat (nth 0 guess) "/" (nth 1 guess))
 163                     (or (and (string= (nth 0 guess) "text")
 164                              (concat
 165                               "; charset=" (upcase (symbol-name charset))))
 166                         "")
 167                     "\nMIME-Version: 1.0\n\n")
 168             (when (string= (nth 0 guess) "text")
 169               (encode-mime-charset-region (point-min) (point-max) charset))
 170             (set-buffer-multibyte nil))))))
 171
 172 (luna-define-method elmo-map-folder-list-message-locations
 173   ((folder elmo-file-folder))
 174   (mapcar
 175    (lambda (file)
 176      (concat
 177       file "/"
 178       (mapconcat
 179        'number-to-string
 180        (nth 5 (file-attributes (expand-file-name
 181                                 file
 182                                 (elmo-file-folder-file-path-internal
 183                                  folder))))
 184        ":")))
 185    (directory-files (elmo-file-folder-file-path-internal folder))))
 186
 187 (luna-define-method elmo-folder-exists-p ((folder elmo-file-folder))
 188   (file-directory-p (elmo-file-folder-file-path-internal folder)))
 189
 190 (luna-define-method elmo-folder-list-subfolders ((folder elmo-file-folder)
 191                                                  &optional one-level)
 192   (when (file-directory-p (elmo-file-folder-file-path-internal folder))
 193     (append
 194      (list (elmo-folder-name-internal folder))
 195      (delq nil
 196            (mapcar
 197             (lambda (file)
 198               (when (and (file-directory-p
 199                           (expand-file-name
 200                            file
 201                            (elmo-file-folder-file-path-internal folder)))
 202                          (not (string= file "."))
 203                          (not (string= file "..")))
 204                 (concat (elmo-folder-name-internal folder) "/" file)))
 205             (directory-files (elmo-file-folder-file-path-internal
 206                               folder)))))))
 207
 208 (require 'product)
 209 (product-provide (provide 'elmo-file) (require 'elmo-version))
 210
 211 ;;; elmo-file.el ends here