elmo/elmo-nmz.el

   1 ;;; elmo-nmz.el --- Namazu 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 (eval-when-compile (require 'cl))
  32
  33 (require 'elmo)
  34 (require 'elmo-map)
  35 (require 'mime-edit)
  36
  37 (defcustom elmo-nmz-default-index-path "~/Mail"
  38   "*Default index path for namazu.
  39 If the value is a list, all elements are used as index paths for namazu."
  40   :type 'directory
  41   :group 'elmo)
  42
  43 (defcustom elmo-nmz-prog "namazu"
  44   "*Program name of namazu."
  45   :type 'string
  46   :group 'elmo)
  47
  48 (defcustom elmo-nmz-charset 'iso-2022-jp
  49   "*Charset for namazu argument."
  50   :type 'symbol
  51   :group 'elmo)
  52
  53 (defcustom elmo-nmz-args '("--all" "--list" "--late")
  54   "*Argument list for namazu to list matched files."
  55   :type '(repeat string)
  56   :group 'elmo)
  57
  58 (defcustom elmo-nmz-index-alias-alist nil
  59   "*Alist of ALIAS and INDEX-PATH."
  60   :type '(repeat (cons (string :tag "Alias Name")
  61                        (choice (directory :tag "Index Path")
  62                                (repeat (directory :tag "Index Path")))))
  63   :group 'elmo)
  64
  65 (defvar elmo-nmz-use-drive-letter (if (memq system-type
  66                                             '(OS/2 emx windows-nt)) t nil)
  67   "*If non-nil, do a drive letter conversion (e.g. /a|/ => a:/).")
  68
  69 ;;; "namazu search"
  70 (eval-and-compile
  71   (luna-define-class elmo-nmz-folder
  72                      (elmo-map-folder) (pattern index-path))
  73   (luna-define-internal-accessors 'elmo-nmz-folder))
  74
  75 (luna-define-method elmo-folder-initialize ((folder
  76                                              elmo-nmz-folder)
  77                                             name)
  78   (when (> (length name) 0)
  79     (with-temp-buffer
  80       (insert "[" name)
  81       (goto-char (point-min))
  82       (forward-sexp)
  83       (elmo-nmz-folder-set-pattern-internal folder
  84                                             (buffer-substring
  85                                              (+ 1 (point-min))
  86                                              (- (point) 1)))
  87       (let ((index (buffer-substring (point) (point-max))))
  88         (elmo-nmz-folder-set-index-path-internal
  89          folder
  90          (cond ((cdr (assoc index elmo-nmz-index-alias-alist)))
  91                ((eq (length index) 0)
  92                 elmo-nmz-default-index-path)
  93                (t
  94                 index))))))
  95   folder)
  96
  97 (luna-define-method elmo-folder-expand-msgdb-path ((folder
  98                                                     elmo-nmz-folder))
  99   (expand-file-name
 100    (elmo-replace-string-as-filename
 101     (elmo-folder-name-internal folder))
 102    (expand-file-name "nmz" elmo-msgdb-directory)))
 103
 104 (defun elmo-nmz-msgdb-create-entity (msgdb folder number)
 105   "Create msgdb entity for the message in the FOLDER with NUMBER."
 106   (let ((location (expand-file-name (elmo-map-message-location folder number)))
 107         entity uid)
 108     (setq entity (elmo-msgdb-create-message-entity-from-file
 109                   (elmo-msgdb-message-entity-handler msgdb) number location))
 110     (unless (or (elmo-message-entity-field entity 'to)
 111                 (elmo-message-entity-field entity 'cc)
 112                 (not (string= (elmo-message-entity-field entity 'subject)
 113                               elmo-no-subject)))
 114       (elmo-message-entity-set-field entity 'subject location)
 115       (setq uid (nth 2 (file-attributes location)))
 116       (elmo-message-entity-set-field entity 'from
 117                                      (concat
 118                                       (user-full-name uid)
 119                                       " <"(user-login-name uid) "@"
 120                                       (system-name) ">")))
 121     entity))
 122
 123 (luna-define-method elmo-folder-msgdb-create ((folder elmo-nmz-folder)
 124                                               numlist flag-table)
 125   (let ((new-msgdb (elmo-make-msgdb))
 126         entity mark i percent num)
 127     (setq num (length numlist))
 128     (setq i 0)
 129     (message "Creating msgdb...")
 130     (while numlist
 131       (setq entity
 132             (elmo-nmz-msgdb-create-entity
 133              new-msgdb folder (car numlist)))
 134       (when entity
 135         (elmo-msgdb-append-entity new-msgdb entity '(new unread)))
 136       (when (> num elmo-display-progress-threshold)
 137         (setq i (1+ i))
 138         (setq percent (/ (* i 100) num))
 139         (elmo-display-progress
 140          'elmo-folder-msgdb-create "Creating msgdb..."
 141          percent))
 142       (setq numlist (cdr numlist)))
 143     (message "Creating msgdb...done")
 144     new-msgdb))
 145
 146 (luna-define-method elmo-folder-message-file-p ((folder elmo-nmz-folder))
 147   t)
 148
 149 (luna-define-method elmo-message-file-name ((folder elmo-nmz-folder)
 150                                             number)
 151   (elmo-map-message-location folder number))
 152
 153 (luna-define-method elmo-folder-message-make-temp-file-p
 154   ((folder elmo-nmz-folder))
 155   t)
 156
 157 (luna-define-method elmo-folder-diff ((folder elmo-nmz-folder))
 158   (cons nil nil))
 159
 160 (luna-define-method elmo-folder-message-make-temp-files ((folder
 161                                                           elmo-nmz-folder)
 162                                                          numbers
 163                                                          &optional
 164                                                          start-number)
 165   (let ((temp-dir (elmo-folder-make-temporary-directory folder))
 166         (cur-number (if start-number 0)))
 167     (dolist (number numbers)
 168       (elmo-copy-file
 169        (elmo-message-file-name folder number)
 170        (expand-file-name
 171         (int-to-string (if start-number (incf cur-number) number))
 172         temp-dir)))
 173     temp-dir))
 174
 175 (luna-define-method elmo-map-message-fetch ((folder elmo-nmz-folder)
 176                                             location strategy
 177                                             &optional section unseen)
 178   (when (file-exists-p location)
 179     (prog1
 180         (insert-file-contents-as-binary (expand-file-name location))
 181       (unless (or (std11-field-body "To")
 182                   (std11-field-body "Cc")
 183                   (std11-field-body "Subject"))
 184         (let (charset guess uid)
 185           (erase-buffer)
 186           (set-buffer-multibyte t)
 187           (insert-file-contents (expand-file-name location))
 188           (setq charset (detect-mime-charset-region (point-min)
 189                                                     (point-max)))
 190           (goto-char (point-min))
 191           (setq guess (mime-find-file-type location))
 192           (setq uid (nth 2 (file-attributes location)))
 193           (insert "From: " (concat (user-full-name uid)
 194                                    " <"(user-login-name uid) "@"
 195                                    (system-name) ">") "\n")
 196           (insert "Subject: " location "\n")
 197           (insert "Content-Type: "
 198                   (concat (nth 0 guess) "/" (nth 1 guess))
 199                   "; charset=" (upcase (symbol-name charset))
 200                   "\nMIME-Version: 1.0\n\n")
 201           (encode-mime-charset-region (point-min) (point-max) charset)
 202           (set-buffer-multibyte nil))))))
 203
 204 (luna-define-method elmo-map-folder-list-message-locations
 205   ((folder elmo-nmz-folder))
 206   (let (bol locations)
 207     (with-temp-buffer
 208       (apply 'call-process elmo-nmz-prog nil t t
 209              (append elmo-nmz-args
 210                      (list
 211                       (encode-mime-charset-string
 212                        (elmo-nmz-folder-pattern-internal folder)
 213                        elmo-nmz-charset))
 214                      (if (listp (elmo-nmz-folder-index-path-internal folder))
 215                          (mapcar
 216                           'expand-file-name
 217                           (elmo-nmz-folder-index-path-internal folder))
 218                        (list
 219                         (expand-file-name
 220                          (elmo-nmz-folder-index-path-internal folder))))))
 221       (goto-char (point-min))
 222       (while (not (eobp))
 223         (beginning-of-line)
 224         ;; convert url to file path.
 225         (when (looking-at "^file://")
 226           (replace-match ""))
 227         (when (and elmo-nmz-use-drive-letter
 228                    (looking-at "^/\\([A-Za-z]\\)|/"))
 229           (replace-match "\\1:/")
 230           (beginning-of-line))
 231         (setq bol (point))
 232         (end-of-line)
 233         (setq locations (cons (buffer-substring bol (point)) locations))
 234         (forward-line 1))
 235       (nreverse locations))))
 236
 237 (luna-define-method elmo-folder-exists-p ((folder elmo-nmz-folder))
 238   (elmo-nmz-folder-pattern-internal folder))
 239
 240 (luna-define-method elmo-folder-have-subfolder-p ((folder elmo-nmz-folder))
 241   (null (elmo-nmz-folder-pattern-internal folder)))
 242
 243 (luna-define-method elmo-folder-list-subfolders ((folder elmo-nmz-folder)
 244                                                  &optional one-level)
 245   (mapcar (lambda (name) (elmo-recover-string-from-filename name))
 246           (directory-files (expand-file-name "nmz" elmo-msgdb-directory)
 247                            nil
 248                            (concat
 249                             "^"
 250                             (regexp-quote
 251                              (elmo-folder-prefix-internal folder))))))
 252
 253 (require 'product)
 254 (product-provide (provide 'elmo-nmz) (require 'elmo-version))
 255
 256 ;;; elmo-nmz.el ends here