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