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