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