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       (set-buffer-multibyte nil)
 139       (prog1
 140           (insert-file-contents-as-binary file)
 141         (unless (or (std11-field-body "To")
 142                     (std11-field-body "Cc")
 143                     (std11-field-body "Subject"))
 144           (setq guess (mime-find-file-type file))
 145           (when (string= (nth 0 guess) "text")
 146             (set-buffer-multibyte t)
 147             (decode-coding-region
 148              (point-min) (point-max)
 149              elmo-mime-display-as-is-coding-system)
 150             (setq charset (detect-mime-charset-region (point-min)
 151                                                       (point-max))))
 152           (goto-char (point-min))
 153           (setq uid (nth 2 (file-attributes file)))
 154           (insert "From: " (concat (user-full-name uid)
 155                                    " <"(user-login-name uid) "@"
 156                                    (system-name) ">") "\n")
 157           (insert "Subject: " (file-name-nondirectory file) "\n")
 158           (insert "Date: "
 159                   (elmo-file-make-date-string (file-attributes file))
 160                   "\n")
 161           (insert "Message-ID: "
 162                   (concat "<" (elmo-replace-in-string file "/" ":")
 163                           "@" (system-name) ">\n"))
 164           (insert "Content-Type: "
 165                   (concat (nth 0 guess) "/" (nth 1 guess))
 166                   (or (and (string= (nth 0 guess) "text")
 167                            (concat
 168                             "; charset=" (upcase (symbol-name charset))))
 169                       "")
 170                   "\nMIME-Version: 1.0\n\n")
 171           (when (string= (nth 0 guess) "text")
 172             (encode-mime-charset-region (point-min) (point-max) charset))
 173           (set-buffer-multibyte nil))))))
 174
 175 (luna-define-method elmo-map-folder-list-message-locations
 176   ((folder elmo-file-folder))
 177   (mapcar
 178    (lambda (file)
 179      (concat
 180       file "/"
 181       (mapconcat
 182        'number-to-string
 183        (nth 5 (file-attributes (expand-file-name
 184                                 file
 185                                 (elmo-file-folder-file-path-internal
 186                                  folder))))
 187        ":")))
 188    (directory-files (elmo-file-folder-file-path-internal folder))))
 189
 190 (luna-define-method elmo-folder-exists-p ((folder elmo-file-folder))
 191   (file-directory-p (elmo-file-folder-file-path-internal folder)))
 192
 193 (luna-define-method elmo-folder-list-subfolders ((folder elmo-file-folder)
 194                                                  &optional one-level)
 195   (when (file-directory-p (elmo-file-folder-file-path-internal folder))
 196     (append
 197      (list (elmo-folder-name-internal folder))
 198      (delq nil
 199            (mapcar
 200             (lambda (file)
 201               (when (and (file-directory-p
 202                           (expand-file-name
 203                            file
 204                            (elmo-file-folder-file-path-internal folder)))
 205                          (not (string= file "."))
 206                          (not (string= file "..")))
 207                 (concat (elmo-folder-name-internal folder) "/" file)))
 208             (directory-files (elmo-file-folder-file-path-internal
 209                               folder)))))))
 210
 211 (require 'product)
 212 (product-provide (provide 'elmo-file) (require 'elmo-version))
 213
 214 ;;; elmo-file.el ends here