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